packages feed

ghc-lib-parser 9.10.3.20250912 → 9.12.1.20241218

raw patch · 294 files changed

+31266/−22909 lines, 294 filesdep +os-stringdep ~basedep ~filepathdep ~ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: os-string

Dependency ranges changed: base, filepath, ghc-prim

API changes (from Hackage documentation)

- GHC.Builtin.Names: cONTROL_MONAD_ZIP :: Module
- GHC.Builtin.Names: dATA_LIST :: Module
- GHC.Builtin.Names: dATA_SUM_EXPERIMENTAL :: Module
- GHC.Builtin.Names: dATA_TUPLE_EXPERIMENTAL :: Module
- GHC.Builtin.Names: mkBaseModule :: FastString -> Module
- GHC.Builtin.Names: mkBaseModule_ :: ModuleName -> Module
- GHC.Builtin.Names: mkExperimentalModule :: FastString -> Module
- GHC.Builtin.Names: mkTrAppCheckedKey :: Unique
- GHC.Builtin.Names: mkTrAppCheckedName :: Name
- GHC.Builtin.Names: pRELUDE :: Module
- GHC.Builtin.PrimOps: SeqOp :: PrimOp
- GHC.Builtin.Types: soloDataConName :: Name
- GHC.Cmm: data CmmTopInfo
- GHC.Cmm: data GenCmmGraph (n :: Extensibility -> Extensibility -> Type)
- GHC.Cmm.CLabel: addLabelSize :: CLabel -> Int -> CLabel
- GHC.Cmm.CLabel: foreignLabelStdcallInfo :: CLabel -> Maybe Int
- GHC.Cmm.Expr: [globalRegUseGlobalReg] :: GlobalRegUse -> !GlobalReg
- GHC.Cmm.Expr: [globalRegUseType] :: GlobalRegUse -> !CmmType
- GHC.Cmm.MachOp: MO_FS_Conv :: Width -> Width -> MachOp
- GHC.Cmm.MachOp: MO_SF_Conv :: Width -> Width -> MachOp
- GHC.Cmm.Node: instance GHC.Cmm.Expr.DefinerOfRegs GHC.Cmm.Reg.GlobalReg (GHC.Cmm.Node.CmmNode e x)
- GHC.Cmm.Node: instance GHC.Cmm.Expr.UserOfRegs GHC.Cmm.Reg.GlobalReg (GHC.Cmm.Node.CmmNode e x)
- GHC.Cmm.Reg: [globalRegUseGlobalReg] :: GlobalRegUse -> !GlobalReg
- GHC.Cmm.Reg: [globalRegUseType] :: GlobalRegUse -> !CmmType
- GHC.Cmm.Type: cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
- GHC.Core.Coercion: coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind, Kind, Type, Type, Role)
- GHC.Core.Coercion: getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type
- GHC.Core.Coercion: mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion
- GHC.Core.Coercion: mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion
- GHC.Core.Coercion.Axiom: CoAxiomRule :: FastString -> [Role] -> Role -> ([TypeEqn] -> Maybe TypeEqn) -> CoAxiomRule
- GHC.Core.Coercion.Axiom: [coaxrAsmpRoles] :: CoAxiomRule -> [Role]
- GHC.Core.Coercion.Axiom: [coaxrName] :: CoAxiomRule -> FastString
- GHC.Core.Coercion.Axiom: [coaxrProves] :: CoAxiomRule -> [TypeEqn] -> Maybe TypeEqn
- GHC.Core.Coercion.Axiom: [coaxrRole] :: CoAxiomRule -> Role
- GHC.Core.Coercion.Axiom: [sfInteractInert] :: BuiltInSynFamily -> [Type] -> Type -> [Type] -> Type -> [TypeEqn]
- GHC.Core.Coercion.Axiom: [sfInteractTop] :: BuiltInSynFamily -> [Type] -> Type -> [TypeEqn]
- GHC.Core.Coercion.Axiom: instance GHC.Classes.Ord GHC.Core.Coercion.Axiom.CoAxiomRule
- GHC.Core.Coercion.Axiom: instance GHC.Types.Unique.Uniquable GHC.Core.Coercion.Axiom.CoAxiomRule
- GHC.Core.DataCon: instance Data.Data.Data GHC.Core.DataCon.HsSrcBang
- GHC.Core.DataCon: instance GHC.Utils.Outputable.Outputable GHC.Core.DataCon.HsSrcBang
- GHC.Core.FVs: exprsOrphNames :: [CoreExpr] -> NameSet
- GHC.Core.FVs: orphNamesOfCo :: Coercion -> NameSet
- GHC.Core.FVs: orphNamesOfCoCon :: forall (br :: BranchFlag). CoAxiom br -> NameSet
- GHC.Core.InstEnv: getPotentialUnifiers :: PotentialUnifiers -> [ClsInst]
- GHC.Core.InstEnv: type Canonical = Bool
- GHC.Core.Opt.OccurAnal: scrutBinderSwap_maybe :: OutExpr -> Maybe (OutVar, MCoercion)
- GHC.Core.Opt.Simplify.Utils: activeUnfolding :: SimplMode -> Id -> Bool
- GHC.Core.Predicate: isExceptionContextTy :: Type -> Bool
- GHC.Core.TyCo.Compare: nonDetCmpTc :: TyCon -> TyCon -> Ordering
- GHC.Core.TyCo.Compare: nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering
- GHC.Core.TyCo.Compare: nonDetCmpTypes :: [Type] -> [Type] -> Ordering
- GHC.Core.TyCo.Compare: nonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering
- GHC.Core.TyCo.Rep: AxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion
- GHC.Core.TyCo.Rep: AxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion
- GHC.Core.TyCo.Rep: provSize :: UnivCoProvenance -> Int
- GHC.Core.TyCo.Tidy: tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
- GHC.Core.TyCo.Tidy: tidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
- GHC.Core.Type: isCoVarType :: Type -> Bool
- GHC.Core.Type: tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
- GHC.Core.Type: tidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
- GHC.Data.TrieMap: type LiteralMap a = Map Literal a
- GHC.Driver.DynFlags: AixLD :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: AppleClang :: CompilerInfo
- GHC.Driver.DynFlags: AppleClang51 :: CompilerInfo
- GHC.Driver.DynFlags: Clang :: CompilerInfo
- GHC.Driver.DynFlags: DarwinLD :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: Emscripten :: CompilerInfo
- GHC.Driver.DynFlags: GCC :: CompilerInfo
- GHC.Driver.DynFlags: GnuGold :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: GnuLD :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: LlvmLLD :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: Mold :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: Opt_InterModuleFarJumps :: GeneralFlag
- GHC.Driver.DynFlags: Opt_SpecEval :: GeneralFlag
- GHC.Driver.DynFlags: Opt_SpecEvalDictFun :: GeneralFlag
- GHC.Driver.DynFlags: SolarisLD :: [Option] -> LinkerInfo
- GHC.Driver.DynFlags: UnknownCC :: CompilerInfo
- GHC.Driver.DynFlags: UnknownLD :: LinkerInfo
- GHC.Driver.DynFlags: data CompilerInfo
- GHC.Driver.DynFlags: data LinkerInfo
- GHC.Driver.DynFlags: instance GHC.Classes.Eq GHC.Driver.DynFlags.CompilerInfo
- GHC.Driver.DynFlags: instance GHC.Classes.Eq GHC.Driver.DynFlags.LinkerInfo
- GHC.Driver.Flags: Opt_InterModuleFarJumps :: GeneralFlag
- GHC.Driver.Flags: Opt_SpecEval :: GeneralFlag
- GHC.Driver.Flags: Opt_SpecEvalDictFun :: GeneralFlag
- GHC.Driver.Session: AixLD :: [Option] -> LinkerInfo
- GHC.Driver.Session: AppleClang :: CompilerInfo
- GHC.Driver.Session: AppleClang51 :: CompilerInfo
- GHC.Driver.Session: Clang :: CompilerInfo
- GHC.Driver.Session: DarwinLD :: [Option] -> LinkerInfo
- GHC.Driver.Session: Emscripten :: CompilerInfo
- GHC.Driver.Session: GCC :: CompilerInfo
- GHC.Driver.Session: GnuGold :: [Option] -> LinkerInfo
- GHC.Driver.Session: GnuLD :: [Option] -> LinkerInfo
- GHC.Driver.Session: LlvmLLD :: [Option] -> LinkerInfo
- GHC.Driver.Session: Mold :: [Option] -> LinkerInfo
- GHC.Driver.Session: Opt_InterModuleFarJumps :: GeneralFlag
- GHC.Driver.Session: Opt_SpecEval :: GeneralFlag
- GHC.Driver.Session: Opt_SpecEvalDictFun :: GeneralFlag
- GHC.Driver.Session: SolarisLD :: [Option] -> LinkerInfo
- GHC.Driver.Session: UnknownCC :: CompilerInfo
- GHC.Driver.Session: UnknownLD :: LinkerInfo
- GHC.Driver.Session: data CompilerInfo
- GHC.Driver.Session: data LinkerInfo
- GHC.Driver.Session: instance GHC.Classes.Eq GHC.Driver.Session.Deprecation
- GHC.Driver.Session: instance GHC.Classes.Ord GHC.Driver.Session.Deprecation
- GHC.ForeignSrcLang: instance Data.Binary.Class.Binary GHC.ForeignSrcLang.Type.ForeignSrcLang
- GHC.ForeignSrcLang.Type: instance GHC.Classes.Eq GHC.ForeignSrcLang.Type.ForeignSrcLang
- GHC.ForeignSrcLang.Type: instance GHC.Generics.Generic GHC.ForeignSrcLang.Type.ForeignSrcLang
- GHC.ForeignSrcLang.Type: instance GHC.Show.Show GHC.ForeignSrcLang.Type.ForeignSrcLang
- GHC.Hs: [am_main] :: AnnsModule -> [AddEpAnn]
- GHC.Hs.Binds: [asRest] :: AnnSig -> [AddEpAnn]
- GHC.Hs.Binds: instance GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Extension.XRec a GHC.Types.Name.Reader.RdrName) => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Binds.RecordPatSynField a)
- GHC.Hs.Expr: [hsCaseAnnsRest] :: EpAnnHsCase -> [AddEpAnn]
- GHC.Hs.Expr: instance GHC.Hs.Extension.OutputableBndrId idL => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Expr.ApplicativeArg (GHC.Hs.Extension.GhcPass idL))
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Expr.ApplicativeArg GHC.Hs.Extension.GhcPs)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Expr.ApplicativeArg GHC.Hs.Extension.GhcRn)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Expr.ApplicativeArg GHC.Hs.Extension.GhcTc)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.AmbiguousFieldOcc GHC.Hs.Extension.GhcPs)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.AmbiguousFieldOcc GHC.Hs.Extension.GhcRn)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.AmbiguousFieldOcc GHC.Hs.Extension.GhcTc)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrow GHC.Hs.Extension.GhcPs)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrow GHC.Hs.Extension.GhcRn)
- GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrow GHC.Hs.Extension.GhcTc)
- GHC.Hs.Pat: hsRecUpdFieldId :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> Located Id
- GHC.Hs.Pat: hsRecUpdFieldOcc :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
- GHC.Hs.Pat: hsRecUpdFieldRdr :: forall (p :: Pass) q. HsRecUpdField (GhcPass p) q -> Located RdrName
- GHC.Hs.Pat: isIrrefutableHsPatHelper :: forall (p :: Pass). OutputableBndrId p => Bool -> LPat (GhcPass p) -> Bool
- GHC.Hs.Pat: isIrrefutableHsPatHelperM :: forall m (p :: Pass). (Monad m, OutputableBndrId p) => LPatIrrefutableCheck m (GhcPass p)
- GHC.Hs.Type: Ambiguous :: XAmbiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
- GHC.Hs.Type: KindedTyVar :: XKindedTyVar pass -> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
- GHC.Hs.Type: Unambiguous :: XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
- GHC.Hs.Type: UserTyVar :: XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
- GHC.Hs.Type: XAmbiguousFieldOcc :: !XXAmbiguousFieldOcc pass -> AmbiguousFieldOcc pass
- GHC.Hs.Type: XXBndrVis :: !XXBndrVis pass -> HsBndrVis pass
- GHC.Hs.Type: ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
- GHC.Hs.Type: ambiguousFieldOccLRdrName :: forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName
- GHC.Hs.Type: ambiguousFieldOccRdrName :: forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
- GHC.Hs.Type: data AmbiguousFieldOcc pass
- GHC.Hs.Type: data HsArrow pass
- GHC.Hs.Type: instance (Language.Haskell.Syntax.Extension.UnXRec pass, GHC.Utils.Outputable.OutputableBndr (Language.Haskell.Syntax.Extension.XRec pass GHC.Types.Name.Reader.RdrName)) => GHC.Utils.Outputable.OutputableBndr (GHC.Types.SrcLoc.GenLocated GHC.Types.SrcLoc.SrcSpan (Language.Haskell.Syntax.Type.FieldOcc pass))
- GHC.Hs.Type: instance (Language.Haskell.Syntax.Extension.UnXRec pass, GHC.Utils.Outputable.OutputableBndr (Language.Haskell.Syntax.Extension.XRec pass GHC.Types.Name.Reader.RdrName)) => GHC.Utils.Outputable.OutputableBndr (Language.Haskell.Syntax.Type.FieldOcc pass)
- GHC.Hs.Type: instance GHC.Hs.Extension.OutputableBndrId pass => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Type.HsArrow (GHC.Hs.Extension.GhcPass pass))
- GHC.Hs.Type: instance GHC.Hs.Type.OutputableBndrFlag GHC.Types.Var.Specificity p
- GHC.Hs.Type: instance GHC.Types.Name.NamedThing (Language.Haskell.Syntax.Type.HsTyVarBndr flag GHC.Hs.Extension.GhcRn)
- GHC.Hs.Type: instance GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Extension.XRec pass GHC.Types.Name.Reader.RdrName) => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Type.FieldOcc pass)
- GHC.Hs.Type: instance GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Type.AmbiguousFieldOcc (GHC.Hs.Extension.GhcPass p))
- GHC.Hs.Type: instance GHC.Utils.Outputable.OutputableBndr (GHC.Types.SrcLoc.Located (Language.Haskell.Syntax.Type.AmbiguousFieldOcc (GHC.Hs.Extension.GhcPass p)))
- GHC.Hs.Type: instance GHC.Utils.Outputable.OutputableBndr (Language.Haskell.Syntax.Type.AmbiguousFieldOcc (GHC.Hs.Extension.GhcPass p))
- GHC.Hs.Type: mkAmbiguousFieldOcc :: LocatedN RdrName -> AmbiguousFieldOcc GhcPs
- GHC.Hs.Type: selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
- GHC.Hs.Type: type EpAnnForallTy = EpAnn (AddEpAnn, AddEpAnn)
- GHC.Hs.Type: type LAmbiguousFieldOcc pass = XRec pass AmbiguousFieldOcc pass
- GHC.Hs.Type: unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
- GHC.HsToCore.Pmc.Solver.Types: data CompleteMatch
- GHC.HsToCore.Pmc.Types: GrdVec :: [PmGrd] -> GrdVec
- GHC.HsToCore.Pmc.Types: instance GHC.Utils.Outputable.Outputable GHC.HsToCore.Pmc.Types.GrdVec
- GHC.HsToCore.Pmc.Types: newtype GrdVec
- GHC.Iface.Type: IfaceAxiomInstCo :: IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
- GHC.Iface.Type: IfaceAxiomRuleCo :: IfLclName -> [IfaceCoercion] -> IfaceCoercion
- GHC.Iface.Type: IfacePhantomProv :: IfaceCoercion -> IfaceUnivCoProv
- GHC.Iface.Type: IfacePluginProv :: String -> IfaceUnivCoProv
- GHC.Iface.Type: IfaceProofIrrelProv :: IfaceCoercion -> IfaceUnivCoProv
- GHC.Iface.Type: data IfaceUnivCoProv
- GHC.Iface.Type: instance Control.DeepSeq.NFData GHC.Iface.Type.IfaceUnivCoProv
- GHC.Iface.Type: instance GHC.Utils.Binary.Binary GHC.Iface.Type.IfaceUnivCoProv
- GHC.Iface.Type: type IfLclName = FastString
- GHC.JS.Ident: global :: FastString -> Ident
- GHC.JS.JStg.Syntax: var :: FastString -> JStgExpr
- GHC.JS.Make: trace :: ToJExpr a => a -> JStgStat
- GHC.JS.Make: typeof :: JStgExpr -> JStgExpr
- GHC.LanguageExtensions: instance Data.Binary.Class.Binary GHC.LanguageExtensions.Type.Extension
- GHC.LanguageExtensions.Type: instance GHC.Classes.Eq GHC.LanguageExtensions.Type.Extension
- GHC.LanguageExtensions.Type: instance GHC.Classes.Ord GHC.LanguageExtensions.Type.Extension
- GHC.LanguageExtensions.Type: instance GHC.Enum.Bounded GHC.LanguageExtensions.Type.Extension
- GHC.LanguageExtensions.Type: instance GHC.Enum.Enum GHC.LanguageExtensions.Type.Extension
- GHC.LanguageExtensions.Type: instance GHC.Generics.Generic GHC.LanguageExtensions.Type.Extension
- GHC.LanguageExtensions.Type: instance GHC.Show.Show GHC.LanguageExtensions.Type.Extension
- GHC.Linker.Types: LM :: !UTCTime -> !Module -> [Unlinked] -> Linkable
- GHC.Linker.Types: LoadedBCOs :: [Unlinked] -> Unlinked
- GHC.Linker.Types: [linkableUnlinked] :: Linkable -> [Unlinked]
- GHC.Linker.Types: byteCodeOfObject :: Unlinked -> [CompiledByteCode]
- GHC.Linker.Types: data Unlinked
- GHC.Linker.Types: instance GHC.Utils.Outputable.Outputable GHC.Linker.Types.SptEntry
- GHC.Linker.Types: instance GHC.Utils.Outputable.Outputable GHC.Linker.Types.Unlinked
- GHC.Linker.Types: isInterpretable :: Unlinked -> Bool
- GHC.Linker.Types: isObject :: Unlinked -> Bool
- GHC.Linker.Types: isObjectLinkable :: Linkable -> Bool
- GHC.Linker.Types: nameOfObject :: Unlinked -> FilePath
- GHC.Linker.Types: nameOfObject_maybe :: Unlinked -> Maybe FilePath
- GHC.Parser.Annotation: AddDarrowUAnn :: EpaLocation -> TrailingAnn
- GHC.Parser.Annotation: AddEpAnn :: AnnKeywordId -> EpaLocation -> AddEpAnn
- GHC.Parser.Annotation: AnnAnyclass :: AnnKeywordId
- GHC.Parser.Annotation: AnnAs :: AnnKeywordId
- GHC.Parser.Annotation: AnnBackquote :: AnnKeywordId
- GHC.Parser.Annotation: AnnBang :: AnnKeywordId
- GHC.Parser.Annotation: AnnBy :: AnnKeywordId
- GHC.Parser.Annotation: AnnCase :: AnnKeywordId
- GHC.Parser.Annotation: AnnCases :: AnnKeywordId
- GHC.Parser.Annotation: AnnClass :: AnnKeywordId
- GHC.Parser.Annotation: AnnClose :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseB :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseBU :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseC :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseP :: AnnKeywordId
- GHC.Parser.Annotation: AnnClosePH :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseQ :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseQU :: AnnKeywordId
- GHC.Parser.Annotation: AnnCloseS :: AnnKeywordId
- GHC.Parser.Annotation: AnnColon :: AnnKeywordId
- GHC.Parser.Annotation: AnnComma :: AnnKeywordId
- GHC.Parser.Annotation: AnnCommaTuple :: AnnKeywordId
- GHC.Parser.Annotation: AnnDarrow :: AnnKeywordId
- GHC.Parser.Annotation: AnnDarrowU :: AnnKeywordId
- GHC.Parser.Annotation: AnnData :: AnnKeywordId
- GHC.Parser.Annotation: AnnDcolon :: AnnKeywordId
- GHC.Parser.Annotation: AnnDcolonU :: AnnKeywordId
- GHC.Parser.Annotation: AnnDefault :: AnnKeywordId
- GHC.Parser.Annotation: AnnDeriving :: AnnKeywordId
- GHC.Parser.Annotation: AnnDo :: AnnKeywordId
- GHC.Parser.Annotation: AnnDollar :: AnnKeywordId
- GHC.Parser.Annotation: AnnDollarDollar :: AnnKeywordId
- GHC.Parser.Annotation: AnnDot :: AnnKeywordId
- GHC.Parser.Annotation: AnnDotdot :: AnnKeywordId
- GHC.Parser.Annotation: AnnElse :: AnnKeywordId
- GHC.Parser.Annotation: AnnEqual :: AnnKeywordId
- GHC.Parser.Annotation: AnnExport :: AnnKeywordId
- GHC.Parser.Annotation: AnnFamily :: AnnKeywordId
- GHC.Parser.Annotation: AnnForall :: AnnKeywordId
- GHC.Parser.Annotation: AnnForallU :: AnnKeywordId
- GHC.Parser.Annotation: AnnForeign :: AnnKeywordId
- GHC.Parser.Annotation: AnnFunId :: AnnKeywordId
- GHC.Parser.Annotation: AnnGroup :: AnnKeywordId
- GHC.Parser.Annotation: AnnHeader :: AnnKeywordId
- GHC.Parser.Annotation: AnnHiding :: AnnKeywordId
- GHC.Parser.Annotation: AnnIf :: AnnKeywordId
- GHC.Parser.Annotation: AnnImport :: AnnKeywordId
- GHC.Parser.Annotation: AnnIn :: AnnKeywordId
- GHC.Parser.Annotation: AnnInfix :: AnnKeywordId
- GHC.Parser.Annotation: AnnInstance :: AnnKeywordId
- GHC.Parser.Annotation: AnnLam :: AnnKeywordId
- GHC.Parser.Annotation: AnnLarrow :: AnnKeywordId
- GHC.Parser.Annotation: AnnLarrowU :: AnnKeywordId
- GHC.Parser.Annotation: AnnLarrowtail :: AnnKeywordId
- GHC.Parser.Annotation: AnnLarrowtailU :: AnnKeywordId
- GHC.Parser.Annotation: AnnLet :: AnnKeywordId
- GHC.Parser.Annotation: AnnLollyU :: AnnKeywordId
- GHC.Parser.Annotation: AnnMdo :: AnnKeywordId
- GHC.Parser.Annotation: AnnMinus :: AnnKeywordId
- GHC.Parser.Annotation: AnnModule :: AnnKeywordId
- GHC.Parser.Annotation: AnnName :: AnnKeywordId
- GHC.Parser.Annotation: AnnNewtype :: AnnKeywordId
- GHC.Parser.Annotation: AnnOf :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpen :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenB :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenBU :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenC :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenE :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenEQ :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenEQU :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenP :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenPH :: AnnKeywordId
- GHC.Parser.Annotation: AnnOpenS :: AnnKeywordId
- GHC.Parser.Annotation: AnnPackageName :: AnnKeywordId
- GHC.Parser.Annotation: AnnParen :: ParenType -> EpaLocation -> EpaLocation -> AnnParen
- GHC.Parser.Annotation: AnnPattern :: AnnKeywordId
- GHC.Parser.Annotation: AnnPercent :: AnnKeywordId
- GHC.Parser.Annotation: AnnPercentOne :: AnnKeywordId
- GHC.Parser.Annotation: AnnProc :: AnnKeywordId
- GHC.Parser.Annotation: AnnQualified :: AnnKeywordId
- GHC.Parser.Annotation: AnnRarrow :: AnnKeywordId
- GHC.Parser.Annotation: AnnRarrowU :: AnnKeywordId
- GHC.Parser.Annotation: AnnRarrowtail :: AnnKeywordId
- GHC.Parser.Annotation: AnnRarrowtailU :: AnnKeywordId
- GHC.Parser.Annotation: AnnRec :: AnnKeywordId
- GHC.Parser.Annotation: AnnRole :: AnnKeywordId
- GHC.Parser.Annotation: AnnSafe :: AnnKeywordId
- GHC.Parser.Annotation: AnnSemi :: AnnKeywordId
- GHC.Parser.Annotation: AnnSignature :: AnnKeywordId
- GHC.Parser.Annotation: AnnSimpleQuote :: AnnKeywordId
- GHC.Parser.Annotation: AnnStatic :: AnnKeywordId
- GHC.Parser.Annotation: AnnStock :: AnnKeywordId
- GHC.Parser.Annotation: AnnThTyQuote :: AnnKeywordId
- GHC.Parser.Annotation: AnnThen :: AnnKeywordId
- GHC.Parser.Annotation: AnnTilde :: AnnKeywordId
- GHC.Parser.Annotation: AnnType :: AnnKeywordId
- GHC.Parser.Annotation: AnnUnit :: AnnKeywordId
- GHC.Parser.Annotation: AnnUsing :: AnnKeywordId
- GHC.Parser.Annotation: AnnVal :: AnnKeywordId
- GHC.Parser.Annotation: AnnValStr :: AnnKeywordId
- GHC.Parser.Annotation: AnnVbar :: AnnKeywordId
- GHC.Parser.Annotation: AnnVia :: AnnKeywordId
- GHC.Parser.Annotation: AnnWhere :: AnnKeywordId
- GHC.Parser.Annotation: Annlarrowtail :: AnnKeywordId
- GHC.Parser.Annotation: AnnlarrowtailU :: AnnKeywordId
- GHC.Parser.Annotation: Annrarrowtail :: AnnKeywordId
- GHC.Parser.Annotation: AnnrarrowtailU :: AnnKeywordId
- GHC.Parser.Annotation: [al_close] :: AnnList -> Maybe AddEpAnn
- GHC.Parser.Annotation: [al_open] :: AnnList -> Maybe AddEpAnn
- GHC.Parser.Annotation: [ap_adornment] :: AnnParen -> ParenType
- GHC.Parser.Annotation: [ap_close] :: AnnParen -> EpaLocation
- GHC.Parser.Annotation: [ap_open] :: AnnParen -> EpaLocation
- GHC.Parser.Annotation: [apr_rest] :: AnnPragma -> [AddEpAnn]
- GHC.Parser.Annotation: [nann_close] :: NameAnn -> EpaLocation
- GHC.Parser.Annotation: [nann_open] :: NameAnn -> EpaLocation
- GHC.Parser.Annotation: [nann_unicode] :: NameAnn -> Bool
- GHC.Parser.Annotation: [ta_location] :: TrailingAnn -> EpaLocation
- GHC.Parser.Annotation: addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
- GHC.Parser.Annotation: anchor :: EpaLocation' a -> RealSrcSpan
- GHC.Parser.Annotation: annParen2AddEpAnn :: AnnParen -> [AddEpAnn]
- GHC.Parser.Annotation: data AddEpAnn
- GHC.Parser.Annotation: data AnnKeywordId
- GHC.Parser.Annotation: data ParenType
- GHC.Parser.Annotation: epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn]
- GHC.Parser.Annotation: instance Data.Data.Data GHC.Parser.Annotation.AddEpAnn
- GHC.Parser.Annotation: instance Data.Data.Data GHC.Parser.Annotation.AnnKeywordId
- GHC.Parser.Annotation: instance Data.Data.Data GHC.Parser.Annotation.AnnList
- GHC.Parser.Annotation: instance Data.Data.Data GHC.Parser.Annotation.ParenType
- GHC.Parser.Annotation: instance GHC.Classes.Eq GHC.Parser.Annotation.AddEpAnn
- GHC.Parser.Annotation: instance GHC.Classes.Eq GHC.Parser.Annotation.AnnKeywordId
- GHC.Parser.Annotation: instance GHC.Classes.Eq GHC.Parser.Annotation.AnnList
- GHC.Parser.Annotation: instance GHC.Classes.Eq GHC.Parser.Annotation.ParenType
- GHC.Parser.Annotation: instance GHC.Classes.Ord GHC.Parser.Annotation.AnnKeywordId
- GHC.Parser.Annotation: instance GHC.Classes.Ord GHC.Parser.Annotation.NameAdornment
- GHC.Parser.Annotation: instance GHC.Classes.Ord GHC.Parser.Annotation.ParenType
- GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn GHC.Parser.Annotation.AddEpAnn
- GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn GHC.Parser.Annotation.AnnKeywordId
- GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn GHC.Parser.Annotation.AnnList
- GHC.Parser.Annotation: instance GHC.Show.Show GHC.Parser.Annotation.AnnKeywordId
- GHC.Parser.Annotation: instance GHC.Show.Show GHC.Parser.Annotation.ParenType
- GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable GHC.Parser.Annotation.AddEpAnn
- GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable GHC.Parser.Annotation.AnnKeywordId
- GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable GHC.Parser.Annotation.AnnList
- GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable GHC.Parser.Annotation.ParenType
- GHC.Parser.Annotation: parenTypeKws :: ParenType -> (AnnKeywordId, AnnKeywordId)
- GHC.Parser.Annotation: trailingAnnToAddEpAnn :: TrailingAnn -> AddEpAnn
- GHC.Parser.Annotation: type Anchor = EpaLocation
- GHC.Parser.Annotation: unicodeAnn :: AnnKeywordId -> AnnKeywordId
- GHC.Parser.Annotation: widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
- GHC.Parser.Annotation: widenLocatedAn :: EpAnn an -> [AddEpAnn] -> EpAnn an
- GHC.Parser.Annotation: widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
- GHC.Parser.Errors.Types: LexStringCharLit :: LexErr
- GHC.Parser.Errors.Types: LexStringCharLitEOF :: LexErr
- GHC.Parser.Errors.Types: PsErrViewPatInExpr :: !LHsExpr GhcPs -> !LHsExpr GhcPs -> PsMessage
- GHC.Parser.Lexer: mkParensEpAnn :: RealSrcSpan -> (AddEpAnn, AddEpAnn)
- GHC.Parser.PostProcess: fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
- GHC.Parser.PostProcess: mkHsViewPatPV :: DisambECP b => SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
- GHC.Parser.PostProcess: requireExplicitNamespaces :: MonadP m => SrcSpan -> m ()
- GHC.Parser.PostProcess.Haddock: instance GHC.Parser.PostProcess.Haddock.HasHaddock (GHC.Parser.Annotation.LocatedL [GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.ImpExp.IE GHC.Hs.Extension.GhcPs)])
- GHC.Platform.Reg: VirtualRegF :: {-# UNPACK #-} !Unique -> VirtualReg
- GHC.Platform.Reg.Class: RcDouble :: RegClass
- GHC.Platform.Reg.Class: RcFloat :: RegClass
- GHC.Platform.Reg.Class: RcInteger :: RegClass
- GHC.Platform.Reg.Class: data RegClass
- GHC.Prelude.Basic: strictGenericLength :: Num a => [x] -> a
- GHC.Stg.Syntax: isDllConApp :: Platform -> Bool -> Module -> DataCon -> [StgArg] -> Bool
- GHC.StgToCmm.Config: [stgToCmmAllowBigArith] :: StgToCmmConfig -> !Bool
- GHC.StgToCmm.Config: [stgToCmmAllowBigQuot] :: StgToCmmConfig -> !Bool
- GHC.StgToCmm.Config: [stgToCmmOptHpc] :: StgToCmmConfig -> !Bool
- GHC.Tc.Errors.Types: EmptyCaseDisallowedCtxt :: BadEmptyCaseReason
- GHC.Tc.Errors.Types: EmptyCaseForall :: ForAllTyBinder -> BadEmptyCaseReason
- GHC.Tc.Errors.Types: EmptyCaseWithoutFlag :: BadEmptyCaseReason
- GHC.Tc.Errors.Types: [TcRnCompatUnqualifiedImport] :: !ImportDecl GhcPs -> TcRnMessage
- GHC.Tc.Errors.Types: data BadEmptyCaseReason
- GHC.Tc.Solver.InertSet: [wl_eqs] :: WorkList -> [Ct]
- GHC.Tc.Types: data CompleteMatch
- GHC.Tc.Types.Constraint: CtLoc :: CtOrigin -> CtLocEnv -> Maybe TypeOrKind -> !SubGoalDepth -> CtLoc
- GHC.Tc.Types.Constraint: [ctl_depth] :: CtLoc -> !SubGoalDepth
- GHC.Tc.Types.Constraint: [ctl_env] :: CtLoc -> CtLocEnv
- GHC.Tc.Types.Constraint: [ctl_origin] :: CtLoc -> CtOrigin
- GHC.Tc.Types.Constraint: [ctl_t_or_k] :: CtLoc -> Maybe TypeOrKind
- GHC.Tc.Types.Constraint: adjustCtLoc :: Bool -> Bool -> CtLoc -> CtLoc
- GHC.Tc.Types.Constraint: adjustCtLocTyConBinder :: TyConBinder -> CtLoc -> CtLoc
- GHC.Tc.Types.Constraint: bumpCtLocDepth :: CtLoc -> CtLoc
- GHC.Tc.Types.Constraint: bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth
- GHC.Tc.Types.Constraint: ctEvRole :: CtEvidence -> Role
- GHC.Tc.Types.Constraint: ctLocDepth :: CtLoc -> SubGoalDepth
- GHC.Tc.Types.Constraint: ctLocEnv :: CtLoc -> CtLocEnv
- GHC.Tc.Types.Constraint: ctLocLevel :: CtLoc -> TcLevel
- GHC.Tc.Types.Constraint: ctLocOrigin :: CtLoc -> CtOrigin
- GHC.Tc.Types.Constraint: ctLocSpan :: CtLoc -> RealSrcSpan
- GHC.Tc.Types.Constraint: ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind
- GHC.Tc.Types.Constraint: data CtLoc
- GHC.Tc.Types.Constraint: data SubGoalDepth
- GHC.Tc.Types.Constraint: initialSubGoalDepth :: SubGoalDepth
- GHC.Tc.Types.Constraint: instance GHC.Classes.Eq GHC.Tc.Types.Constraint.SubGoalDepth
- GHC.Tc.Types.Constraint: instance GHC.Classes.Ord GHC.Tc.Types.Constraint.SubGoalDepth
- GHC.Tc.Types.Constraint: instance GHC.Utils.Outputable.Outputable GHC.Tc.Types.Constraint.SubGoalDepth
- GHC.Tc.Types.Constraint: isGivenLoc :: CtLoc -> Bool
- GHC.Tc.Types.Constraint: maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth
- GHC.Tc.Types.Constraint: mkGivenLoc :: TcLevel -> SkolemInfoAnon -> CtLocEnv -> CtLoc
- GHC.Tc.Types.Constraint: mkKindEqLoc :: TcType -> TcType -> CtLoc -> CtLoc
- GHC.Tc.Types.Constraint: pprCtLoc :: CtLoc -> SDoc
- GHC.Tc.Types.Constraint: setCtLocEnv :: CtLoc -> CtLocEnv -> CtLoc
- GHC.Tc.Types.Constraint: setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
- GHC.Tc.Types.Constraint: setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc
- GHC.Tc.Types.Constraint: subGoalDepthExceeded :: IntWithInf -> SubGoalDepth -> Bool
- GHC.Tc.Types.Constraint: toInvisibleLoc :: CtLoc -> CtLoc
- GHC.Tc.Types.Constraint: toKindLoc :: CtLoc -> CtLoc
- GHC.Tc.Types.Constraint: updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc
- GHC.Tc.Types.CtLocEnv: CtLocEnv :: ![ErrCtxt] -> !RealSrcSpan -> !TcBinderStack -> !TcLevel -> !Bool -> !LocalRdrEnv -> CtLocEnv
- GHC.Tc.Types.CtLocEnv: [ctl_bndrs] :: CtLocEnv -> !TcBinderStack
- GHC.Tc.Types.CtLocEnv: [ctl_ctxt] :: CtLocEnv -> ![ErrCtxt]
- GHC.Tc.Types.CtLocEnv: [ctl_in_gen_code] :: CtLocEnv -> !Bool
- GHC.Tc.Types.CtLocEnv: [ctl_loc] :: CtLocEnv -> !RealSrcSpan
- GHC.Tc.Types.CtLocEnv: [ctl_rdr] :: CtLocEnv -> !LocalRdrEnv
- GHC.Tc.Types.CtLocEnv: [ctl_tclvl] :: CtLocEnv -> !TcLevel
- GHC.Tc.Types.CtLocEnv: ctLocEnvInGeneratedCode :: CtLocEnv -> Bool
- GHC.Tc.Types.CtLocEnv: data CtLocEnv
- GHC.Tc.Types.CtLocEnv: getCtLocEnvLoc :: CtLocEnv -> RealSrcSpan
- GHC.Tc.Types.CtLocEnv: getCtLocEnvLvl :: CtLocEnv -> TcLevel
- GHC.Tc.Types.CtLocEnv: setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv
- GHC.Tc.Types.CtLocEnv: setCtLocEnvLvl :: CtLocEnv -> TcLevel -> CtLocEnv
- GHC.Tc.Types.CtLocEnv: setCtLocRealLoc :: CtLocEnv -> RealSrcSpan -> CtLocEnv
- GHC.Tc.Utils.TcType: instance GHC.Classes.Eq GHC.Tc.Utils.TcType.TcLevel
- GHC.Tc.Utils.TcType: instance GHC.Classes.Ord GHC.Tc.Utils.TcType.TcLevel
- GHC.Tc.Utils.TcType: newtype TcLevel
- GHC.Tc.Utils.TcType: nonDetCmpTypes :: [Type] -> [Type] -> Ordering
- GHC.Types.CompleteMatch: data CompleteMatch
- GHC.Types.CompleteMatch: instance GHC.Utils.Outputable.Outputable GHC.Types.CompleteMatch.CompleteMatch
- GHC.Types.Fixity: instance Data.Data.Data GHC.Types.Fixity.Fixity
- GHC.Types.Fixity: instance Data.Data.Data GHC.Types.Fixity.FixityDirection
- GHC.Types.Fixity: instance Data.Data.Data GHC.Types.Fixity.LexicalFixity
- GHC.Types.Fixity: instance GHC.Classes.Eq GHC.Types.Fixity.Fixity
- GHC.Types.Fixity: instance GHC.Classes.Eq GHC.Types.Fixity.FixityDirection
- GHC.Types.Fixity: instance GHC.Classes.Eq GHC.Types.Fixity.LexicalFixity
- GHC.Types.Fixity: instance GHC.Utils.Binary.Binary GHC.Types.Fixity.Fixity
- GHC.Types.Fixity: instance GHC.Utils.Binary.Binary GHC.Types.Fixity.FixityDirection
- GHC.Types.Fixity: instance GHC.Utils.Outputable.Outputable GHC.Types.Fixity.Fixity
- GHC.Types.Fixity: instance GHC.Utils.Outputable.Outputable GHC.Types.Fixity.FixityDirection
- GHC.Types.Fixity: instance GHC.Utils.Outputable.Outputable GHC.Types.Fixity.LexicalFixity
- GHC.Types.ForeignCall: ccallConvToInt :: CCallConv -> Int
- GHC.Types.Var: instance Control.DeepSeq.NFData GHC.Types.Var.ForAllTyFlag
- GHC.Types.Var: instance Control.DeepSeq.NFData GHC.Types.Var.Specificity
- GHC.Types.Var: instance Data.Data.Data GHC.Types.Var.ForAllTyFlag
- GHC.Types.Var: instance Data.Data.Data GHC.Types.Var.Specificity
- GHC.Types.Var: instance GHC.Classes.Eq GHC.Types.Var.ForAllTyFlag
- GHC.Types.Var: instance GHC.Classes.Eq GHC.Types.Var.Specificity
- GHC.Types.Var: instance GHC.Classes.Ord GHC.Types.Var.ForAllTyFlag
- GHC.Types.Var: instance GHC.Classes.Ord GHC.Types.Var.Specificity
- GHC.Types.Var: instance GHC.Utils.Binary.Binary GHC.Types.Var.ForAllTyFlag
- GHC.Types.Var: instance GHC.Utils.Binary.Binary GHC.Types.Var.Specificity
- GHC.Types.Var: instance GHC.Utils.Outputable.Outputable GHC.Types.Var.ForAllTyFlag
- GHC.Types.Var: instance GHC.Utils.Outputable.Outputable tv => GHC.Utils.Outputable.Outputable (GHC.Types.Var.VarBndr tv GHC.Types.Var.ForAllTyFlag)
- GHC.Types.Var: instance GHC.Utils.Outputable.Outputable tv => GHC.Utils.Outputable.Outputable (GHC.Types.Var.VarBndr tv GHC.Types.Var.Specificity)
- GHC.Unit.Finder.Types: [fcFileCache] :: FinderCache -> IORef FileCacheState
- GHC.Unit.Finder.Types: [fcModuleCache] :: FinderCache -> IORef FinderCacheState
- GHC.Unit.Finder.Types: instance GHC.Show.Show GHC.Unit.Finder.Types.FinderOpts
- GHC.Unit.Module.Location: ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
- GHC.Unit.Module.Location: [ml_dyn_hi_file] :: ModLocation -> FilePath
- GHC.Unit.Module.Location: [ml_dyn_obj_file] :: ModLocation -> FilePath
- GHC.Unit.Module.Location: [ml_hi_file] :: ModLocation -> FilePath
- GHC.Unit.Module.Location: [ml_hie_file] :: ModLocation -> FilePath
- GHC.Unit.Module.Location: [ml_hs_file] :: ModLocation -> Maybe FilePath
- GHC.Unit.Module.Location: [ml_obj_file] :: ModLocation -> FilePath
- GHC.Unit.Module.ModGuts: [cg_hpc_info] :: CgGuts -> !HpcInfo
- GHC.Unit.Module.ModIface: ModIface :: !Module -> !Maybe Module -> !HscSource -> Dependencies -> [Usage] -> ![IfaceExport] -> !Bool -> [(OccName, Fixity)] -> IfaceWarnings -> [IfaceAnnotation] -> [IfaceDeclExts phase] -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> !Maybe IfGlobalRdrEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] -> !AnyHpcUsage -> !IfaceTrustInfo -> !Bool -> ![IfaceCompleteMatch] -> !Maybe Docs -> !IfaceBackendExts phase -> !ExtensibleFields -> !Fingerprint -> ModIface_ (phase :: ModIfacePhase)
- GHC.Unit.Module.ModIface: [mi_anns] :: ModIface_ (phase :: ModIfacePhase) -> [IfaceAnnotation]
- GHC.Unit.Module.ModIface: [mi_complete_matches] :: ModIface_ (phase :: ModIfacePhase) -> ![IfaceCompleteMatch]
- GHC.Unit.Module.ModIface: [mi_decls] :: ModIface_ (phase :: ModIfacePhase) -> [IfaceDeclExts phase]
- GHC.Unit.Module.ModIface: [mi_deps] :: ModIface_ (phase :: ModIfacePhase) -> Dependencies
- GHC.Unit.Module.ModIface: [mi_docs] :: ModIface_ (phase :: ModIfacePhase) -> !Maybe Docs
- GHC.Unit.Module.ModIface: [mi_exports] :: ModIface_ (phase :: ModIfacePhase) -> ![IfaceExport]
- GHC.Unit.Module.ModIface: [mi_ext_fields] :: ModIface_ (phase :: ModIfacePhase) -> !ExtensibleFields
- GHC.Unit.Module.ModIface: [mi_extra_decls] :: ModIface_ (phase :: ModIfacePhase) -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
- GHC.Unit.Module.ModIface: [mi_fam_insts] :: ModIface_ (phase :: ModIfacePhase) -> [IfaceFamInst]
- GHC.Unit.Module.ModIface: [mi_final_exts] :: ModIface_ (phase :: ModIfacePhase) -> !IfaceBackendExts phase
- GHC.Unit.Module.ModIface: [mi_fixities] :: ModIface_ (phase :: ModIfacePhase) -> [(OccName, Fixity)]
- GHC.Unit.Module.ModIface: [mi_globals] :: ModIface_ (phase :: ModIfacePhase) -> !Maybe IfGlobalRdrEnv
- GHC.Unit.Module.ModIface: [mi_hpc] :: ModIface_ (phase :: ModIfacePhase) -> !AnyHpcUsage
- GHC.Unit.Module.ModIface: [mi_hsc_src] :: ModIface_ (phase :: ModIfacePhase) -> !HscSource
- GHC.Unit.Module.ModIface: [mi_insts] :: ModIface_ (phase :: ModIfacePhase) -> [IfaceClsInst]
- GHC.Unit.Module.ModIface: [mi_module] :: ModIface_ (phase :: ModIfacePhase) -> !Module
- GHC.Unit.Module.ModIface: [mi_rules] :: ModIface_ (phase :: ModIfacePhase) -> [IfaceRule]
- GHC.Unit.Module.ModIface: [mi_sig_of] :: ModIface_ (phase :: ModIfacePhase) -> !Maybe Module
- GHC.Unit.Module.ModIface: [mi_src_hash] :: ModIface_ (phase :: ModIfacePhase) -> !Fingerprint
- GHC.Unit.Module.ModIface: [mi_trust] :: ModIface_ (phase :: ModIfacePhase) -> !IfaceTrustInfo
- GHC.Unit.Module.ModIface: [mi_trust_pkg] :: ModIface_ (phase :: ModIfacePhase) -> !Bool
- GHC.Unit.Module.ModIface: [mi_usages] :: ModIface_ (phase :: ModIfacePhase) -> [Usage]
- GHC.Unit.Module.ModIface: [mi_used_th] :: ModIface_ (phase :: ModIfacePhase) -> !Bool
- GHC.Unit.Module.ModIface: [mi_warns] :: ModIface_ (phase :: ModIfacePhase) -> IfaceWarnings
- GHC.Unit.State: implicitPackageDeps :: DynFlags -> [UnitId]
- GHC.Unit.Types: baseUnit :: Unit
- GHC.Unit.Types: baseUnitId :: UnitId
- GHC.Unit.Types: experimentalUnit :: Unit
- GHC.Unit.Types: thUnit :: Unit
- GHC.Unit.Types: thUnitId :: UnitId
- GHC.Utils.Binary: UserData :: (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> (BinHandle -> Name -> IO ()) -> (BinHandle -> Name -> IO ()) -> (BinHandle -> FastString -> IO ()) -> UserData
- GHC.Utils.Binary: [ud_get_fs] :: UserData -> BinHandle -> IO FastString
- GHC.Utils.Binary: [ud_get_name] :: UserData -> BinHandle -> IO Name
- GHC.Utils.Binary: [ud_put_binding_name] :: UserData -> BinHandle -> Name -> IO ()
- GHC.Utils.Binary: [ud_put_fs] :: UserData -> BinHandle -> FastString -> IO ()
- GHC.Utils.Binary: [ud_put_nonbinding_name] :: UserData -> BinHandle -> Name -> IO ()
- GHC.Utils.Binary: data BinHandle
- GHC.Utils.Binary: data UserData
- GHC.Utils.Binary: getUserData :: BinHandle -> UserData
- GHC.Utils.Binary: initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int)
- GHC.Utils.Binary: noUserData :: UserData
- GHC.Utils.Binary: seekBin :: forall {k} (a :: k). BinHandle -> Bin a -> IO ()
- GHC.Utils.Binary: setUserData :: BinHandle -> UserData -> BinHandle
- GHC.Utils.Binary: tellBin :: forall {k} (a :: k). BinHandle -> IO (Bin a)
- GHC.Utils.Monad.State.Strict: data State s a
- GHC.Utils.Outputable: instance GHC.Utils.Outputable.Outputable GHC.LanguageExtensions.Type.Extension
- GHCi.FFI: FFICCall :: FFIConv
- GHCi.FFI: FFIStdCall :: FFIConv
- GHCi.FFI: data FFIConv
- GHCi.FFI: instance Data.Binary.Class.Binary GHCi.FFI.FFIConv
- GHCi.FFI: instance GHC.Generics.Generic GHCi.FFI.FFIConv
- GHCi.FFI: instance GHC.Show.Show GHCi.FFI.FFIConv
- GHCi.ResolvedBCO: instance forall k (a :: k). Data.Binary.Class.Binary (GHCi.ResolvedBCO.BCOByteArray a)
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.AnnLookup
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.AnnTarget
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Bang
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.BndrVis
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Body
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Bytes
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Callconv
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Clause
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Con
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Dec
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.DecidedStrictness
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.DerivClause
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.DerivStrategy
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.DocLoc
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Exp
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.FamilyResultSig
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Fixity
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.FixityDirection
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Foreign
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.FunDep
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Guard
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Info
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.InjectivityAnn
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Inline
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Lit
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Loc
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Match
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.ModName
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Module
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.ModuleInfo
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Name
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.NameFlavour
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.NameSpace
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.NamespaceSpecifier
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.OccName
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Overlap
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Pat
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.PatSynArgs
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.PatSynDir
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Phases
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.PkgName
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Pragma
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Range
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Role
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.RuleBndr
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.RuleMatch
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Safety
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.SourceStrictness
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.SourceUnpackedness
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Specificity
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Stmt
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.TyLit
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.TySynEqn
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.Type
- GHCi.TH.Binary: instance Data.Binary.Class.Binary Language.Haskell.TH.Syntax.TypeFamilyHead
- GHCi.TH.Binary: instance Data.Binary.Class.Binary flag => Data.Binary.Class.Binary (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.Syntax.Expr: ApplicativeArgMany :: XApplicativeArgMany idL -> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> HsDoFlavour -> ApplicativeArg idL
- Language.Haskell.Syntax.Expr: ApplicativeArgOne :: XApplicativeArgOne idL -> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
- Language.Haskell.Syntax.Expr: ApplicativeStmt :: XApplicativeStmt idL idR body -> [(SyntaxExpr idR, ApplicativeArg idL)] -> Maybe (SyntaxExpr idR) -> StmtLR idL idR body
- Language.Haskell.Syntax.Expr: HsRecSel :: XRecSel p -> FieldOcc p -> HsExpr p
- Language.Haskell.Syntax.Expr: XApplicativeArg :: !XXApplicativeArg idL -> ApplicativeArg idL
- Language.Haskell.Syntax.Expr: [app_arg_pattern] :: ApplicativeArg idL -> LPat idL
- Language.Haskell.Syntax.Expr: [app_stmts] :: ApplicativeArg idL -> [ExprLStmt idL]
- Language.Haskell.Syntax.Expr: [arg_expr] :: ApplicativeArg idL -> LHsExpr idL
- Language.Haskell.Syntax.Expr: [bv_pattern] :: ApplicativeArg idL -> LPat idL
- Language.Haskell.Syntax.Expr: [final_expr] :: ApplicativeArg idL -> HsExpr idL
- Language.Haskell.Syntax.Expr: [is_body_stmt] :: ApplicativeArg idL -> Bool
- Language.Haskell.Syntax.Expr: [stmt_context] :: ApplicativeArg idL -> HsDoFlavour
- Language.Haskell.Syntax.Expr: [xarg_app_arg_many] :: ApplicativeArg idL -> XApplicativeArgMany idL
- Language.Haskell.Syntax.Expr: [xarg_app_arg_one] :: ApplicativeArg idL -> XApplicativeArgOne idL
- Language.Haskell.Syntax.Expr: data ApplicativeArg idL
- Language.Haskell.Syntax.Lit: instance GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XXOverLit p) => GHC.Classes.Eq (Language.Haskell.Syntax.Lit.HsOverLit p)
- Language.Haskell.Syntax.Lit: instance GHC.Classes.Ord (Language.Haskell.Syntax.Extension.XXOverLit p) => GHC.Classes.Ord (Language.Haskell.Syntax.Lit.HsOverLit p)
- Language.Haskell.Syntax.Lit: negateOverLitVal :: OverLitVal -> OverLitVal
- Language.Haskell.Syntax.Module.Name: instance Data.Data.Data Language.Haskell.Syntax.Module.Name.ModuleName
- Language.Haskell.Syntax.Type: Ambiguous :: XAmbiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
- Language.Haskell.Syntax.Type: HsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
- Language.Haskell.Syntax.Type: KindedTyVar :: XKindedTyVar pass -> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
- Language.Haskell.Syntax.Type: Unambiguous :: XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
- Language.Haskell.Syntax.Type: UserTyVar :: XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
- Language.Haskell.Syntax.Type: XAmbiguousFieldOcc :: !XXAmbiguousFieldOcc pass -> AmbiguousFieldOcc pass
- Language.Haskell.Syntax.Type: XXBndrVis :: !XXBndrVis pass -> HsBndrVis pass
- Language.Haskell.Syntax.Type: conDetailsArity :: (rec -> Arity) -> HsConDetails tyarg arg rec -> Arity
- Language.Haskell.Syntax.Type: data AmbiguousFieldOcc pass
- Language.Haskell.Syntax.Type: data HsArrow pass
- Language.Haskell.Syntax.Type: data HsSrcBang
- Language.Haskell.Syntax.Type: instance (GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XRec pass GHC.Types.Name.Reader.RdrName), GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XCFieldOcc pass), GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XXFieldOcc pass)) => GHC.Classes.Eq (Language.Haskell.Syntax.Type.FieldOcc pass)
- Language.Haskell.Syntax.Type: type LAmbiguousFieldOcc pass = XRec pass AmbiguousFieldOcc pass
- Language.Haskell.TH: AllPhases :: Phases
- Language.Haskell.TH: AllowAmbiguousTypes :: Extension
- Language.Haskell.TH: AlternativeLayoutRule :: Extension
- Language.Haskell.TH: AlternativeLayoutRuleTransitional :: Extension
- Language.Haskell.TH: AnnLookupModule :: Module -> AnnLookup
- Language.Haskell.TH: AnnLookupName :: Name -> AnnLookup
- Language.Haskell.TH: AnnP :: AnnTarget -> Exp -> Pragma
- Language.Haskell.TH: AppE :: Exp -> Exp -> Exp
- Language.Haskell.TH: AppKindT :: Type -> Kind -> Type
- Language.Haskell.TH: AppT :: Type -> Type -> Type
- Language.Haskell.TH: AppTypeE :: Exp -> Type -> Exp
- Language.Haskell.TH: ApplicativeDo :: Extension
- Language.Haskell.TH: ArgDoc :: Name -> Int -> DocLoc
- Language.Haskell.TH: ArithSeqE :: Range -> Exp
- Language.Haskell.TH: ArrowT :: Type
- Language.Haskell.TH: Arrows :: Extension
- Language.Haskell.TH: AsP :: Name -> Pat -> Pat
- Language.Haskell.TH: AutoDeriveTypeable :: Extension
- Language.Haskell.TH: Bang :: SourceUnpackedness -> SourceStrictness -> Bang
- Language.Haskell.TH: BangP :: Pat -> Pat
- Language.Haskell.TH: BangPatterns :: Extension
- Language.Haskell.TH: BeforePhase :: Int -> Phases
- Language.Haskell.TH: BinaryLiterals :: Extension
- Language.Haskell.TH: BindS :: Pat -> Exp -> Stmt
- Language.Haskell.TH: BlockArguments :: Extension
- Language.Haskell.TH: BndrInvis :: BndrVis
- Language.Haskell.TH: BndrReq :: BndrVis
- Language.Haskell.TH: BytesPrimL :: Bytes -> Lit
- Language.Haskell.TH: CApi :: Callconv
- Language.Haskell.TH: CApiFFI :: Extension
- Language.Haskell.TH: CCall :: Callconv
- Language.Haskell.TH: CUSKs :: Extension
- Language.Haskell.TH: CaseE :: Exp -> [Match] -> Exp
- Language.Haskell.TH: CharL :: Char -> Lit
- Language.Haskell.TH: CharPrimL :: Char -> Lit
- Language.Haskell.TH: CharTyLit :: Char -> TyLit
- Language.Haskell.TH: ClassD :: Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [Dec] -> Dec
- Language.Haskell.TH: ClassI :: Dec -> [InstanceDec] -> Info
- Language.Haskell.TH: ClassOpI :: Name -> Type -> ParentName -> Info
- Language.Haskell.TH: Clause :: [Pat] -> Body -> [Dec] -> Clause
- Language.Haskell.TH: ClosedTypeFamilyD :: TypeFamilyHead -> [TySynEqn] -> Dec
- Language.Haskell.TH: Code :: m (TExp a) -> Code (m :: Type -> Type) (a :: TYPE r)
- Language.Haskell.TH: CompE :: [Stmt] -> Exp
- Language.Haskell.TH: CompleteP :: [Name] -> Maybe Name -> Pragma
- Language.Haskell.TH: ConE :: Name -> Exp
- Language.Haskell.TH: ConLike :: RuleMatch
- Language.Haskell.TH: ConP :: Name -> [Type] -> [Pat] -> Pat
- Language.Haskell.TH: ConT :: Name -> Type
- Language.Haskell.TH: CondE :: Exp -> Exp -> Exp -> Exp
- Language.Haskell.TH: ConstrainedClassMethods :: Extension
- Language.Haskell.TH: ConstraintKinds :: Extension
- Language.Haskell.TH: ConstraintT :: Type
- Language.Haskell.TH: Cpp :: Extension
- Language.Haskell.TH: DataConI :: Name -> Type -> ParentName -> Info
- Language.Haskell.TH: DataD :: Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [Con] -> [DerivClause] -> Dec
- Language.Haskell.TH: DataFamilyD :: Name -> [TyVarBndr BndrVis] -> Maybe Kind -> Dec
- Language.Haskell.TH: DataInstD :: Cxt -> Maybe [TyVarBndr ()] -> Type -> Maybe Kind -> [Con] -> [DerivClause] -> Dec
- Language.Haskell.TH: DataKinds :: Extension
- Language.Haskell.TH: DataNamespaceSpecifier :: NamespaceSpecifier
- Language.Haskell.TH: DatatypeContexts :: Extension
- Language.Haskell.TH: DecidedLazy :: DecidedStrictness
- Language.Haskell.TH: DecidedStrict :: DecidedStrictness
- Language.Haskell.TH: DecidedUnpack :: DecidedStrictness
- Language.Haskell.TH: DeclDoc :: Name -> DocLoc
- Language.Haskell.TH: DeepSubsumption :: Extension
- Language.Haskell.TH: DefaultD :: [Type] -> Dec
- Language.Haskell.TH: DefaultSigD :: Name -> Type -> Dec
- Language.Haskell.TH: DefaultSignatures :: Extension
- Language.Haskell.TH: DeriveAnyClass :: Extension
- Language.Haskell.TH: DeriveDataTypeable :: Extension
- Language.Haskell.TH: DeriveFoldable :: Extension
- Language.Haskell.TH: DeriveFunctor :: Extension
- Language.Haskell.TH: DeriveGeneric :: Extension
- Language.Haskell.TH: DeriveLift :: Extension
- Language.Haskell.TH: DeriveTraversable :: Extension
- Language.Haskell.TH: DerivingStrategies :: Extension
- Language.Haskell.TH: DerivingVia :: Extension
- Language.Haskell.TH: DisambiguateRecordFields :: Extension
- Language.Haskell.TH: DoAndIfThenElse :: Extension
- Language.Haskell.TH: DoE :: Maybe ModName -> [Stmt] -> Exp
- Language.Haskell.TH: DoublePrimL :: Rational -> Lit
- Language.Haskell.TH: DuplicateRecordFields :: Extension
- Language.Haskell.TH: EmptyCase :: Extension
- Language.Haskell.TH: EmptyDataDecls :: Extension
- Language.Haskell.TH: EmptyDataDeriving :: Extension
- Language.Haskell.TH: EqualityT :: Type
- Language.Haskell.TH: ExistentialQuantification :: Extension
- Language.Haskell.TH: ExplBidir :: [Clause] -> PatSynDir
- Language.Haskell.TH: ExplicitForAll :: Extension
- Language.Haskell.TH: ExplicitNamespaces :: Extension
- Language.Haskell.TH: ExportF :: Callconv -> String -> Name -> Type -> Foreign
- Language.Haskell.TH: ExtendedDefaultRules :: Extension
- Language.Haskell.TH: ExtendedLiterals :: Extension
- Language.Haskell.TH: FamilyI :: Dec -> [InstanceDec] -> Info
- Language.Haskell.TH: FieldSelectors :: Extension
- Language.Haskell.TH: Fixity :: Int -> FixityDirection -> Fixity
- Language.Haskell.TH: FlexibleContexts :: Extension
- Language.Haskell.TH: FlexibleInstances :: Extension
- Language.Haskell.TH: FloatPrimL :: Rational -> Lit
- Language.Haskell.TH: ForallC :: [TyVarBndr Specificity] -> Cxt -> Con -> Con
- Language.Haskell.TH: ForallT :: [TyVarBndr Specificity] -> Cxt -> Type -> Type
- Language.Haskell.TH: ForallVisT :: [TyVarBndr ()] -> Type -> Type
- Language.Haskell.TH: ForeignD :: Foreign -> Dec
- Language.Haskell.TH: ForeignFunctionInterface :: Extension
- Language.Haskell.TH: FromPhase :: Int -> Phases
- Language.Haskell.TH: FromR :: Exp -> Range
- Language.Haskell.TH: FromThenR :: Exp -> Exp -> Range
- Language.Haskell.TH: FromThenToR :: Exp -> Exp -> Exp -> Range
- Language.Haskell.TH: FromToR :: Exp -> Exp -> Range
- Language.Haskell.TH: FunD :: Name -> [Clause] -> Dec
- Language.Haskell.TH: FunDep :: [Name] -> [Name] -> FunDep
- Language.Haskell.TH: FunLike :: RuleMatch
- Language.Haskell.TH: FunctionalDependencies :: Extension
- Language.Haskell.TH: GADTSyntax :: Extension
- Language.Haskell.TH: GADTs :: Extension
- Language.Haskell.TH: GHCForeignImportPrim :: Extension
- Language.Haskell.TH: GadtC :: [Name] -> [BangType] -> Type -> Con
- Language.Haskell.TH: GeneralizedNewtypeDeriving :: Extension
- Language.Haskell.TH: GetFieldE :: Exp -> String -> Exp
- Language.Haskell.TH: GuardedB :: [(Guard, Exp)] -> Body
- Language.Haskell.TH: HexFloatLiterals :: Extension
- Language.Haskell.TH: ImplBidir :: PatSynDir
- Language.Haskell.TH: ImplicitParamBindD :: String -> Exp -> Dec
- Language.Haskell.TH: ImplicitParamT :: String -> Type -> Type
- Language.Haskell.TH: ImplicitParamVarE :: String -> Exp
- Language.Haskell.TH: ImplicitParams :: Extension
- Language.Haskell.TH: ImplicitPrelude :: Extension
- Language.Haskell.TH: ImportF :: Callconv -> Safety -> String -> Name -> Type -> Foreign
- Language.Haskell.TH: ImportQualifiedPost :: Extension
- Language.Haskell.TH: ImpredicativeTypes :: Extension
- Language.Haskell.TH: IncoherentInstances :: Extension
- Language.Haskell.TH: InferR :: Role
- Language.Haskell.TH: InferredSpec :: Specificity
- Language.Haskell.TH: InfixC :: BangType -> Name -> BangType -> Con
- Language.Haskell.TH: InfixD :: Fixity -> NamespaceSpecifier -> Name -> Dec
- Language.Haskell.TH: InfixE :: Maybe Exp -> Exp -> Maybe Exp -> Exp
- Language.Haskell.TH: InfixL :: FixityDirection
- Language.Haskell.TH: InfixN :: FixityDirection
- Language.Haskell.TH: InfixP :: Pat -> Name -> Pat -> Pat
- Language.Haskell.TH: InfixPatSyn :: Name -> Name -> PatSynArgs
- Language.Haskell.TH: InfixR :: FixityDirection
- Language.Haskell.TH: InfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH: InjectivityAnn :: Name -> [Name] -> InjectivityAnn
- Language.Haskell.TH: Inlinable :: Inline
- Language.Haskell.TH: Inline :: Inline
- Language.Haskell.TH: InlineP :: Name -> Inline -> RuleMatch -> Phases -> Pragma
- Language.Haskell.TH: InstDoc :: Type -> DocLoc
- Language.Haskell.TH: InstanceD :: Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
- Language.Haskell.TH: InstanceSigs :: Extension
- Language.Haskell.TH: IntPrimL :: Integer -> Lit
- Language.Haskell.TH: IntegerL :: Integer -> Lit
- Language.Haskell.TH: Interruptible :: Safety
- Language.Haskell.TH: InterruptibleFFI :: Extension
- Language.Haskell.TH: InvisP :: Type -> Pat
- Language.Haskell.TH: JavaScript :: Callconv
- Language.Haskell.TH: JavaScriptFFI :: Extension
- Language.Haskell.TH: KiSigD :: Name -> Kind -> Dec
- Language.Haskell.TH: KindSig :: Kind -> FamilyResultSig
- Language.Haskell.TH: KindSignatures :: Extension
- Language.Haskell.TH: KindedTV :: Name -> flag -> Kind -> TyVarBndr flag
- Language.Haskell.TH: LabelE :: String -> Exp
- Language.Haskell.TH: LamCaseE :: [Match] -> Exp
- Language.Haskell.TH: LamCasesE :: [Clause] -> Exp
- Language.Haskell.TH: LamE :: [Pat] -> Exp -> Exp
- Language.Haskell.TH: LambdaCase :: Extension
- Language.Haskell.TH: LetE :: [Dec] -> Exp -> Exp
- Language.Haskell.TH: LetS :: [Dec] -> Stmt
- Language.Haskell.TH: LexicalNegation :: Extension
- Language.Haskell.TH: LiberalTypeSynonyms :: Extension
- Language.Haskell.TH: LineP :: Int -> String -> Pragma
- Language.Haskell.TH: LinearTypes :: Extension
- Language.Haskell.TH: ListE :: [Exp] -> Exp
- Language.Haskell.TH: ListP :: [Pat] -> Pat
- Language.Haskell.TH: ListT :: Type
- Language.Haskell.TH: ListTuplePuns :: Extension
- Language.Haskell.TH: LitE :: Lit -> Exp
- Language.Haskell.TH: LitP :: Lit -> Pat
- Language.Haskell.TH: LitT :: TyLit -> Type
- Language.Haskell.TH: Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
- Language.Haskell.TH: MDoE :: Maybe ModName -> [Stmt] -> Exp
- Language.Haskell.TH: MagicHash :: Extension
- Language.Haskell.TH: Match :: Pat -> Body -> [Dec] -> Match
- Language.Haskell.TH: ModuleAnnotation :: AnnTarget
- Language.Haskell.TH: ModuleDoc :: DocLoc
- Language.Haskell.TH: ModuleInfo :: [Module] -> ModuleInfo
- Language.Haskell.TH: MonadComprehensions :: Extension
- Language.Haskell.TH: MonoLocalBinds :: Extension
- Language.Haskell.TH: MonomorphismRestriction :: Extension
- Language.Haskell.TH: MulArrowT :: Type
- Language.Haskell.TH: MultiIfE :: [(Guard, Exp)] -> Exp
- Language.Haskell.TH: MultiParamTypeClasses :: Extension
- Language.Haskell.TH: MultiWayIf :: Extension
- Language.Haskell.TH: NPlusKPatterns :: Extension
- Language.Haskell.TH: NamedFieldPuns :: Extension
- Language.Haskell.TH: NamedWildCards :: Extension
- Language.Haskell.TH: NegativeLiterals :: Extension
- Language.Haskell.TH: NewtypeD :: Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> Con -> [DerivClause] -> Dec
- Language.Haskell.TH: NewtypeInstD :: Cxt -> Maybe [TyVarBndr ()] -> Type -> Maybe Kind -> Con -> [DerivClause] -> Dec
- Language.Haskell.TH: NoBindS :: Exp -> Stmt
- Language.Haskell.TH: NoInline :: Inline
- Language.Haskell.TH: NoNamespaceSpecifier :: NamespaceSpecifier
- Language.Haskell.TH: NoSig :: FamilyResultSig
- Language.Haskell.TH: NoSourceStrictness :: SourceStrictness
- Language.Haskell.TH: NoSourceUnpackedness :: SourceUnpackedness
- Language.Haskell.TH: NominalR :: Role
- Language.Haskell.TH: NondecreasingIndentation :: Extension
- Language.Haskell.TH: NormalB :: Exp -> Body
- Language.Haskell.TH: NormalC :: Name -> [BangType] -> Con
- Language.Haskell.TH: NormalG :: Exp -> Guard
- Language.Haskell.TH: NullaryTypeClasses :: Extension
- Language.Haskell.TH: NumDecimals :: Extension
- Language.Haskell.TH: NumTyLit :: Integer -> TyLit
- Language.Haskell.TH: NumericUnderscores :: Extension
- Language.Haskell.TH: OpaqueP :: Name -> Pragma
- Language.Haskell.TH: OpenTypeFamilyD :: TypeFamilyHead -> Dec
- Language.Haskell.TH: OverlappingInstances :: Extension
- Language.Haskell.TH: OverloadedLabels :: Extension
- Language.Haskell.TH: OverloadedLists :: Extension
- Language.Haskell.TH: OverloadedRecordDot :: Extension
- Language.Haskell.TH: OverloadedRecordUpdate :: Extension
- Language.Haskell.TH: OverloadedStrings :: Extension
- Language.Haskell.TH: PackageImports :: Extension
- Language.Haskell.TH: ParS :: [[Stmt]] -> Stmt
- Language.Haskell.TH: ParallelArrays :: Extension
- Language.Haskell.TH: ParallelListComp :: Extension
- Language.Haskell.TH: ParensE :: Exp -> Exp
- Language.Haskell.TH: ParensP :: Pat -> Pat
- Language.Haskell.TH: ParensT :: Type -> Type
- Language.Haskell.TH: PartialTypeSignatures :: Extension
- Language.Haskell.TH: PatG :: [Stmt] -> Guard
- Language.Haskell.TH: PatSynD :: Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
- Language.Haskell.TH: PatSynI :: Name -> PatSynType -> Info
- Language.Haskell.TH: PatSynSigD :: Name -> PatSynType -> Dec
- Language.Haskell.TH: PatternGuards :: Extension
- Language.Haskell.TH: PatternSynonyms :: Extension
- Language.Haskell.TH: PhantomR :: Role
- Language.Haskell.TH: PlainTV :: Name -> flag -> TyVarBndr flag
- Language.Haskell.TH: PolyKinds :: Extension
- Language.Haskell.TH: PostfixOperators :: Extension
- Language.Haskell.TH: PragmaD :: Pragma -> Dec
- Language.Haskell.TH: PrefixPatSyn :: [Name] -> PatSynArgs
- Language.Haskell.TH: Prim :: Callconv
- Language.Haskell.TH: PrimTyConI :: Name -> Arity -> Unlifted -> Info
- Language.Haskell.TH: ProjectionE :: NonEmpty String -> Exp
- Language.Haskell.TH: PromotedConsT :: Type
- Language.Haskell.TH: PromotedInfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH: PromotedNilT :: Type
- Language.Haskell.TH: PromotedT :: Name -> Type
- Language.Haskell.TH: PromotedTupleT :: Int -> Type
- Language.Haskell.TH: PromotedUInfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH: QualifiedDo :: Extension
- Language.Haskell.TH: QuantifiedConstraints :: Extension
- Language.Haskell.TH: QuasiQuotes :: Extension
- Language.Haskell.TH: RankNTypes :: Extension
- Language.Haskell.TH: RationalL :: Rational -> Lit
- Language.Haskell.TH: RebindableSyntax :: Extension
- Language.Haskell.TH: RecC :: Name -> [VarBangType] -> Con
- Language.Haskell.TH: RecConE :: Name -> [FieldExp] -> Exp
- Language.Haskell.TH: RecGadtC :: [Name] -> [VarBangType] -> Type -> Con
- Language.Haskell.TH: RecP :: Name -> [FieldPat] -> Pat
- Language.Haskell.TH: RecS :: [Stmt] -> Stmt
- Language.Haskell.TH: RecUpdE :: Exp -> [FieldExp] -> Exp
- Language.Haskell.TH: RecordPatSyn :: [Name] -> PatSynArgs
- Language.Haskell.TH: RecordWildCards :: Extension
- Language.Haskell.TH: RecursiveDo :: Extension
- Language.Haskell.TH: RelaxedLayout :: Extension
- Language.Haskell.TH: RelaxedPolyRec :: Extension
- Language.Haskell.TH: RepresentationalR :: Role
- Language.Haskell.TH: RequiredTypeArguments :: Extension
- Language.Haskell.TH: RoleAnnotD :: Name -> [Role] -> Dec
- Language.Haskell.TH: RoleAnnotations :: Extension
- Language.Haskell.TH: RuleP :: String -> Maybe [TyVarBndr ()] -> [RuleBndr] -> Exp -> Exp -> Phases -> Pragma
- Language.Haskell.TH: RuleVar :: Name -> RuleBndr
- Language.Haskell.TH: SCCP :: Name -> Maybe String -> Pragma
- Language.Haskell.TH: Safe :: Safety
- Language.Haskell.TH: ScopedTypeVariables :: Extension
- Language.Haskell.TH: SigD :: Name -> Type -> Dec
- Language.Haskell.TH: SigE :: Exp -> Type -> Exp
- Language.Haskell.TH: SigP :: Pat -> Type -> Pat
- Language.Haskell.TH: SigT :: Type -> Kind -> Type
- Language.Haskell.TH: SourceLazy :: SourceStrictness
- Language.Haskell.TH: SourceNoUnpack :: SourceUnpackedness
- Language.Haskell.TH: SourceStrict :: SourceStrictness
- Language.Haskell.TH: SourceUnpack :: SourceUnpackedness
- Language.Haskell.TH: SpecialiseInstP :: Type -> Pragma
- Language.Haskell.TH: SpecialiseP :: Name -> Type -> Maybe Inline -> Phases -> Pragma
- Language.Haskell.TH: SpecifiedSpec :: Specificity
- Language.Haskell.TH: StandaloneDerivD :: Maybe DerivStrategy -> Cxt -> Type -> Dec
- Language.Haskell.TH: StandaloneDeriving :: Extension
- Language.Haskell.TH: StandaloneKindSignatures :: Extension
- Language.Haskell.TH: StarIsType :: Extension
- Language.Haskell.TH: StarT :: Type
- Language.Haskell.TH: StaticE :: Exp -> Exp
- Language.Haskell.TH: StaticPointers :: Extension
- Language.Haskell.TH: StdCall :: Callconv
- Language.Haskell.TH: StrTyLit :: String -> TyLit
- Language.Haskell.TH: Strict :: Extension
- Language.Haskell.TH: StrictData :: Extension
- Language.Haskell.TH: StringL :: String -> Lit
- Language.Haskell.TH: StringPrimL :: [Word8] -> Lit
- Language.Haskell.TH: TemplateHaskell :: Extension
- Language.Haskell.TH: TemplateHaskellQuotes :: Extension
- Language.Haskell.TH: TildeP :: Pat -> Pat
- Language.Haskell.TH: TraditionalRecordSyntax :: Extension
- Language.Haskell.TH: TransformListComp :: Extension
- Language.Haskell.TH: TupE :: [Maybe Exp] -> Exp
- Language.Haskell.TH: TupP :: [Pat] -> Pat
- Language.Haskell.TH: TupleSections :: Extension
- Language.Haskell.TH: TupleT :: Int -> Type
- Language.Haskell.TH: TyConI :: Dec -> Info
- Language.Haskell.TH: TySynD :: Name -> [TyVarBndr BndrVis] -> Type -> Dec
- Language.Haskell.TH: TySynEqn :: Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
- Language.Haskell.TH: TySynInstD :: TySynEqn -> Dec
- Language.Haskell.TH: TyVarI :: Name -> Type -> Info
- Language.Haskell.TH: TyVarSig :: TyVarBndr () -> FamilyResultSig
- Language.Haskell.TH: TypeAbstractions :: Extension
- Language.Haskell.TH: TypeAnnotation :: Name -> AnnTarget
- Language.Haskell.TH: TypeApplications :: Extension
- Language.Haskell.TH: TypeData :: Extension
- Language.Haskell.TH: TypeDataD :: Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [Con] -> Dec
- Language.Haskell.TH: TypeE :: Type -> Exp
- Language.Haskell.TH: TypeFamilies :: Extension
- Language.Haskell.TH: TypeFamilyDependencies :: Extension
- Language.Haskell.TH: TypeFamilyHead :: Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> TypeFamilyHead
- Language.Haskell.TH: TypeInType :: Extension
- Language.Haskell.TH: TypeNamespaceSpecifier :: NamespaceSpecifier
- Language.Haskell.TH: TypeOperators :: Extension
- Language.Haskell.TH: TypeP :: Type -> Pat
- Language.Haskell.TH: TypeSynonymInstances :: Extension
- Language.Haskell.TH: TypedBracketE :: Exp -> Exp
- Language.Haskell.TH: TypedRuleVar :: Name -> Type -> RuleBndr
- Language.Haskell.TH: TypedSpliceE :: Exp -> Exp
- Language.Haskell.TH: UInfixE :: Exp -> Exp -> Exp -> Exp
- Language.Haskell.TH: UInfixP :: Pat -> Name -> Pat -> Pat
- Language.Haskell.TH: UInfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH: UnboundVarE :: Name -> Exp
- Language.Haskell.TH: UnboxedSumE :: Exp -> SumAlt -> SumArity -> Exp
- Language.Haskell.TH: UnboxedSumP :: Pat -> SumAlt -> SumArity -> Pat
- Language.Haskell.TH: UnboxedSumT :: SumArity -> Type
- Language.Haskell.TH: UnboxedSums :: Extension
- Language.Haskell.TH: UnboxedTupE :: [Maybe Exp] -> Exp
- Language.Haskell.TH: UnboxedTupP :: [Pat] -> Pat
- Language.Haskell.TH: UnboxedTupleT :: Int -> Type
- Language.Haskell.TH: UnboxedTuples :: Extension
- Language.Haskell.TH: UndecidableInstances :: Extension
- Language.Haskell.TH: UndecidableSuperClasses :: Extension
- Language.Haskell.TH: UnicodeSyntax :: Extension
- Language.Haskell.TH: Unidir :: PatSynDir
- Language.Haskell.TH: UnliftedDatatypes :: Extension
- Language.Haskell.TH: UnliftedFFITypes :: Extension
- Language.Haskell.TH: UnliftedNewtypes :: Extension
- Language.Haskell.TH: Unsafe :: Safety
- Language.Haskell.TH: ValD :: Pat -> Body -> [Dec] -> Dec
- Language.Haskell.TH: ValueAnnotation :: Name -> AnnTarget
- Language.Haskell.TH: VarE :: Name -> Exp
- Language.Haskell.TH: VarI :: Name -> Type -> Maybe Dec -> Info
- Language.Haskell.TH: VarP :: Name -> Pat
- Language.Haskell.TH: VarT :: Name -> Type
- Language.Haskell.TH: ViewP :: Exp -> Pat -> Pat
- Language.Haskell.TH: ViewPatterns :: Extension
- Language.Haskell.TH: WildCardT :: Type
- Language.Haskell.TH: WildP :: Pat
- Language.Haskell.TH: WordPrimL :: Integer -> Lit
- Language.Haskell.TH: [examineCode] :: Code (m :: Type -> Type) (a :: TYPE r) -> m (TExp a)
- Language.Haskell.TH: [loc_end] :: Loc -> CharPos
- Language.Haskell.TH: [loc_filename] :: Loc -> String
- Language.Haskell.TH: [loc_module] :: Loc -> String
- Language.Haskell.TH: [loc_package] :: Loc -> String
- Language.Haskell.TH: [loc_start] :: Loc -> CharPos
- Language.Haskell.TH: bindCode :: Monad m => m a -> (a -> Code m b) -> Code m b
- Language.Haskell.TH: bindCode_ :: Monad m => m a -> Code m b -> Code m b
- Language.Haskell.TH: class Ppr a
- Language.Haskell.TH: class Monad m => Quote (m :: Type -> Type)
- Language.Haskell.TH: data AnnLookup
- Language.Haskell.TH: data AnnTarget
- Language.Haskell.TH: data Bang
- Language.Haskell.TH: data BndrVis
- Language.Haskell.TH: data Body
- Language.Haskell.TH: data Callconv
- Language.Haskell.TH: data Clause
- Language.Haskell.TH: data Con
- Language.Haskell.TH: data Dec
- Language.Haskell.TH: data DecidedStrictness
- Language.Haskell.TH: data DocLoc
- Language.Haskell.TH: data Exp
- Language.Haskell.TH: data Extension
- Language.Haskell.TH: data FamilyResultSig
- Language.Haskell.TH: data Fixity
- Language.Haskell.TH: data FixityDirection
- Language.Haskell.TH: data Foreign
- Language.Haskell.TH: data FunDep
- Language.Haskell.TH: data Guard
- Language.Haskell.TH: data Info
- Language.Haskell.TH: data InjectivityAnn
- Language.Haskell.TH: data Inline
- Language.Haskell.TH: data Lit
- Language.Haskell.TH: data Loc
- Language.Haskell.TH: data Match
- Language.Haskell.TH: data ModuleInfo
- Language.Haskell.TH: data Name
- Language.Haskell.TH: data NameSpace
- Language.Haskell.TH: data NamespaceSpecifier
- Language.Haskell.TH: data Pat
- Language.Haskell.TH: data PatSynArgs
- Language.Haskell.TH: data PatSynDir
- Language.Haskell.TH: data Phases
- Language.Haskell.TH: data Pragma
- Language.Haskell.TH: data Q a
- Language.Haskell.TH: data Range
- Language.Haskell.TH: data Role
- Language.Haskell.TH: data RuleBndr
- Language.Haskell.TH: data RuleMatch
- Language.Haskell.TH: data Safety
- Language.Haskell.TH: data SourceStrictness
- Language.Haskell.TH: data SourceUnpackedness
- Language.Haskell.TH: data Specificity
- Language.Haskell.TH: data Stmt
- Language.Haskell.TH: data TExp (a :: TYPE r)
- Language.Haskell.TH: data TyLit
- Language.Haskell.TH: data TySynEqn
- Language.Haskell.TH: data TyVarBndr flag
- Language.Haskell.TH: data Type
- Language.Haskell.TH: data TypeFamilyHead
- Language.Haskell.TH: defaultFixity :: Fixity
- Language.Haskell.TH: extsEnabled :: Q [Extension]
- Language.Haskell.TH: getDoc :: DocLoc -> Q (Maybe String)
- Language.Haskell.TH: hoistCode :: Monad m => (forall x. () => m x -> n x) -> Code m a -> Code n a
- Language.Haskell.TH: isExtEnabled :: Extension -> Q Bool
- Language.Haskell.TH: isInstance :: Name -> [Type] -> Q Bool
- Language.Haskell.TH: joinCode :: Monad m => m (Code m a) -> Code m a
- Language.Haskell.TH: liftCode :: forall a m. m (TExp a) -> Code m a
- Language.Haskell.TH: location :: Q Loc
- Language.Haskell.TH: lookupTypeName :: String -> Q (Maybe Name)
- Language.Haskell.TH: lookupValueName :: String -> Q (Maybe Name)
- Language.Haskell.TH: maxPrecedence :: Int
- Language.Haskell.TH: mkName :: String -> Name
- Language.Haskell.TH: nameBase :: Name -> String
- Language.Haskell.TH: nameModule :: Name -> Maybe String
- Language.Haskell.TH: namePackage :: Name -> Maybe String
- Language.Haskell.TH: nameSpace :: Name -> Maybe NameSpace
- Language.Haskell.TH: newDeclarationGroup :: Q [Dec]
- Language.Haskell.TH: newName :: Quote m => String -> m Name
- Language.Haskell.TH: newtype Code (m :: Type -> Type) (a :: TYPE r)
- Language.Haskell.TH: ppr :: Ppr a => a -> Doc
- Language.Haskell.TH: pprExp :: Precedence -> Exp -> Doc
- Language.Haskell.TH: pprLit :: Precedence -> Lit -> Doc
- Language.Haskell.TH: pprParendType :: Type -> Doc
- Language.Haskell.TH: pprPat :: Precedence -> Pat -> Doc
- Language.Haskell.TH: ppr_list :: Ppr a => [a] -> Doc
- Language.Haskell.TH: pprint :: Ppr a => a -> String
- Language.Haskell.TH: putDoc :: DocLoc -> String -> Q ()
- Language.Haskell.TH: recover :: Q a -> Q a -> Q a
- Language.Haskell.TH: reify :: Name -> Q Info
- Language.Haskell.TH: reifyAnnotations :: Data a => AnnLookup -> Q [a]
- Language.Haskell.TH: reifyConStrictness :: Name -> Q [DecidedStrictness]
- Language.Haskell.TH: reifyFixity :: Name -> Q (Maybe Fixity)
- Language.Haskell.TH: reifyInstances :: Name -> [Type] -> Q [InstanceDec]
- Language.Haskell.TH: reifyModule :: Module -> Q ModuleInfo
- Language.Haskell.TH: reifyRoles :: Name -> Q [Role]
- Language.Haskell.TH: reifyType :: Name -> Q Type
- Language.Haskell.TH: report :: Bool -> String -> Q ()
- Language.Haskell.TH: reportError :: String -> Q ()
- Language.Haskell.TH: reportWarning :: String -> Q ()
- Language.Haskell.TH: runIO :: IO a -> Q a
- Language.Haskell.TH: runQ :: Quasi m => Q a -> m a
- Language.Haskell.TH: tupleDataName :: Int -> Name
- Language.Haskell.TH: tupleTypeName :: Int -> Name
- Language.Haskell.TH: type Arity = Int
- Language.Haskell.TH: type BangType = (Bang, Type)
- Language.Haskell.TH: type Cxt = [Pred]
- Language.Haskell.TH: type FieldExp = (Name, Exp)
- Language.Haskell.TH: type FieldPat = (Name, Pat)
- Language.Haskell.TH: type InstanceDec = Dec
- Language.Haskell.TH: type Kind = Type
- Language.Haskell.TH: type ParentName = Name
- Language.Haskell.TH: type PatSynType = Type
- Language.Haskell.TH: type Pred = Type
- Language.Haskell.TH: type Strict = Bang
- Language.Haskell.TH: type SumAlt = Int
- Language.Haskell.TH: type SumArity = Int
- Language.Haskell.TH: type Unlifted = Bool
- Language.Haskell.TH: type VarBangType = (Name, Bang, Type)
- Language.Haskell.TH: unType :: TExp a -> Exp
- Language.Haskell.TH: unTypeCode :: forall a m. Quote m => Code m a -> m Exp
- Language.Haskell.TH: unboxedSumDataName :: SumAlt -> SumArity -> Name
- Language.Haskell.TH: unboxedSumTypeName :: SumArity -> Name
- Language.Haskell.TH: unboxedTupleDataName :: Int -> Name
- Language.Haskell.TH: unboxedTupleTypeName :: Int -> Name
- Language.Haskell.TH: unsafeCodeCoerce :: forall a m. Quote m => m Exp -> Code m a
- Language.Haskell.TH.LanguageExtensions: AllowAmbiguousTypes :: Extension
- Language.Haskell.TH.LanguageExtensions: AlternativeLayoutRule :: Extension
- Language.Haskell.TH.LanguageExtensions: AlternativeLayoutRuleTransitional :: Extension
- Language.Haskell.TH.LanguageExtensions: ApplicativeDo :: Extension
- Language.Haskell.TH.LanguageExtensions: Arrows :: Extension
- Language.Haskell.TH.LanguageExtensions: AutoDeriveTypeable :: Extension
- Language.Haskell.TH.LanguageExtensions: BangPatterns :: Extension
- Language.Haskell.TH.LanguageExtensions: BinaryLiterals :: Extension
- Language.Haskell.TH.LanguageExtensions: BlockArguments :: Extension
- Language.Haskell.TH.LanguageExtensions: CApiFFI :: Extension
- Language.Haskell.TH.LanguageExtensions: CUSKs :: Extension
- Language.Haskell.TH.LanguageExtensions: ConstrainedClassMethods :: Extension
- Language.Haskell.TH.LanguageExtensions: ConstraintKinds :: Extension
- Language.Haskell.TH.LanguageExtensions: Cpp :: Extension
- Language.Haskell.TH.LanguageExtensions: DataKinds :: Extension
- Language.Haskell.TH.LanguageExtensions: DatatypeContexts :: Extension
- Language.Haskell.TH.LanguageExtensions: DeepSubsumption :: Extension
- Language.Haskell.TH.LanguageExtensions: DefaultSignatures :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveAnyClass :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveDataTypeable :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveFoldable :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveFunctor :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveGeneric :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveLift :: Extension
- Language.Haskell.TH.LanguageExtensions: DeriveTraversable :: Extension
- Language.Haskell.TH.LanguageExtensions: DerivingStrategies :: Extension
- Language.Haskell.TH.LanguageExtensions: DerivingVia :: Extension
- Language.Haskell.TH.LanguageExtensions: DisambiguateRecordFields :: Extension
- Language.Haskell.TH.LanguageExtensions: DoAndIfThenElse :: Extension
- Language.Haskell.TH.LanguageExtensions: DuplicateRecordFields :: Extension
- Language.Haskell.TH.LanguageExtensions: EmptyCase :: Extension
- Language.Haskell.TH.LanguageExtensions: EmptyDataDecls :: Extension
- Language.Haskell.TH.LanguageExtensions: EmptyDataDeriving :: Extension
- Language.Haskell.TH.LanguageExtensions: ExistentialQuantification :: Extension
- Language.Haskell.TH.LanguageExtensions: ExplicitForAll :: Extension
- Language.Haskell.TH.LanguageExtensions: ExplicitNamespaces :: Extension
- Language.Haskell.TH.LanguageExtensions: ExtendedDefaultRules :: Extension
- Language.Haskell.TH.LanguageExtensions: ExtendedLiterals :: Extension
- Language.Haskell.TH.LanguageExtensions: FieldSelectors :: Extension
- Language.Haskell.TH.LanguageExtensions: FlexibleContexts :: Extension
- Language.Haskell.TH.LanguageExtensions: FlexibleInstances :: Extension
- Language.Haskell.TH.LanguageExtensions: ForeignFunctionInterface :: Extension
- Language.Haskell.TH.LanguageExtensions: FunctionalDependencies :: Extension
- Language.Haskell.TH.LanguageExtensions: GADTSyntax :: Extension
- Language.Haskell.TH.LanguageExtensions: GADTs :: Extension
- Language.Haskell.TH.LanguageExtensions: GHCForeignImportPrim :: Extension
- Language.Haskell.TH.LanguageExtensions: GeneralizedNewtypeDeriving :: Extension
- Language.Haskell.TH.LanguageExtensions: HexFloatLiterals :: Extension
- Language.Haskell.TH.LanguageExtensions: ImplicitParams :: Extension
- Language.Haskell.TH.LanguageExtensions: ImplicitPrelude :: Extension
- Language.Haskell.TH.LanguageExtensions: ImportQualifiedPost :: Extension
- Language.Haskell.TH.LanguageExtensions: ImpredicativeTypes :: Extension
- Language.Haskell.TH.LanguageExtensions: IncoherentInstances :: Extension
- Language.Haskell.TH.LanguageExtensions: InstanceSigs :: Extension
- Language.Haskell.TH.LanguageExtensions: InterruptibleFFI :: Extension
- Language.Haskell.TH.LanguageExtensions: JavaScriptFFI :: Extension
- Language.Haskell.TH.LanguageExtensions: KindSignatures :: Extension
- Language.Haskell.TH.LanguageExtensions: LambdaCase :: Extension
- Language.Haskell.TH.LanguageExtensions: LexicalNegation :: Extension
- Language.Haskell.TH.LanguageExtensions: LiberalTypeSynonyms :: Extension
- Language.Haskell.TH.LanguageExtensions: LinearTypes :: Extension
- Language.Haskell.TH.LanguageExtensions: ListTuplePuns :: Extension
- Language.Haskell.TH.LanguageExtensions: MagicHash :: Extension
- Language.Haskell.TH.LanguageExtensions: MonadComprehensions :: Extension
- Language.Haskell.TH.LanguageExtensions: MonoLocalBinds :: Extension
- Language.Haskell.TH.LanguageExtensions: MonomorphismRestriction :: Extension
- Language.Haskell.TH.LanguageExtensions: MultiParamTypeClasses :: Extension
- Language.Haskell.TH.LanguageExtensions: MultiWayIf :: Extension
- Language.Haskell.TH.LanguageExtensions: NPlusKPatterns :: Extension
- Language.Haskell.TH.LanguageExtensions: NamedFieldPuns :: Extension
- Language.Haskell.TH.LanguageExtensions: NamedWildCards :: Extension
- Language.Haskell.TH.LanguageExtensions: NegativeLiterals :: Extension
- Language.Haskell.TH.LanguageExtensions: NondecreasingIndentation :: Extension
- Language.Haskell.TH.LanguageExtensions: NullaryTypeClasses :: Extension
- Language.Haskell.TH.LanguageExtensions: NumDecimals :: Extension
- Language.Haskell.TH.LanguageExtensions: NumericUnderscores :: Extension
- Language.Haskell.TH.LanguageExtensions: OverlappingInstances :: Extension
- Language.Haskell.TH.LanguageExtensions: OverloadedLabels :: Extension
- Language.Haskell.TH.LanguageExtensions: OverloadedLists :: Extension
- Language.Haskell.TH.LanguageExtensions: OverloadedRecordDot :: Extension
- Language.Haskell.TH.LanguageExtensions: OverloadedRecordUpdate :: Extension
- Language.Haskell.TH.LanguageExtensions: OverloadedStrings :: Extension
- Language.Haskell.TH.LanguageExtensions: PackageImports :: Extension
- Language.Haskell.TH.LanguageExtensions: ParallelArrays :: Extension
- Language.Haskell.TH.LanguageExtensions: ParallelListComp :: Extension
- Language.Haskell.TH.LanguageExtensions: PartialTypeSignatures :: Extension
- Language.Haskell.TH.LanguageExtensions: PatternGuards :: Extension
- Language.Haskell.TH.LanguageExtensions: PatternSynonyms :: Extension
- Language.Haskell.TH.LanguageExtensions: PolyKinds :: Extension
- Language.Haskell.TH.LanguageExtensions: PostfixOperators :: Extension
- Language.Haskell.TH.LanguageExtensions: QualifiedDo :: Extension
- Language.Haskell.TH.LanguageExtensions: QuantifiedConstraints :: Extension
- Language.Haskell.TH.LanguageExtensions: QuasiQuotes :: Extension
- Language.Haskell.TH.LanguageExtensions: RankNTypes :: Extension
- Language.Haskell.TH.LanguageExtensions: RebindableSyntax :: Extension
- Language.Haskell.TH.LanguageExtensions: RecordWildCards :: Extension
- Language.Haskell.TH.LanguageExtensions: RecursiveDo :: Extension
- Language.Haskell.TH.LanguageExtensions: RelaxedLayout :: Extension
- Language.Haskell.TH.LanguageExtensions: RelaxedPolyRec :: Extension
- Language.Haskell.TH.LanguageExtensions: RequiredTypeArguments :: Extension
- Language.Haskell.TH.LanguageExtensions: RoleAnnotations :: Extension
- Language.Haskell.TH.LanguageExtensions: ScopedTypeVariables :: Extension
- Language.Haskell.TH.LanguageExtensions: StandaloneDeriving :: Extension
- Language.Haskell.TH.LanguageExtensions: StandaloneKindSignatures :: Extension
- Language.Haskell.TH.LanguageExtensions: StarIsType :: Extension
- Language.Haskell.TH.LanguageExtensions: StaticPointers :: Extension
- Language.Haskell.TH.LanguageExtensions: Strict :: Extension
- Language.Haskell.TH.LanguageExtensions: StrictData :: Extension
- Language.Haskell.TH.LanguageExtensions: TemplateHaskell :: Extension
- Language.Haskell.TH.LanguageExtensions: TemplateHaskellQuotes :: Extension
- Language.Haskell.TH.LanguageExtensions: TraditionalRecordSyntax :: Extension
- Language.Haskell.TH.LanguageExtensions: TransformListComp :: Extension
- Language.Haskell.TH.LanguageExtensions: TupleSections :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeAbstractions :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeApplications :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeData :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeFamilies :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeFamilyDependencies :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeInType :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeOperators :: Extension
- Language.Haskell.TH.LanguageExtensions: TypeSynonymInstances :: Extension
- Language.Haskell.TH.LanguageExtensions: UnboxedSums :: Extension
- Language.Haskell.TH.LanguageExtensions: UnboxedTuples :: Extension
- Language.Haskell.TH.LanguageExtensions: UndecidableInstances :: Extension
- Language.Haskell.TH.LanguageExtensions: UndecidableSuperClasses :: Extension
- Language.Haskell.TH.LanguageExtensions: UnicodeSyntax :: Extension
- Language.Haskell.TH.LanguageExtensions: UnliftedDatatypes :: Extension
- Language.Haskell.TH.LanguageExtensions: UnliftedFFITypes :: Extension
- Language.Haskell.TH.LanguageExtensions: UnliftedNewtypes :: Extension
- Language.Haskell.TH.LanguageExtensions: ViewPatterns :: Extension
- Language.Haskell.TH.LanguageExtensions: data Extension
- Language.Haskell.TH.Lib: AnyclassStrategy :: DerivStrategy
- Language.Haskell.TH.Lib: DerivClause :: Maybe DerivStrategy -> Cxt -> DerivClause
- Language.Haskell.TH.Lib: Incoherent :: Overlap
- Language.Haskell.TH.Lib: NewtypeStrategy :: DerivStrategy
- Language.Haskell.TH.Lib: Overlappable :: Overlap
- Language.Haskell.TH.Lib: Overlapping :: Overlap
- Language.Haskell.TH.Lib: Overlaps :: Overlap
- Language.Haskell.TH.Lib: StockStrategy :: DerivStrategy
- Language.Haskell.TH.Lib: ViaStrategy :: Type -> DerivStrategy
- Language.Haskell.TH.Lib: anyclassStrategy :: Quote m => m DerivStrategy
- Language.Haskell.TH.Lib: appE :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: appK :: Kind -> Kind -> Kind
- Language.Haskell.TH.Lib: appKindT :: Quote m => m Type -> m Kind -> m Type
- Language.Haskell.TH.Lib: appT :: Quote m => m Type -> m Type -> m Type
- Language.Haskell.TH.Lib: appTypeE :: Quote m => m Exp -> m Type -> m Exp
- Language.Haskell.TH.Lib: appsE :: Quote m => [m Exp] -> m Exp
- Language.Haskell.TH.Lib: arithSeqE :: Quote m => m Range -> m Exp
- Language.Haskell.TH.Lib: arrowK :: Kind
- Language.Haskell.TH.Lib: arrowT :: Quote m => m Type
- Language.Haskell.TH.Lib: asP :: Quote m => Name -> m Pat -> m Pat
- Language.Haskell.TH.Lib: bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang
- Language.Haskell.TH.Lib: bangP :: Quote m => m Pat -> m Pat
- Language.Haskell.TH.Lib: bangType :: Quote m => m Bang -> m Type -> m BangType
- Language.Haskell.TH.Lib: bindS :: Quote m => m Pat -> m Exp -> m Stmt
- Language.Haskell.TH.Lib: bndrInvis :: BndrVis
- Language.Haskell.TH.Lib: bndrReq :: BndrVis
- Language.Haskell.TH.Lib: bytesPrimL :: Bytes -> Lit
- Language.Haskell.TH.Lib: cApi :: Callconv
- Language.Haskell.TH.Lib: cCall :: Callconv
- Language.Haskell.TH.Lib: caseE :: Quote m => m Exp -> [m Match] -> m Exp
- Language.Haskell.TH.Lib: charL :: Char -> Lit
- Language.Haskell.TH.Lib: charPrimL :: Char -> Lit
- Language.Haskell.TH.Lib: charTyLit :: Quote m => Char -> m TyLit
- Language.Haskell.TH.Lib: class DefaultBndrFlag flag
- Language.Haskell.TH.Lib: classD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib: classP :: Quote m => Name -> [m Type] -> m Pred
- Language.Haskell.TH.Lib: clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause
- Language.Haskell.TH.Lib: closedTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
- Language.Haskell.TH.Lib: compE :: Quote m => [m Stmt] -> m Exp
- Language.Haskell.TH.Lib: conE :: Quote m => Name -> m Exp
- Language.Haskell.TH.Lib: conK :: Name -> Kind
- Language.Haskell.TH.Lib: conP :: Quote m => Name -> [m Pat] -> m Pat
- Language.Haskell.TH.Lib: conT :: Quote m => Name -> m Type
- Language.Haskell.TH.Lib: condE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: constraintK :: Kind
- Language.Haskell.TH.Lib: cxt :: Quote m => [m Pred] -> m Cxt
- Language.Haskell.TH.Lib: data DerivClause
- Language.Haskell.TH.Lib: data DerivStrategy
- Language.Haskell.TH.Lib: data Overlap
- Language.Haskell.TH.Lib: dataD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con] -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib: dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib: dataFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Dec
- Language.Haskell.TH.Lib: dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib: dataInstD_doc :: Q Cxt -> Maybe [Q (TyVarBndr ())] -> Q Type -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib: defaultBndrFlag :: DefaultBndrFlag flag => flag
- Language.Haskell.TH.Lib: defaultD :: Quote m => [m Type] -> m Dec
- Language.Haskell.TH.Lib: defaultSigD :: Quote m => Name -> m Type -> m Dec
- Language.Haskell.TH.Lib: derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause
- Language.Haskell.TH.Lib: doE :: Quote m => [m Stmt] -> m Exp
- Language.Haskell.TH.Lib: doublePrimL :: Rational -> Lit
- Language.Haskell.TH.Lib: dyn :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib: equalP :: Quote m => m Type -> m Type -> m Pred
- Language.Haskell.TH.Lib: equalityT :: Quote m => m Type
- Language.Haskell.TH.Lib: explBidir :: Quote m => [m Clause] -> m PatSynDir
- Language.Haskell.TH.Lib: fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)
- Language.Haskell.TH.Lib: fieldPat :: Quote m => Name -> m Pat -> m FieldPat
- Language.Haskell.TH.Lib: floatPrimL :: Rational -> Lit
- Language.Haskell.TH.Lib: forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec
- Language.Haskell.TH.Lib: forallC :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Con -> m Con
- Language.Haskell.TH.Lib: forallT :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Type -> m Type
- Language.Haskell.TH.Lib: forallVisT :: Quote m => [m (TyVarBndr ())] -> m Type -> m Type
- Language.Haskell.TH.Lib: fromE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib: fromR :: Quote m => m Exp -> m Range
- Language.Haskell.TH.Lib: fromThenE :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: fromThenR :: Quote m => m Exp -> m Exp -> m Range
- Language.Haskell.TH.Lib: fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range
- Language.Haskell.TH.Lib: fromToE :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: fromToR :: Quote m => m Exp -> m Exp -> m Range
- Language.Haskell.TH.Lib: funD :: Quote m => Name -> [m Clause] -> m Dec
- Language.Haskell.TH.Lib: funD_doc :: Name -> [Q Clause] -> Maybe String -> [Maybe String] -> Q Dec
- Language.Haskell.TH.Lib: funDep :: [Name] -> [Name] -> FunDep
- Language.Haskell.TH.Lib: gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
- Language.Haskell.TH.Lib: getFieldE :: Quote m => m Exp -> String -> m Exp
- Language.Haskell.TH.Lib: guardedB :: Quote m => [m (Guard, Exp)] -> m Body
- Language.Haskell.TH.Lib: implBidir :: Quote m => m PatSynDir
- Language.Haskell.TH.Lib: implicitParamBindD :: Quote m => String -> m Exp -> m Dec
- Language.Haskell.TH.Lib: implicitParamT :: Quote m => String -> m Type -> m Type
- Language.Haskell.TH.Lib: implicitParamVarE :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib: inferR :: Role
- Language.Haskell.TH.Lib: inferredSpec :: Specificity
- Language.Haskell.TH.Lib: infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con
- Language.Haskell.TH.Lib: infixE :: Quote m => Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
- Language.Haskell.TH.Lib: infixLD :: Quote m => Int -> Name -> m Dec
- Language.Haskell.TH.Lib: infixND :: Quote m => Int -> Name -> m Dec
- Language.Haskell.TH.Lib: infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
- Language.Haskell.TH.Lib: infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs
- Language.Haskell.TH.Lib: infixRD :: Quote m => Int -> Name -> m Dec
- Language.Haskell.TH.Lib: infixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib: injectivityAnn :: Name -> [Name] -> InjectivityAnn
- Language.Haskell.TH.Lib: instance Language.Haskell.TH.Lib.DefaultBndrFlag ()
- Language.Haskell.TH.Lib: instance Language.Haskell.TH.Lib.DefaultBndrFlag Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Lib: instance Language.Haskell.TH.Lib.DefaultBndrFlag Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Lib: instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib: instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib: intPrimL :: Integer -> Lit
- Language.Haskell.TH.Lib: integerL :: Integer -> Lit
- Language.Haskell.TH.Lib: interruptible :: Safety
- Language.Haskell.TH.Lib: invisP :: Quote m => m Type -> m Pat
- Language.Haskell.TH.Lib: isStrict :: Quote m => m Strict
- Language.Haskell.TH.Lib: javaScript :: Callconv
- Language.Haskell.TH.Lib: kiSigD :: Quote m => Name -> m Kind -> m Dec
- Language.Haskell.TH.Lib: kindSig :: Kind -> FamilyResultSig
- Language.Haskell.TH.Lib: kindedBndrTV :: Quote m => Name -> BndrVis -> m Kind -> m (TyVarBndr BndrVis)
- Language.Haskell.TH.Lib: kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity)
- Language.Haskell.TH.Lib: kindedTV :: DefaultBndrFlag flag => Name -> Kind -> TyVarBndr flag
- Language.Haskell.TH.Lib: labelE :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib: lam1E :: Quote m => m Pat -> m Exp -> m Exp
- Language.Haskell.TH.Lib: lamCaseE :: Quote m => [m Match] -> m Exp
- Language.Haskell.TH.Lib: lamCasesE :: Quote m => [m Clause] -> m Exp
- Language.Haskell.TH.Lib: lamE :: Quote m => [m Pat] -> m Exp -> m Exp
- Language.Haskell.TH.Lib: letE :: Quote m => [m Dec] -> m Exp -> m Exp
- Language.Haskell.TH.Lib: letS :: Quote m => [m Dec] -> m Stmt
- Language.Haskell.TH.Lib: listE :: Quote m => [m Exp] -> m Exp
- Language.Haskell.TH.Lib: listK :: Kind
- Language.Haskell.TH.Lib: listP :: Quote m => [m Pat] -> m Pat
- Language.Haskell.TH.Lib: listT :: Quote m => m Type
- Language.Haskell.TH.Lib: litE :: Quote m => Lit -> m Exp
- Language.Haskell.TH.Lib: litP :: Quote m => Lit -> m Pat
- Language.Haskell.TH.Lib: litT :: Quote m => m TyLit -> m Type
- Language.Haskell.TH.Lib: match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match
- Language.Haskell.TH.Lib: mdoE :: Quote m => [m Stmt] -> m Exp
- Language.Haskell.TH.Lib: mkBytes :: ForeignPtr Word8 -> Word -> Word -> Bytes
- Language.Haskell.TH.Lib: moduleAnnotation :: AnnTarget
- Language.Haskell.TH.Lib: mulArrowT :: Quote m => m Type
- Language.Haskell.TH.Lib: multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp
- Language.Haskell.TH.Lib: newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Con -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib: newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> (Q Con, Maybe String, [Maybe String]) -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib: newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib: newtypeInstD_doc :: Q Cxt -> Maybe [Q (TyVarBndr ())] -> Q Type -> Maybe (Q Kind) -> (Q Con, Maybe String, [Maybe String]) -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib: newtypeStrategy :: Quote m => m DerivStrategy
- Language.Haskell.TH.Lib: noBindS :: Quote m => m Exp -> m Stmt
- Language.Haskell.TH.Lib: noSig :: FamilyResultSig
- Language.Haskell.TH.Lib: noSourceStrictness :: Quote m => m SourceStrictness
- Language.Haskell.TH.Lib: noSourceUnpackedness :: Quote m => m SourceUnpackedness
- Language.Haskell.TH.Lib: nominalR :: Role
- Language.Haskell.TH.Lib: normalB :: Quote m => m Exp -> m Body
- Language.Haskell.TH.Lib: normalC :: Quote m => Name -> [m BangType] -> m Con
- Language.Haskell.TH.Lib: normalG :: Quote m => m Exp -> m Guard
- Language.Haskell.TH.Lib: normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)
- Language.Haskell.TH.Lib: notStrict :: Quote m => m Strict
- Language.Haskell.TH.Lib: numTyLit :: Quote m => Integer -> m TyLit
- Language.Haskell.TH.Lib: openTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> m Dec
- Language.Haskell.TH.Lib: parS :: Quote m => [[m Stmt]] -> m Stmt
- Language.Haskell.TH.Lib: parensE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib: parensP :: Quote m => m Pat -> m Pat
- Language.Haskell.TH.Lib: parensT :: Quote m => m Type -> m Type
- Language.Haskell.TH.Lib: patG :: Quote m => [m Stmt] -> m Guard
- Language.Haskell.TH.Lib: patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)
- Language.Haskell.TH.Lib: patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
- Language.Haskell.TH.Lib: patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat -> Maybe String -> [Maybe String] -> Q Dec
- Language.Haskell.TH.Lib: patSynSigD :: Quote m => Name -> m Type -> m Dec
- Language.Haskell.TH.Lib: phantomR :: Role
- Language.Haskell.TH.Lib: plainBndrTV :: Quote m => Name -> BndrVis -> m (TyVarBndr BndrVis)
- Language.Haskell.TH.Lib: plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity)
- Language.Haskell.TH.Lib: plainTV :: DefaultBndrFlag flag => Name -> TyVarBndr flag
- Language.Haskell.TH.Lib: pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec
- Language.Haskell.TH.Lib: pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
- Language.Haskell.TH.Lib: pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
- Language.Haskell.TH.Lib: pragLineD :: Quote m => Int -> String -> m Dec
- Language.Haskell.TH.Lib: pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
- Language.Haskell.TH.Lib: pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
- Language.Haskell.TH.Lib: pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
- Language.Haskell.TH.Lib: pragSpecInstD :: Quote m => m Type -> m Dec
- Language.Haskell.TH.Lib: prefixPatSyn :: Quote m => [Name] -> m PatSynArgs
- Language.Haskell.TH.Lib: prim :: Callconv
- Language.Haskell.TH.Lib: projectionE :: Quote m => NonEmpty String -> m Exp
- Language.Haskell.TH.Lib: promotedConsT :: Quote m => m Type
- Language.Haskell.TH.Lib: promotedInfixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib: promotedNilT :: Quote m => m Type
- Language.Haskell.TH.Lib: promotedT :: Quote m => Name -> m Type
- Language.Haskell.TH.Lib: promotedTupleT :: Quote m => Int -> m Type
- Language.Haskell.TH.Lib: promotedUInfixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib: rationalL :: Rational -> Lit
- Language.Haskell.TH.Lib: recC :: Quote m => Name -> [m VarBangType] -> m Con
- Language.Haskell.TH.Lib: recConE :: Quote m => Name -> [m (Name, Exp)] -> m Exp
- Language.Haskell.TH.Lib: recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
- Language.Haskell.TH.Lib: recP :: Quote m => Name -> [m FieldPat] -> m Pat
- Language.Haskell.TH.Lib: recS :: Quote m => [m Stmt] -> m Stmt
- Language.Haskell.TH.Lib: recUpdE :: Quote m => m Exp -> [m (Name, Exp)] -> m Exp
- Language.Haskell.TH.Lib: recordPatSyn :: Quote m => [Name] -> m PatSynArgs
- Language.Haskell.TH.Lib: representationalR :: Role
- Language.Haskell.TH.Lib: roleAnnotD :: Quote m => Name -> [Role] -> m Dec
- Language.Haskell.TH.Lib: ruleVar :: Quote m => Name -> m RuleBndr
- Language.Haskell.TH.Lib: safe :: Safety
- Language.Haskell.TH.Lib: sectionL :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: sectionR :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: sigD :: Quote m => Name -> m Type -> m Dec
- Language.Haskell.TH.Lib: sigE :: Quote m => m Exp -> m Type -> m Exp
- Language.Haskell.TH.Lib: sigP :: Quote m => m Pat -> m Type -> m Pat
- Language.Haskell.TH.Lib: sigT :: Quote m => m Type -> Kind -> m Type
- Language.Haskell.TH.Lib: sourceLazy :: Quote m => m SourceStrictness
- Language.Haskell.TH.Lib: sourceNoUnpack :: Quote m => m SourceUnpackedness
- Language.Haskell.TH.Lib: sourceStrict :: Quote m => m SourceStrictness
- Language.Haskell.TH.Lib: sourceUnpack :: Quote m => m SourceUnpackedness
- Language.Haskell.TH.Lib: specifiedSpec :: Specificity
- Language.Haskell.TH.Lib: standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec
- Language.Haskell.TH.Lib: standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
- Language.Haskell.TH.Lib: starK :: Kind
- Language.Haskell.TH.Lib: staticE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib: stdCall :: Callconv
- Language.Haskell.TH.Lib: stockStrategy :: Quote m => m DerivStrategy
- Language.Haskell.TH.Lib: strTyLit :: Quote m => String -> m TyLit
- Language.Haskell.TH.Lib: strictType :: Quote m => m Strict -> m Type -> m StrictType
- Language.Haskell.TH.Lib: stringE :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib: stringL :: String -> Lit
- Language.Haskell.TH.Lib: stringPrimL :: [Word8] -> Lit
- Language.Haskell.TH.Lib: thisModule :: Q Module
- Language.Haskell.TH.Lib: tildeP :: Quote m => m Pat -> m Pat
- Language.Haskell.TH.Lib: tupE :: Quote m => [m Exp] -> m Exp
- Language.Haskell.TH.Lib: tupP :: Quote m => [m Pat] -> m Pat
- Language.Haskell.TH.Lib: tupleK :: Int -> Kind
- Language.Haskell.TH.Lib: tupleT :: Quote m => Int -> m Type
- Language.Haskell.TH.Lib: tySynD :: Quote m => Name -> [TyVarBndr BndrVis] -> m Type -> m Dec
- Language.Haskell.TH.Lib: tySynEqn :: Quote m => Maybe [TyVarBndr ()] -> m Type -> m Type -> m TySynEqn
- Language.Haskell.TH.Lib: tySynInstD :: Quote m => m TySynEqn -> m Dec
- Language.Haskell.TH.Lib: tyVarSig :: TyVarBndr () -> FamilyResultSig
- Language.Haskell.TH.Lib: type BangQ = Q Bang
- Language.Haskell.TH.Lib: type BangTypeQ = Q BangType
- Language.Haskell.TH.Lib: type BodyQ = Q Body
- Language.Haskell.TH.Lib: type ClauseQ = Q Clause
- Language.Haskell.TH.Lib: type CodeQ = Code Q :: TYPE r -> Type
- Language.Haskell.TH.Lib: type ConQ = Q Con
- Language.Haskell.TH.Lib: type CxtQ = Q Cxt
- Language.Haskell.TH.Lib: type DecQ = Q Dec
- Language.Haskell.TH.Lib: type DecsQ = Q [Dec]
- Language.Haskell.TH.Lib: type DerivClauseQ = Q DerivClause
- Language.Haskell.TH.Lib: type DerivStrategyQ = Q DerivStrategy
- Language.Haskell.TH.Lib: type ExpQ = Q Exp
- Language.Haskell.TH.Lib: type FamilyResultSigQ = Q FamilyResultSig
- Language.Haskell.TH.Lib: type FieldExpQ = Q FieldExp
- Language.Haskell.TH.Lib: type FieldPatQ = Q FieldPat
- Language.Haskell.TH.Lib: type GuardQ = Q Guard
- Language.Haskell.TH.Lib: type InfoQ = Q Info
- Language.Haskell.TH.Lib: type KindQ = Q Kind
- Language.Haskell.TH.Lib: type MatchQ = Q Match
- Language.Haskell.TH.Lib: type PatQ = Q Pat
- Language.Haskell.TH.Lib: type PatSynArgsQ = Q PatSynArgs
- Language.Haskell.TH.Lib: type PatSynDirQ = Q PatSynDir
- Language.Haskell.TH.Lib: type PredQ = Q Pred
- Language.Haskell.TH.Lib: type RangeQ = Q Range
- Language.Haskell.TH.Lib: type RuleBndrQ = Q RuleBndr
- Language.Haskell.TH.Lib: type SourceStrictnessQ = Q SourceStrictness
- Language.Haskell.TH.Lib: type SourceUnpackednessQ = Q SourceUnpackedness
- Language.Haskell.TH.Lib: type StmtQ = Q Stmt
- Language.Haskell.TH.Lib: type StrictTypeQ = Q StrictType
- Language.Haskell.TH.Lib: type TExpQ (a :: TYPE r) = Q TExp a
- Language.Haskell.TH.Lib: type TyLitQ = Q TyLit
- Language.Haskell.TH.Lib: type TySynEqnQ = Q TySynEqn
- Language.Haskell.TH.Lib: type TyVarBndrSpec = TyVarBndr Specificity
- Language.Haskell.TH.Lib: type TyVarBndrUnit = TyVarBndr ()
- Language.Haskell.TH.Lib: type TyVarBndrVis = TyVarBndr BndrVis
- Language.Haskell.TH.Lib: type TypeQ = Q Type
- Language.Haskell.TH.Lib: type VarBangTypeQ = Q VarBangType
- Language.Haskell.TH.Lib: type VarStrictTypeQ = Q VarStrictType
- Language.Haskell.TH.Lib: typeAnnotation :: Name -> AnnTarget
- Language.Haskell.TH.Lib: typeDataD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con] -> m Dec
- Language.Haskell.TH.Lib: typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib: typeE :: Quote m => m Type -> m Exp
- Language.Haskell.TH.Lib: typeP :: Quote m => m Type -> m Pat
- Language.Haskell.TH.Lib: typedBracketE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib: typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
- Language.Haskell.TH.Lib: typedSpliceE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib: uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib: uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
- Language.Haskell.TH.Lib: uInfixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib: unboundVarE :: Quote m => Name -> m Exp
- Language.Haskell.TH.Lib: unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp
- Language.Haskell.TH.Lib: unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat
- Language.Haskell.TH.Lib: unboxedSumT :: Quote m => SumArity -> m Type
- Language.Haskell.TH.Lib: unboxedTupE :: Quote m => [m Exp] -> m Exp
- Language.Haskell.TH.Lib: unboxedTupP :: Quote m => [m Pat] -> m Pat
- Language.Haskell.TH.Lib: unboxedTupleT :: Quote m => Int -> m Type
- Language.Haskell.TH.Lib: unidir :: Quote m => m PatSynDir
- Language.Haskell.TH.Lib: unpacked :: Quote m => m Strict
- Language.Haskell.TH.Lib: unsafe :: Safety
- Language.Haskell.TH.Lib: valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib: valueAnnotation :: Name -> AnnTarget
- Language.Haskell.TH.Lib: varBangType :: Quote m => Name -> m BangType -> m VarBangType
- Language.Haskell.TH.Lib: varE :: Quote m => Name -> m Exp
- Language.Haskell.TH.Lib: varK :: Name -> Kind
- Language.Haskell.TH.Lib: varP :: Quote m => Name -> m Pat
- Language.Haskell.TH.Lib: varStrictType :: Quote m => Name -> m StrictType -> m VarStrictType
- Language.Haskell.TH.Lib: varT :: Quote m => Name -> m Type
- Language.Haskell.TH.Lib: viaStrategy :: Quote m => m Type -> m DerivStrategy
- Language.Haskell.TH.Lib: viewP :: Quote m => m Exp -> m Pat -> m Pat
- Language.Haskell.TH.Lib: wildCardT :: Quote m => m Type
- Language.Haskell.TH.Lib: wildP :: Quote m => m Pat
- Language.Haskell.TH.Lib: withDecDoc :: String -> Q Dec -> Q Dec
- Language.Haskell.TH.Lib: withDecsDoc :: String -> Q [Dec] -> Q [Dec]
- Language.Haskell.TH.Lib: wordPrimL :: Integer -> Lit
- Language.Haskell.TH.Lib.Internal: anyclassStrategy :: Quote m => m DerivStrategy
- Language.Haskell.TH.Lib.Internal: appE :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: appK :: Kind -> Kind -> Kind
- Language.Haskell.TH.Lib.Internal: appKindT :: Quote m => m Type -> m Kind -> m Type
- Language.Haskell.TH.Lib.Internal: appT :: Quote m => m Type -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: appTypeE :: Quote m => m Exp -> m Type -> m Exp
- Language.Haskell.TH.Lib.Internal: appsE :: Quote m => [m Exp] -> m Exp
- Language.Haskell.TH.Lib.Internal: arithSeqE :: Quote m => m Range -> m Exp
- Language.Haskell.TH.Lib.Internal: arrowK :: Kind
- Language.Haskell.TH.Lib.Internal: arrowT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: asP :: Quote m => Name -> m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang
- Language.Haskell.TH.Lib.Internal: bangP :: Quote m => m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: bangType :: Quote m => m Bang -> m Type -> m BangType
- Language.Haskell.TH.Lib.Internal: bindS :: Quote m => m Pat -> m Exp -> m Stmt
- Language.Haskell.TH.Lib.Internal: bndrInvis :: BndrVis
- Language.Haskell.TH.Lib.Internal: bndrReq :: BndrVis
- Language.Haskell.TH.Lib.Internal: bytesPrimL :: Bytes -> Lit
- Language.Haskell.TH.Lib.Internal: cApi :: Callconv
- Language.Haskell.TH.Lib.Internal: cCall :: Callconv
- Language.Haskell.TH.Lib.Internal: caseE :: Quote m => m Exp -> [m Match] -> m Exp
- Language.Haskell.TH.Lib.Internal: charL :: Char -> Lit
- Language.Haskell.TH.Lib.Internal: charPrimL :: Char -> Lit
- Language.Haskell.TH.Lib.Internal: charTyLit :: Quote m => Char -> m TyLit
- Language.Haskell.TH.Lib.Internal: classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> [FunDep] -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib.Internal: classP :: Quote m => Name -> [m Type] -> m Pred
- Language.Haskell.TH.Lib.Internal: clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause
- Language.Haskell.TH.Lib.Internal: closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
- Language.Haskell.TH.Lib.Internal: compE :: Quote m => [m Stmt] -> m Exp
- Language.Haskell.TH.Lib.Internal: conE :: Quote m => Name -> m Exp
- Language.Haskell.TH.Lib.Internal: conK :: Name -> Kind
- Language.Haskell.TH.Lib.Internal: conP :: Quote m => Name -> [m Type] -> [m Pat] -> m Pat
- Language.Haskell.TH.Lib.Internal: conT :: Quote m => Name -> m Type
- Language.Haskell.TH.Lib.Internal: condE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: constraintK :: Quote m => m Kind
- Language.Haskell.TH.Lib.Internal: cxt :: Quote m => [m Pred] -> m Cxt
- Language.Haskell.TH.Lib.Internal: dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con] -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib.Internal: dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib.Internal: dataFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Dec
- Language.Haskell.TH.Lib.Internal: dataInstD :: Quote m => m Cxt -> Maybe [m (TyVarBndr ())] -> m Type -> Maybe (m Kind) -> [m Con] -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib.Internal: dataInstD_doc :: Q Cxt -> Maybe [Q (TyVarBndr ())] -> Q Type -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib.Internal: defaultD :: Quote m => [m Type] -> m Dec
- Language.Haskell.TH.Lib.Internal: defaultSigD :: Quote m => Name -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: derivClause :: Quote m => Maybe (m DerivStrategy) -> [m Pred] -> m DerivClause
- Language.Haskell.TH.Lib.Internal: doE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
- Language.Haskell.TH.Lib.Internal: docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()
- Language.Haskell.TH.Lib.Internal: doublePrimL :: Rational -> Lit
- Language.Haskell.TH.Lib.Internal: dyn :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib.Internal: equalP :: Quote m => m Type -> m Type -> m Pred
- Language.Haskell.TH.Lib.Internal: equalityT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: explBidir :: Quote m => [m Clause] -> m PatSynDir
- Language.Haskell.TH.Lib.Internal: fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)
- Language.Haskell.TH.Lib.Internal: fieldPat :: Quote m => Name -> m Pat -> m FieldPat
- Language.Haskell.TH.Lib.Internal: floatPrimL :: Rational -> Lit
- Language.Haskell.TH.Lib.Internal: forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: forallC :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Con -> m Con
- Language.Haskell.TH.Lib.Internal: forallT :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: forallVisT :: Quote m => [m (TyVarBndr ())] -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: fromE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: fromR :: Quote m => m Exp -> m Range
- Language.Haskell.TH.Lib.Internal: fromThenE :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: fromThenR :: Quote m => m Exp -> m Exp -> m Range
- Language.Haskell.TH.Lib.Internal: fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range
- Language.Haskell.TH.Lib.Internal: fromToE :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: fromToR :: Quote m => m Exp -> m Exp -> m Range
- Language.Haskell.TH.Lib.Internal: funD :: Quote m => Name -> [m Clause] -> m Dec
- Language.Haskell.TH.Lib.Internal: funD_doc :: Name -> [Q Clause] -> Maybe String -> [Maybe String] -> Q Dec
- Language.Haskell.TH.Lib.Internal: funDep :: [Name] -> [Name] -> FunDep
- Language.Haskell.TH.Lib.Internal: gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
- Language.Haskell.TH.Lib.Internal: getFieldE :: Quote m => m Exp -> String -> m Exp
- Language.Haskell.TH.Lib.Internal: guardedB :: Quote m => [m (Guard, Exp)] -> m Body
- Language.Haskell.TH.Lib.Internal: implBidir :: Quote m => m PatSynDir
- Language.Haskell.TH.Lib.Internal: implicitParamBindD :: Quote m => String -> m Exp -> m Dec
- Language.Haskell.TH.Lib.Internal: implicitParamT :: Quote m => String -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: implicitParamVarE :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib.Internal: inferR :: Role
- Language.Haskell.TH.Lib.Internal: inferredSpec :: Specificity
- Language.Haskell.TH.Lib.Internal: infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con
- Language.Haskell.TH.Lib.Internal: infixE :: Quote m => Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
- Language.Haskell.TH.Lib.Internal: infixLD :: Quote m => Int -> Name -> m Dec
- Language.Haskell.TH.Lib.Internal: infixLWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
- Language.Haskell.TH.Lib.Internal: infixND :: Quote m => Int -> Name -> m Dec
- Language.Haskell.TH.Lib.Internal: infixNWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
- Language.Haskell.TH.Lib.Internal: infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs
- Language.Haskell.TH.Lib.Internal: infixRD :: Quote m => Int -> Name -> m Dec
- Language.Haskell.TH.Lib.Internal: infixRWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
- Language.Haskell.TH.Lib.Internal: infixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: injectivityAnn :: Name -> [Name] -> InjectivityAnn
- Language.Haskell.TH.Lib.Internal: instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib.Internal: instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib.Internal: intPrimL :: Integer -> Lit
- Language.Haskell.TH.Lib.Internal: integerL :: Integer -> Lit
- Language.Haskell.TH.Lib.Internal: interruptible :: Safety
- Language.Haskell.TH.Lib.Internal: invisP :: Quote m => m Type -> m Pat
- Language.Haskell.TH.Lib.Internal: isStrict :: Quote m => m Strict
- Language.Haskell.TH.Lib.Internal: javaScript :: Callconv
- Language.Haskell.TH.Lib.Internal: kiSigD :: Quote m => Name -> m Kind -> m Dec
- Language.Haskell.TH.Lib.Internal: kindSig :: Quote m => m Kind -> m FamilyResultSig
- Language.Haskell.TH.Lib.Internal: kindedBndrTV :: Quote m => Name -> BndrVis -> m Kind -> m (TyVarBndr BndrVis)
- Language.Haskell.TH.Lib.Internal: kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity)
- Language.Haskell.TH.Lib.Internal: kindedTV :: Quote m => Name -> m Kind -> m (TyVarBndr ())
- Language.Haskell.TH.Lib.Internal: labelE :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib.Internal: lam1E :: Quote m => m Pat -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: lamCaseE :: Quote m => [m Match] -> m Exp
- Language.Haskell.TH.Lib.Internal: lamCasesE :: Quote m => [m Clause] -> m Exp
- Language.Haskell.TH.Lib.Internal: lamE :: Quote m => [m Pat] -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: letE :: Quote m => [m Dec] -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: letS :: Quote m => [m Dec] -> m Stmt
- Language.Haskell.TH.Lib.Internal: listE :: Quote m => [m Exp] -> m Exp
- Language.Haskell.TH.Lib.Internal: listK :: Kind
- Language.Haskell.TH.Lib.Internal: listP :: Quote m => [m Pat] -> m Pat
- Language.Haskell.TH.Lib.Internal: listT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: litE :: Quote m => Lit -> m Exp
- Language.Haskell.TH.Lib.Internal: litP :: Quote m => Lit -> m Pat
- Language.Haskell.TH.Lib.Internal: litT :: Quote m => m TyLit -> m Type
- Language.Haskell.TH.Lib.Internal: match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match
- Language.Haskell.TH.Lib.Internal: mdoE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
- Language.Haskell.TH.Lib.Internal: moduleAnnotation :: AnnTarget
- Language.Haskell.TH.Lib.Internal: mulArrowT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp
- Language.Haskell.TH.Lib.Internal: newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Con -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib.Internal: newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> (Q Con, Maybe String, [Maybe String]) -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib.Internal: newtypeInstD :: Quote m => m Cxt -> Maybe [m (TyVarBndr ())] -> m Type -> Maybe (m Kind) -> m Con -> [m DerivClause] -> m Dec
- Language.Haskell.TH.Lib.Internal: newtypeInstD_doc :: Q Cxt -> Maybe [Q (TyVarBndr ())] -> Q Type -> Maybe (Q Kind) -> (Q Con, Maybe String, [Maybe String]) -> [Q DerivClause] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib.Internal: newtypeStrategy :: Quote m => m DerivStrategy
- Language.Haskell.TH.Lib.Internal: noBindS :: Quote m => m Exp -> m Stmt
- Language.Haskell.TH.Lib.Internal: noSig :: Quote m => m FamilyResultSig
- Language.Haskell.TH.Lib.Internal: noSourceStrictness :: Quote m => m SourceStrictness
- Language.Haskell.TH.Lib.Internal: noSourceUnpackedness :: Quote m => m SourceUnpackedness
- Language.Haskell.TH.Lib.Internal: nominalR :: Role
- Language.Haskell.TH.Lib.Internal: normalB :: Quote m => m Exp -> m Body
- Language.Haskell.TH.Lib.Internal: normalC :: Quote m => Name -> [m BangType] -> m Con
- Language.Haskell.TH.Lib.Internal: normalG :: Quote m => m Exp -> m Guard
- Language.Haskell.TH.Lib.Internal: normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)
- Language.Haskell.TH.Lib.Internal: notStrict :: Quote m => m Strict
- Language.Haskell.TH.Lib.Internal: numTyLit :: Quote m => Integer -> m TyLit
- Language.Haskell.TH.Lib.Internal: openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig -> Maybe InjectivityAnn -> m Dec
- Language.Haskell.TH.Lib.Internal: parS :: Quote m => [[m Stmt]] -> m Stmt
- Language.Haskell.TH.Lib.Internal: parensE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: parensP :: Quote m => m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: parensT :: Quote m => m Type -> m Type
- Language.Haskell.TH.Lib.Internal: patG :: Quote m => [m Stmt] -> m Guard
- Language.Haskell.TH.Lib.Internal: patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)
- Language.Haskell.TH.Lib.Internal: patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
- Language.Haskell.TH.Lib.Internal: patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat -> Maybe String -> [Maybe String] -> Q Dec
- Language.Haskell.TH.Lib.Internal: patSynSigD :: Quote m => Name -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: phantomR :: Role
- Language.Haskell.TH.Lib.Internal: plainBndrTV :: Quote m => Name -> BndrVis -> m (TyVarBndr BndrVis)
- Language.Haskell.TH.Lib.Internal: plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity)
- Language.Haskell.TH.Lib.Internal: plainTV :: Quote m => Name -> m (TyVarBndr ())
- Language.Haskell.TH.Lib.Internal: pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec
- Language.Haskell.TH.Lib.Internal: pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
- Language.Haskell.TH.Lib.Internal: pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
- Language.Haskell.TH.Lib.Internal: pragLineD :: Quote m => Int -> String -> m Dec
- Language.Haskell.TH.Lib.Internal: pragOpaqueD :: Quote m => Name -> m Dec
- Language.Haskell.TH.Lib.Internal: pragRuleD :: Quote m => String -> Maybe [m (TyVarBndr ())] -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
- Language.Haskell.TH.Lib.Internal: pragSCCFunD :: Quote m => Name -> m Dec
- Language.Haskell.TH.Lib.Internal: pragSCCFunNamedD :: Quote m => Name -> String -> m Dec
- Language.Haskell.TH.Lib.Internal: pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
- Language.Haskell.TH.Lib.Internal: pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
- Language.Haskell.TH.Lib.Internal: pragSpecInstD :: Quote m => m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: prefixPatSyn :: Quote m => [Name] -> m PatSynArgs
- Language.Haskell.TH.Lib.Internal: prim :: Callconv
- Language.Haskell.TH.Lib.Internal: projectionE :: Quote m => NonEmpty String -> m Exp
- Language.Haskell.TH.Lib.Internal: promotedConsT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: promotedInfixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: promotedNilT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: promotedT :: Quote m => Name -> m Type
- Language.Haskell.TH.Lib.Internal: promotedTupleT :: Quote m => Int -> m Type
- Language.Haskell.TH.Lib.Internal: promotedUInfixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: rationalL :: Rational -> Lit
- Language.Haskell.TH.Lib.Internal: recC :: Quote m => Name -> [m VarBangType] -> m Con
- Language.Haskell.TH.Lib.Internal: recConE :: Quote m => Name -> [m (Name, Exp)] -> m Exp
- Language.Haskell.TH.Lib.Internal: recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
- Language.Haskell.TH.Lib.Internal: recP :: Quote m => Name -> [m FieldPat] -> m Pat
- Language.Haskell.TH.Lib.Internal: recS :: Quote m => [m Stmt] -> m Stmt
- Language.Haskell.TH.Lib.Internal: recUpdE :: Quote m => m Exp -> [m (Name, Exp)] -> m Exp
- Language.Haskell.TH.Lib.Internal: recordPatSyn :: Quote m => [Name] -> m PatSynArgs
- Language.Haskell.TH.Lib.Internal: representationalR :: Role
- Language.Haskell.TH.Lib.Internal: roleAnnotD :: Quote m => Name -> [Role] -> m Dec
- Language.Haskell.TH.Lib.Internal: ruleVar :: Quote m => Name -> m RuleBndr
- Language.Haskell.TH.Lib.Internal: safe :: Safety
- Language.Haskell.TH.Lib.Internal: sectionL :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: sectionR :: Quote m => m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: sigD :: Quote m => Name -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: sigE :: Quote m => m Exp -> m Type -> m Exp
- Language.Haskell.TH.Lib.Internal: sigP :: Quote m => m Pat -> m Type -> m Pat
- Language.Haskell.TH.Lib.Internal: sigT :: Quote m => m Type -> m Kind -> m Type
- Language.Haskell.TH.Lib.Internal: sourceLazy :: Quote m => m SourceStrictness
- Language.Haskell.TH.Lib.Internal: sourceNoUnpack :: Quote m => m SourceUnpackedness
- Language.Haskell.TH.Lib.Internal: sourceStrict :: Quote m => m SourceStrictness
- Language.Haskell.TH.Lib.Internal: sourceUnpack :: Quote m => m SourceUnpackedness
- Language.Haskell.TH.Lib.Internal: specifiedSpec :: Specificity
- Language.Haskell.TH.Lib.Internal: standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: standaloneDerivWithStrategyD :: Quote m => Maybe (m DerivStrategy) -> m Cxt -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: starK :: Quote m => m Kind
- Language.Haskell.TH.Lib.Internal: staticE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: stdCall :: Callconv
- Language.Haskell.TH.Lib.Internal: stockStrategy :: Quote m => m DerivStrategy
- Language.Haskell.TH.Lib.Internal: strTyLit :: Quote m => String -> m TyLit
- Language.Haskell.TH.Lib.Internal: strictType :: Quote m => m Strict -> m Type -> m StrictType
- Language.Haskell.TH.Lib.Internal: stringE :: Quote m => String -> m Exp
- Language.Haskell.TH.Lib.Internal: stringL :: String -> Lit
- Language.Haskell.TH.Lib.Internal: stringPrimL :: [Word8] -> Lit
- Language.Haskell.TH.Lib.Internal: thisModule :: Q Module
- Language.Haskell.TH.Lib.Internal: tildeP :: Quote m => m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: tupE :: Quote m => [Maybe (m Exp)] -> m Exp
- Language.Haskell.TH.Lib.Internal: tupP :: Quote m => [m Pat] -> m Pat
- Language.Haskell.TH.Lib.Internal: tupleK :: Int -> Kind
- Language.Haskell.TH.Lib.Internal: tupleT :: Quote m => Int -> m Type
- Language.Haskell.TH.Lib.Internal: tySynD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m Type -> m Dec
- Language.Haskell.TH.Lib.Internal: tySynEqn :: Quote m => Maybe [m (TyVarBndr ())] -> m Type -> m Type -> m TySynEqn
- Language.Haskell.TH.Lib.Internal: tySynInstD :: Quote m => m TySynEqn -> m Dec
- Language.Haskell.TH.Lib.Internal: tyVarSig :: Quote m => m (TyVarBndr ()) -> m FamilyResultSig
- Language.Haskell.TH.Lib.Internal: type BangQ = Q Bang
- Language.Haskell.TH.Lib.Internal: type BangTypeQ = Q BangType
- Language.Haskell.TH.Lib.Internal: type BodyQ = Q Body
- Language.Haskell.TH.Lib.Internal: type ClauseQ = Q Clause
- Language.Haskell.TH.Lib.Internal: type CodeQ = Code Q :: TYPE r -> Type
- Language.Haskell.TH.Lib.Internal: type ConQ = Q Con
- Language.Haskell.TH.Lib.Internal: type CxtQ = Q Cxt
- Language.Haskell.TH.Lib.Internal: type DecQ = Q Dec
- Language.Haskell.TH.Lib.Internal: type Decs = [Dec]
- Language.Haskell.TH.Lib.Internal: type DecsQ = Q [Dec]
- Language.Haskell.TH.Lib.Internal: type DerivClauseQ = Q DerivClause
- Language.Haskell.TH.Lib.Internal: type DerivStrategyQ = Q DerivStrategy
- Language.Haskell.TH.Lib.Internal: type ExpQ = Q Exp
- Language.Haskell.TH.Lib.Internal: type FamilyResultSigQ = Q FamilyResultSig
- Language.Haskell.TH.Lib.Internal: type FieldExpQ = Q FieldExp
- Language.Haskell.TH.Lib.Internal: type FieldPatQ = Q FieldPat
- Language.Haskell.TH.Lib.Internal: type GuardQ = Q Guard
- Language.Haskell.TH.Lib.Internal: type InfoQ = Q Info
- Language.Haskell.TH.Lib.Internal: type InjectivityAnn = InjectivityAnn
- Language.Haskell.TH.Lib.Internal: type KindQ = Q Kind
- Language.Haskell.TH.Lib.Internal: type MatchQ = Q Match
- Language.Haskell.TH.Lib.Internal: type PatQ = Q Pat
- Language.Haskell.TH.Lib.Internal: type PatSynArgsQ = Q PatSynArgs
- Language.Haskell.TH.Lib.Internal: type PatSynDirQ = Q PatSynDir
- Language.Haskell.TH.Lib.Internal: type PredQ = Q Pred
- Language.Haskell.TH.Lib.Internal: type RangeQ = Q Range
- Language.Haskell.TH.Lib.Internal: type Role = Role
- Language.Haskell.TH.Lib.Internal: type RuleBndrQ = Q RuleBndr
- Language.Haskell.TH.Lib.Internal: type SourceStrictnessQ = Q SourceStrictness
- Language.Haskell.TH.Lib.Internal: type SourceUnpackednessQ = Q SourceUnpackedness
- Language.Haskell.TH.Lib.Internal: type StmtQ = Q Stmt
- Language.Haskell.TH.Lib.Internal: type StrictTypeQ = Q StrictType
- Language.Haskell.TH.Lib.Internal: type TExpQ (a :: TYPE r) = Q TExp a
- Language.Haskell.TH.Lib.Internal: type TyLitQ = Q TyLit
- Language.Haskell.TH.Lib.Internal: type TySynEqnQ = Q TySynEqn
- Language.Haskell.TH.Lib.Internal: type TyVarBndrSpec = TyVarBndr Specificity
- Language.Haskell.TH.Lib.Internal: type TyVarBndrUnit = TyVarBndr ()
- Language.Haskell.TH.Lib.Internal: type TyVarBndrVis = TyVarBndr BndrVis
- Language.Haskell.TH.Lib.Internal: type TypeQ = Q Type
- Language.Haskell.TH.Lib.Internal: type VarBangTypeQ = Q VarBangType
- Language.Haskell.TH.Lib.Internal: type VarStrictTypeQ = Q VarStrictType
- Language.Haskell.TH.Lib.Internal: typeAnnotation :: Name -> AnnTarget
- Language.Haskell.TH.Lib.Internal: typeDataD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con] -> m Dec
- Language.Haskell.TH.Lib.Internal: typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -> Maybe String -> Q Dec
- Language.Haskell.TH.Lib.Internal: typeE :: Quote m => m Type -> m Exp
- Language.Haskell.TH.Lib.Internal: typeP :: Quote m => m Type -> m Pat
- Language.Haskell.TH.Lib.Internal: typedBracketE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
- Language.Haskell.TH.Lib.Internal: typedSpliceE :: Quote m => m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
- Language.Haskell.TH.Lib.Internal: uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: uInfixT :: Quote m => m Type -> Name -> m Type -> m Type
- Language.Haskell.TH.Lib.Internal: unboundVarE :: Quote m => Name -> m Exp
- Language.Haskell.TH.Lib.Internal: unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp
- Language.Haskell.TH.Lib.Internal: unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat
- Language.Haskell.TH.Lib.Internal: unboxedSumT :: Quote m => SumArity -> m Type
- Language.Haskell.TH.Lib.Internal: unboxedTupE :: Quote m => [Maybe (m Exp)] -> m Exp
- Language.Haskell.TH.Lib.Internal: unboxedTupP :: Quote m => [m Pat] -> m Pat
- Language.Haskell.TH.Lib.Internal: unboxedTupleT :: Quote m => Int -> m Type
- Language.Haskell.TH.Lib.Internal: unidir :: Quote m => m PatSynDir
- Language.Haskell.TH.Lib.Internal: unpacked :: Quote m => m Strict
- Language.Haskell.TH.Lib.Internal: unsafe :: Safety
- Language.Haskell.TH.Lib.Internal: valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec
- Language.Haskell.TH.Lib.Internal: valueAnnotation :: Name -> AnnTarget
- Language.Haskell.TH.Lib.Internal: varBangType :: Quote m => Name -> m BangType -> m VarBangType
- Language.Haskell.TH.Lib.Internal: varE :: Quote m => Name -> m Exp
- Language.Haskell.TH.Lib.Internal: varK :: Name -> Kind
- Language.Haskell.TH.Lib.Internal: varP :: Quote m => Name -> m Pat
- Language.Haskell.TH.Lib.Internal: varStrictType :: Quote m => Name -> m StrictType -> m VarStrictType
- Language.Haskell.TH.Lib.Internal: varT :: Quote m => Name -> m Type
- Language.Haskell.TH.Lib.Internal: viaStrategy :: Quote m => m Type -> m DerivStrategy
- Language.Haskell.TH.Lib.Internal: viewP :: Quote m => m Exp -> m Pat -> m Pat
- Language.Haskell.TH.Lib.Internal: wildCardT :: Quote m => m Type
- Language.Haskell.TH.Lib.Internal: wildP :: Quote m => m Pat
- Language.Haskell.TH.Lib.Internal: withDecDoc :: String -> Q Dec -> Q Dec
- Language.Haskell.TH.Lib.Internal: withDecsDoc :: String -> Q [Dec] -> Q [Dec]
- Language.Haskell.TH.Lib.Internal: wordPrimL :: Integer -> Lit
- Language.Haskell.TH.Lib.Map: data Map k a
- Language.Haskell.TH.Lib.Map: empty :: Map k a
- Language.Haskell.TH.Lib.Map: insert :: Ord k => k -> a -> Map k a -> Map k a
- Language.Haskell.TH.Lib.Map: lookup :: Ord k => k -> Map k a -> Maybe a
- Language.Haskell.TH.Ppr: ForallInvis :: ForallVisFlag
- Language.Haskell.TH.Ppr: ForallVis :: ForallVisFlag
- Language.Haskell.TH.Ppr: TANormal :: Type -> TypeArg
- Language.Haskell.TH.Ppr: TyArg :: Kind -> TypeArg
- Language.Haskell.TH.Ppr: appPrec :: Precedence
- Language.Haskell.TH.Ppr: bar :: Doc
- Language.Haskell.TH.Ppr: bytesToString :: [Word8] -> String
- Language.Haskell.TH.Ppr: class Ppr a
- Language.Haskell.TH.Ppr: class PprFlag flag
- Language.Haskell.TH.Ppr: commaSep :: Ppr a => [a] -> Doc
- Language.Haskell.TH.Ppr: commaSepApplied :: [Name] -> Doc
- Language.Haskell.TH.Ppr: commaSepWith :: (a -> Doc) -> [a] -> Doc
- Language.Haskell.TH.Ppr: data ForallVisFlag
- Language.Haskell.TH.Ppr: data TypeArg
- Language.Haskell.TH.Ppr: fromTANormal :: TypeArg -> Maybe Type
- Language.Haskell.TH.Ppr: funPrec :: Precedence
- Language.Haskell.TH.Ppr: hashParens :: Doc -> Doc
- Language.Haskell.TH.Ppr: instance GHC.Show.Show Language.Haskell.TH.Ppr.ForallVisFlag
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Ppr.TypeArg
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Bang
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Clause
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Con
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Dec
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.DecidedStrictness
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Exp
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.FamilyResultSig
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Foreign
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.FunDep
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Info
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.InjectivityAnn
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Inline
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Lit
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Loc
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Match
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Module
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.ModuleInfo
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Name
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Pat
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.PatSynArgs
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.PatSynDir
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Phases
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Pragma
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Range
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Role
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.RuleBndr
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.RuleMatch
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.SourceStrictness
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.SourceUnpackedness
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Stmt
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.TyLit
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr Language.Haskell.TH.Syntax.Type
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.Ppr a => Language.Haskell.TH.Ppr.Ppr [a]
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.PprFlag ()
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.PprFlag Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.PprFlag Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Ppr: instance Language.Haskell.TH.Ppr.PprFlag flag => Language.Haskell.TH.Ppr.Ppr (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.TH.Ppr: isStarT :: Type -> Bool
- Language.Haskell.TH.Ppr: isSymOcc :: Name -> Bool
- Language.Haskell.TH.Ppr: nestDepth :: Int
- Language.Haskell.TH.Ppr: noPrec :: Precedence
- Language.Haskell.TH.Ppr: opPrec :: Precedence
- Language.Haskell.TH.Ppr: parensIf :: Bool -> Doc -> Doc
- Language.Haskell.TH.Ppr: ppr :: Ppr a => a -> Doc
- Language.Haskell.TH.Ppr: pprBangType :: BangType -> Doc
- Language.Haskell.TH.Ppr: pprBndrVis :: BndrVis -> Doc -> Doc
- Language.Haskell.TH.Ppr: pprBody :: Bool -> Body -> Doc
- Language.Haskell.TH.Ppr: pprClause :: Bool -> Clause -> Doc
- Language.Haskell.TH.Ppr: pprCxt :: Cxt -> Doc
- Language.Haskell.TH.Ppr: pprExp :: Precedence -> Exp -> Doc
- Language.Haskell.TH.Ppr: pprFields :: [(Name, Exp)] -> Doc
- Language.Haskell.TH.Ppr: pprFixity :: Name -> Fixity -> NamespaceSpecifier -> Doc
- Language.Haskell.TH.Ppr: pprForall :: [TyVarBndr Specificity] -> Cxt -> Doc
- Language.Haskell.TH.Ppr: pprForall' :: PprFlag flag => ForallVisFlag -> [TyVarBndr flag] -> Cxt -> Doc
- Language.Haskell.TH.Ppr: pprForallVis :: [TyVarBndr ()] -> Cxt -> Doc
- Language.Haskell.TH.Ppr: pprFunArgType :: Type -> Doc
- Language.Haskell.TH.Ppr: pprGadtRHS :: [(Strict, Type)] -> Type -> Doc
- Language.Haskell.TH.Ppr: pprGuarded :: Doc -> (Guard, Exp) -> Doc
- Language.Haskell.TH.Ppr: pprInfixExp :: Exp -> Doc
- Language.Haskell.TH.Ppr: pprInfixT :: Precedence -> Type -> Doc
- Language.Haskell.TH.Ppr: pprLit :: Precedence -> Lit -> Doc
- Language.Haskell.TH.Ppr: pprMatchPat :: Pat -> Doc
- Language.Haskell.TH.Ppr: pprMaybeExp :: Precedence -> Maybe Exp -> Doc
- Language.Haskell.TH.Ppr: pprNamespaceSpecifier :: NamespaceSpecifier -> Doc
- Language.Haskell.TH.Ppr: pprParendType :: Type -> Doc
- Language.Haskell.TH.Ppr: pprParendTypeArg :: TypeArg -> Doc
- Language.Haskell.TH.Ppr: pprPat :: Precedence -> Pat -> Doc
- Language.Haskell.TH.Ppr: pprPatSynSig :: Name -> PatSynType -> Doc
- Language.Haskell.TH.Ppr: pprPatSynType :: PatSynType -> Doc
- Language.Haskell.TH.Ppr: pprPrefixOcc :: Name -> Doc
- Language.Haskell.TH.Ppr: pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc
- Language.Haskell.TH.Ppr: pprStrictType :: (Strict, Type) -> Doc
- Language.Haskell.TH.Ppr: pprString :: String -> Doc
- Language.Haskell.TH.Ppr: pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc
- Language.Haskell.TH.Ppr: pprTyLit :: TyLit -> Doc
- Language.Haskell.TH.Ppr: pprTyVarBndr :: PprFlag flag => TyVarBndr flag -> Doc
- Language.Haskell.TH.Ppr: pprType :: Precedence -> Type -> Doc
- Language.Haskell.TH.Ppr: pprVarBangType :: VarBangType -> Doc
- Language.Haskell.TH.Ppr: pprVarStrictType :: (Name, Strict, Type) -> Doc
- Language.Haskell.TH.Ppr: ppr_bndrs :: PprFlag flag => Maybe [TyVarBndr flag] -> Doc
- Language.Haskell.TH.Ppr: ppr_cxt_preds :: Precedence -> Cxt -> Doc
- Language.Haskell.TH.Ppr: ppr_data :: Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc
- Language.Haskell.TH.Ppr: ppr_dec :: Bool -> Dec -> Doc
- Language.Haskell.TH.Ppr: ppr_deriv_clause :: DerivClause -> Doc
- Language.Haskell.TH.Ppr: ppr_deriv_strategy :: DerivStrategy -> Doc
- Language.Haskell.TH.Ppr: ppr_list :: Ppr a => [a] -> Doc
- Language.Haskell.TH.Ppr: ppr_newtype :: Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause] -> Doc
- Language.Haskell.TH.Ppr: ppr_overlap :: Overlap -> Doc
- Language.Haskell.TH.Ppr: ppr_sig :: Name -> Type -> Doc
- Language.Haskell.TH.Ppr: ppr_tf_head :: TypeFamilyHead -> Doc
- Language.Haskell.TH.Ppr: ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc
- Language.Haskell.TH.Ppr: ppr_type_data :: Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc
- Language.Haskell.TH.Ppr: ppr_typedef :: String -> Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc
- Language.Haskell.TH.Ppr: pprint :: Ppr a => a -> String
- Language.Haskell.TH.Ppr: qualPrec :: Precedence
- Language.Haskell.TH.Ppr: quoteParens :: Doc -> Doc
- Language.Haskell.TH.Ppr: semiSep :: Ppr a => [a] -> Doc
- Language.Haskell.TH.Ppr: semiSepWith :: (a -> Doc) -> [a] -> Doc
- Language.Haskell.TH.Ppr: sepWith :: Doc -> (a -> Doc) -> [a] -> Doc
- Language.Haskell.TH.Ppr: showtextl :: Show a => a -> Doc
- Language.Haskell.TH.Ppr: sigPrec :: Precedence
- Language.Haskell.TH.Ppr: split :: Type -> (Type, [TypeArg])
- Language.Haskell.TH.Ppr: type Precedence = Int
- Language.Haskell.TH.Ppr: unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc
- Language.Haskell.TH.Ppr: unopPrec :: Precedence
- Language.Haskell.TH.Ppr: where_clause :: [Dec] -> Doc
- Language.Haskell.TH.PprLib: ($$) :: Doc -> Doc -> Doc
- Language.Haskell.TH.PprLib: ($+$) :: Doc -> Doc -> Doc
- Language.Haskell.TH.PprLib: (<+>) :: Doc -> Doc -> Doc
- Language.Haskell.TH.PprLib: (<>) :: Doc -> Doc -> Doc
- Language.Haskell.TH.PprLib: arrow :: Doc
- Language.Haskell.TH.PprLib: braces :: Doc -> Doc
- Language.Haskell.TH.PprLib: brackets :: Doc -> Doc
- Language.Haskell.TH.PprLib: cat :: [Doc] -> Doc
- Language.Haskell.TH.PprLib: char :: Char -> Doc
- Language.Haskell.TH.PprLib: colon :: Doc
- Language.Haskell.TH.PprLib: comma :: Doc
- Language.Haskell.TH.PprLib: data PprM a
- Language.Haskell.TH.PprLib: dcolon :: Doc
- Language.Haskell.TH.PprLib: double :: Double -> Doc
- Language.Haskell.TH.PprLib: doubleQuotes :: Doc -> Doc
- Language.Haskell.TH.PprLib: empty :: Doc
- Language.Haskell.TH.PprLib: equals :: Doc
- Language.Haskell.TH.PprLib: fcat :: [Doc] -> Doc
- Language.Haskell.TH.PprLib: float :: Float -> Doc
- Language.Haskell.TH.PprLib: fsep :: [Doc] -> Doc
- Language.Haskell.TH.PprLib: hang :: Doc -> Int -> Doc -> Doc
- Language.Haskell.TH.PprLib: hcat :: [Doc] -> Doc
- Language.Haskell.TH.PprLib: hsep :: [Doc] -> Doc
- Language.Haskell.TH.PprLib: infixl 5 $+$
- Language.Haskell.TH.PprLib: infixl 6 <+>
- Language.Haskell.TH.PprLib: instance GHC.Base.Applicative Language.Haskell.TH.PprLib.PprM
- Language.Haskell.TH.PprLib: instance GHC.Base.Functor Language.Haskell.TH.PprLib.PprM
- Language.Haskell.TH.PprLib: instance GHC.Base.Monad Language.Haskell.TH.PprLib.PprM
- Language.Haskell.TH.PprLib: instance GHC.Show.Show Language.Haskell.TH.PprLib.Doc
- Language.Haskell.TH.PprLib: int :: Int -> Doc
- Language.Haskell.TH.PprLib: integer :: Integer -> Doc
- Language.Haskell.TH.PprLib: isEmpty :: Doc -> PprM Bool
- Language.Haskell.TH.PprLib: lbrace :: Doc
- Language.Haskell.TH.PprLib: lbrack :: Doc
- Language.Haskell.TH.PprLib: lparen :: Doc
- Language.Haskell.TH.PprLib: nest :: Int -> Doc -> Doc
- Language.Haskell.TH.PprLib: parens :: Doc -> Doc
- Language.Haskell.TH.PprLib: pprName :: Name -> Doc
- Language.Haskell.TH.PprLib: pprName' :: NameIs -> Name -> Doc
- Language.Haskell.TH.PprLib: ptext :: String -> Doc
- Language.Haskell.TH.PprLib: punctuate :: Doc -> [Doc] -> [Doc]
- Language.Haskell.TH.PprLib: quotes :: Doc -> Doc
- Language.Haskell.TH.PprLib: rational :: Rational -> Doc
- Language.Haskell.TH.PprLib: rbrace :: Doc
- Language.Haskell.TH.PprLib: rbrack :: Doc
- Language.Haskell.TH.PprLib: rparen :: Doc
- Language.Haskell.TH.PprLib: semi :: Doc
- Language.Haskell.TH.PprLib: sep :: [Doc] -> Doc
- Language.Haskell.TH.PprLib: space :: Doc
- Language.Haskell.TH.PprLib: text :: String -> Doc
- Language.Haskell.TH.PprLib: to_HPJ_Doc :: Doc -> Doc
- Language.Haskell.TH.PprLib: type Doc = PprM Doc
- Language.Haskell.TH.PprLib: vcat :: [Doc] -> Doc
- Language.Haskell.TH.Syntax: ($dmlift) :: forall m. (Lift t, r ~ LiftedRep, Quote m) => t -> m Exp
- Language.Haskell.TH.Syntax: AllPhases :: Phases
- Language.Haskell.TH.Syntax: Alone :: NameIs
- Language.Haskell.TH.Syntax: AnnLookupModule :: Module -> AnnLookup
- Language.Haskell.TH.Syntax: AnnLookupName :: Name -> AnnLookup
- Language.Haskell.TH.Syntax: AnnP :: AnnTarget -> Exp -> Pragma
- Language.Haskell.TH.Syntax: AnyclassStrategy :: DerivStrategy
- Language.Haskell.TH.Syntax: AppE :: Exp -> Exp -> Exp
- Language.Haskell.TH.Syntax: AppKindT :: Type -> Kind -> Type
- Language.Haskell.TH.Syntax: AppT :: Type -> Type -> Type
- Language.Haskell.TH.Syntax: AppTypeE :: Exp -> Type -> Exp
- Language.Haskell.TH.Syntax: Applied :: NameIs
- Language.Haskell.TH.Syntax: ArgDoc :: Name -> Int -> DocLoc
- Language.Haskell.TH.Syntax: ArithSeqE :: Range -> Exp
- Language.Haskell.TH.Syntax: ArrowT :: Type
- Language.Haskell.TH.Syntax: AsP :: Name -> Pat -> Pat
- Language.Haskell.TH.Syntax: Bang :: SourceUnpackedness -> SourceStrictness -> Bang
- Language.Haskell.TH.Syntax: BangP :: Pat -> Pat
- Language.Haskell.TH.Syntax: BeforePhase :: Int -> Phases
- Language.Haskell.TH.Syntax: BindS :: Pat -> Exp -> Stmt
- Language.Haskell.TH.Syntax: BndrInvis :: BndrVis
- Language.Haskell.TH.Syntax: BndrReq :: BndrVis
- Language.Haskell.TH.Syntax: Bytes :: ForeignPtr Word8 -> Word -> Word -> Bytes
- Language.Haskell.TH.Syntax: BytesPrimL :: Bytes -> Lit
- Language.Haskell.TH.Syntax: CApi :: Callconv
- Language.Haskell.TH.Syntax: CCall :: Callconv
- Language.Haskell.TH.Syntax: CaseE :: Exp -> [Match] -> Exp
- Language.Haskell.TH.Syntax: CharL :: Char -> Lit
- Language.Haskell.TH.Syntax: CharPrimL :: Char -> Lit
- Language.Haskell.TH.Syntax: CharTyLit :: Char -> TyLit
- Language.Haskell.TH.Syntax: ClassD :: Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [Dec] -> Dec
- Language.Haskell.TH.Syntax: ClassI :: Dec -> [InstanceDec] -> Info
- Language.Haskell.TH.Syntax: ClassOpI :: Name -> Type -> ParentName -> Info
- Language.Haskell.TH.Syntax: Clause :: [Pat] -> Body -> [Dec] -> Clause
- Language.Haskell.TH.Syntax: ClosedTypeFamilyD :: TypeFamilyHead -> [TySynEqn] -> Dec
- Language.Haskell.TH.Syntax: Code :: m (TExp a) -> Code (m :: Type -> Type) (a :: TYPE r)
- Language.Haskell.TH.Syntax: CompE :: [Stmt] -> Exp
- Language.Haskell.TH.Syntax: CompleteP :: [Name] -> Maybe Name -> Pragma
- Language.Haskell.TH.Syntax: ConE :: Name -> Exp
- Language.Haskell.TH.Syntax: ConLike :: RuleMatch
- Language.Haskell.TH.Syntax: ConP :: Name -> [Type] -> [Pat] -> Pat
- Language.Haskell.TH.Syntax: ConT :: Name -> Type
- Language.Haskell.TH.Syntax: CondE :: Exp -> Exp -> Exp -> Exp
- Language.Haskell.TH.Syntax: ConstraintT :: Type
- Language.Haskell.TH.Syntax: DataConI :: Name -> Type -> ParentName -> Info
- Language.Haskell.TH.Syntax: DataD :: Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [Con] -> [DerivClause] -> Dec
- Language.Haskell.TH.Syntax: DataFamilyD :: Name -> [TyVarBndr BndrVis] -> Maybe Kind -> Dec
- Language.Haskell.TH.Syntax: DataInstD :: Cxt -> Maybe [TyVarBndr ()] -> Type -> Maybe Kind -> [Con] -> [DerivClause] -> Dec
- Language.Haskell.TH.Syntax: DataName :: NameSpace
- Language.Haskell.TH.Syntax: DataNamespaceSpecifier :: NamespaceSpecifier
- Language.Haskell.TH.Syntax: DecidedLazy :: DecidedStrictness
- Language.Haskell.TH.Syntax: DecidedStrict :: DecidedStrictness
- Language.Haskell.TH.Syntax: DecidedUnpack :: DecidedStrictness
- Language.Haskell.TH.Syntax: DeclDoc :: Name -> DocLoc
- Language.Haskell.TH.Syntax: DefaultD :: [Type] -> Dec
- Language.Haskell.TH.Syntax: DefaultSigD :: Name -> Type -> Dec
- Language.Haskell.TH.Syntax: DerivClause :: Maybe DerivStrategy -> Cxt -> DerivClause
- Language.Haskell.TH.Syntax: DoE :: Maybe ModName -> [Stmt] -> Exp
- Language.Haskell.TH.Syntax: DoublePrimL :: Rational -> Lit
- Language.Haskell.TH.Syntax: EqualityT :: Type
- Language.Haskell.TH.Syntax: ExplBidir :: [Clause] -> PatSynDir
- Language.Haskell.TH.Syntax: ExportF :: Callconv -> String -> Name -> Type -> Foreign
- Language.Haskell.TH.Syntax: FamilyI :: Dec -> [InstanceDec] -> Info
- Language.Haskell.TH.Syntax: Fixity :: Int -> FixityDirection -> Fixity
- Language.Haskell.TH.Syntax: FldName :: !String -> NameSpace
- Language.Haskell.TH.Syntax: FloatPrimL :: Rational -> Lit
- Language.Haskell.TH.Syntax: ForallC :: [TyVarBndr Specificity] -> Cxt -> Con -> Con
- Language.Haskell.TH.Syntax: ForallT :: [TyVarBndr Specificity] -> Cxt -> Type -> Type
- Language.Haskell.TH.Syntax: ForallVisT :: [TyVarBndr ()] -> Type -> Type
- Language.Haskell.TH.Syntax: ForeignD :: Foreign -> Dec
- Language.Haskell.TH.Syntax: FromPhase :: Int -> Phases
- Language.Haskell.TH.Syntax: FromR :: Exp -> Range
- Language.Haskell.TH.Syntax: FromThenR :: Exp -> Exp -> Range
- Language.Haskell.TH.Syntax: FromThenToR :: Exp -> Exp -> Exp -> Range
- Language.Haskell.TH.Syntax: FromToR :: Exp -> Exp -> Range
- Language.Haskell.TH.Syntax: FunD :: Name -> [Clause] -> Dec
- Language.Haskell.TH.Syntax: FunDep :: [Name] -> [Name] -> FunDep
- Language.Haskell.TH.Syntax: FunLike :: RuleMatch
- Language.Haskell.TH.Syntax: GadtC :: [Name] -> [BangType] -> Type -> Con
- Language.Haskell.TH.Syntax: GetFieldE :: Exp -> String -> Exp
- Language.Haskell.TH.Syntax: GuardedB :: [(Guard, Exp)] -> Body
- Language.Haskell.TH.Syntax: ImplBidir :: PatSynDir
- Language.Haskell.TH.Syntax: ImplicitParamBindD :: String -> Exp -> Dec
- Language.Haskell.TH.Syntax: ImplicitParamT :: String -> Type -> Type
- Language.Haskell.TH.Syntax: ImplicitParamVarE :: String -> Exp
- Language.Haskell.TH.Syntax: ImportF :: Callconv -> Safety -> String -> Name -> Type -> Foreign
- Language.Haskell.TH.Syntax: Incoherent :: Overlap
- Language.Haskell.TH.Syntax: InferR :: Role
- Language.Haskell.TH.Syntax: InferredSpec :: Specificity
- Language.Haskell.TH.Syntax: Infix :: NameIs
- Language.Haskell.TH.Syntax: InfixC :: BangType -> Name -> BangType -> Con
- Language.Haskell.TH.Syntax: InfixD :: Fixity -> NamespaceSpecifier -> Name -> Dec
- Language.Haskell.TH.Syntax: InfixE :: Maybe Exp -> Exp -> Maybe Exp -> Exp
- Language.Haskell.TH.Syntax: InfixL :: FixityDirection
- Language.Haskell.TH.Syntax: InfixN :: FixityDirection
- Language.Haskell.TH.Syntax: InfixP :: Pat -> Name -> Pat -> Pat
- Language.Haskell.TH.Syntax: InfixPatSyn :: Name -> Name -> PatSynArgs
- Language.Haskell.TH.Syntax: InfixR :: FixityDirection
- Language.Haskell.TH.Syntax: InfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH.Syntax: InjectivityAnn :: Name -> [Name] -> InjectivityAnn
- Language.Haskell.TH.Syntax: Inlinable :: Inline
- Language.Haskell.TH.Syntax: Inline :: Inline
- Language.Haskell.TH.Syntax: InlineP :: Name -> Inline -> RuleMatch -> Phases -> Pragma
- Language.Haskell.TH.Syntax: InstDoc :: Type -> DocLoc
- Language.Haskell.TH.Syntax: InstanceD :: Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
- Language.Haskell.TH.Syntax: IntPrimL :: Integer -> Lit
- Language.Haskell.TH.Syntax: IntegerL :: Integer -> Lit
- Language.Haskell.TH.Syntax: Interruptible :: Safety
- Language.Haskell.TH.Syntax: InvisP :: Type -> Pat
- Language.Haskell.TH.Syntax: JavaScript :: Callconv
- Language.Haskell.TH.Syntax: KiSigD :: Name -> Kind -> Dec
- Language.Haskell.TH.Syntax: KindSig :: Kind -> FamilyResultSig
- Language.Haskell.TH.Syntax: KindedTV :: Name -> flag -> Kind -> TyVarBndr flag
- Language.Haskell.TH.Syntax: LabelE :: String -> Exp
- Language.Haskell.TH.Syntax: LamCaseE :: [Match] -> Exp
- Language.Haskell.TH.Syntax: LamCasesE :: [Clause] -> Exp
- Language.Haskell.TH.Syntax: LamE :: [Pat] -> Exp -> Exp
- Language.Haskell.TH.Syntax: LangAsm :: ForeignSrcLang
- Language.Haskell.TH.Syntax: LangC :: ForeignSrcLang
- Language.Haskell.TH.Syntax: LangCxx :: ForeignSrcLang
- Language.Haskell.TH.Syntax: LangJs :: ForeignSrcLang
- Language.Haskell.TH.Syntax: LangObjc :: ForeignSrcLang
- Language.Haskell.TH.Syntax: LangObjcxx :: ForeignSrcLang
- Language.Haskell.TH.Syntax: LetE :: [Dec] -> Exp -> Exp
- Language.Haskell.TH.Syntax: LetS :: [Dec] -> Stmt
- Language.Haskell.TH.Syntax: LineP :: Int -> String -> Pragma
- Language.Haskell.TH.Syntax: ListE :: [Exp] -> Exp
- Language.Haskell.TH.Syntax: ListP :: [Pat] -> Pat
- Language.Haskell.TH.Syntax: ListT :: Type
- Language.Haskell.TH.Syntax: LitE :: Lit -> Exp
- Language.Haskell.TH.Syntax: LitP :: Lit -> Pat
- Language.Haskell.TH.Syntax: LitT :: TyLit -> Type
- Language.Haskell.TH.Syntax: Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
- Language.Haskell.TH.Syntax: MDoE :: Maybe ModName -> [Stmt] -> Exp
- Language.Haskell.TH.Syntax: Match :: Pat -> Body -> [Dec] -> Match
- Language.Haskell.TH.Syntax: ModName :: String -> ModName
- Language.Haskell.TH.Syntax: Module :: PkgName -> ModName -> Module
- Language.Haskell.TH.Syntax: ModuleAnnotation :: AnnTarget
- Language.Haskell.TH.Syntax: ModuleDoc :: DocLoc
- Language.Haskell.TH.Syntax: ModuleInfo :: [Module] -> ModuleInfo
- Language.Haskell.TH.Syntax: MulArrowT :: Type
- Language.Haskell.TH.Syntax: MultiIfE :: [(Guard, Exp)] -> Exp
- Language.Haskell.TH.Syntax: Name :: OccName -> NameFlavour -> Name
- Language.Haskell.TH.Syntax: NameG :: NameSpace -> PkgName -> ModName -> NameFlavour
- Language.Haskell.TH.Syntax: NameL :: !Uniq -> NameFlavour
- Language.Haskell.TH.Syntax: NameQ :: ModName -> NameFlavour
- Language.Haskell.TH.Syntax: NameS :: NameFlavour
- Language.Haskell.TH.Syntax: NameU :: !Uniq -> NameFlavour
- Language.Haskell.TH.Syntax: NewtypeD :: Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> Con -> [DerivClause] -> Dec
- Language.Haskell.TH.Syntax: NewtypeInstD :: Cxt -> Maybe [TyVarBndr ()] -> Type -> Maybe Kind -> Con -> [DerivClause] -> Dec
- Language.Haskell.TH.Syntax: NewtypeStrategy :: DerivStrategy
- Language.Haskell.TH.Syntax: NoBindS :: Exp -> Stmt
- Language.Haskell.TH.Syntax: NoInline :: Inline
- Language.Haskell.TH.Syntax: NoNamespaceSpecifier :: NamespaceSpecifier
- Language.Haskell.TH.Syntax: NoSig :: FamilyResultSig
- Language.Haskell.TH.Syntax: NoSourceStrictness :: SourceStrictness
- Language.Haskell.TH.Syntax: NoSourceUnpackedness :: SourceUnpackedness
- Language.Haskell.TH.Syntax: NominalR :: Role
- Language.Haskell.TH.Syntax: NormalB :: Exp -> Body
- Language.Haskell.TH.Syntax: NormalC :: Name -> [BangType] -> Con
- Language.Haskell.TH.Syntax: NormalG :: Exp -> Guard
- Language.Haskell.TH.Syntax: NumTyLit :: Integer -> TyLit
- Language.Haskell.TH.Syntax: OccName :: String -> OccName
- Language.Haskell.TH.Syntax: OpaqueP :: Name -> Pragma
- Language.Haskell.TH.Syntax: OpenTypeFamilyD :: TypeFamilyHead -> Dec
- Language.Haskell.TH.Syntax: Overlappable :: Overlap
- Language.Haskell.TH.Syntax: Overlapping :: Overlap
- Language.Haskell.TH.Syntax: Overlaps :: Overlap
- Language.Haskell.TH.Syntax: ParS :: [[Stmt]] -> Stmt
- Language.Haskell.TH.Syntax: ParensE :: Exp -> Exp
- Language.Haskell.TH.Syntax: ParensP :: Pat -> Pat
- Language.Haskell.TH.Syntax: ParensT :: Type -> Type
- Language.Haskell.TH.Syntax: PatG :: [Stmt] -> Guard
- Language.Haskell.TH.Syntax: PatSynD :: Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
- Language.Haskell.TH.Syntax: PatSynI :: Name -> PatSynType -> Info
- Language.Haskell.TH.Syntax: PatSynSigD :: Name -> PatSynType -> Dec
- Language.Haskell.TH.Syntax: PhantomR :: Role
- Language.Haskell.TH.Syntax: PkgName :: String -> PkgName
- Language.Haskell.TH.Syntax: PlainTV :: Name -> flag -> TyVarBndr flag
- Language.Haskell.TH.Syntax: PragmaD :: Pragma -> Dec
- Language.Haskell.TH.Syntax: PrefixPatSyn :: [Name] -> PatSynArgs
- Language.Haskell.TH.Syntax: Prim :: Callconv
- Language.Haskell.TH.Syntax: PrimTyConI :: Name -> Arity -> Unlifted -> Info
- Language.Haskell.TH.Syntax: ProjectionE :: NonEmpty String -> Exp
- Language.Haskell.TH.Syntax: PromotedConsT :: Type
- Language.Haskell.TH.Syntax: PromotedInfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH.Syntax: PromotedNilT :: Type
- Language.Haskell.TH.Syntax: PromotedT :: Name -> Type
- Language.Haskell.TH.Syntax: PromotedTupleT :: Int -> Type
- Language.Haskell.TH.Syntax: PromotedUInfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH.Syntax: Q :: (forall (m :: Type -> Type). Quasi m => m a) -> Q a
- Language.Haskell.TH.Syntax: RationalL :: Rational -> Lit
- Language.Haskell.TH.Syntax: RawObject :: ForeignSrcLang
- Language.Haskell.TH.Syntax: RecC :: Name -> [VarBangType] -> Con
- Language.Haskell.TH.Syntax: RecConE :: Name -> [FieldExp] -> Exp
- Language.Haskell.TH.Syntax: RecGadtC :: [Name] -> [VarBangType] -> Type -> Con
- Language.Haskell.TH.Syntax: RecP :: Name -> [FieldPat] -> Pat
- Language.Haskell.TH.Syntax: RecS :: [Stmt] -> Stmt
- Language.Haskell.TH.Syntax: RecUpdE :: Exp -> [FieldExp] -> Exp
- Language.Haskell.TH.Syntax: RecordPatSyn :: [Name] -> PatSynArgs
- Language.Haskell.TH.Syntax: RepresentationalR :: Role
- Language.Haskell.TH.Syntax: RoleAnnotD :: Name -> [Role] -> Dec
- Language.Haskell.TH.Syntax: RuleP :: String -> Maybe [TyVarBndr ()] -> [RuleBndr] -> Exp -> Exp -> Phases -> Pragma
- Language.Haskell.TH.Syntax: RuleVar :: Name -> RuleBndr
- Language.Haskell.TH.Syntax: SCCP :: Name -> Maybe String -> Pragma
- Language.Haskell.TH.Syntax: Safe :: Safety
- Language.Haskell.TH.Syntax: SigD :: Name -> Type -> Dec
- Language.Haskell.TH.Syntax: SigE :: Exp -> Type -> Exp
- Language.Haskell.TH.Syntax: SigP :: Pat -> Type -> Pat
- Language.Haskell.TH.Syntax: SigT :: Type -> Kind -> Type
- Language.Haskell.TH.Syntax: SourceLazy :: SourceStrictness
- Language.Haskell.TH.Syntax: SourceNoUnpack :: SourceUnpackedness
- Language.Haskell.TH.Syntax: SourceStrict :: SourceStrictness
- Language.Haskell.TH.Syntax: SourceUnpack :: SourceUnpackedness
- Language.Haskell.TH.Syntax: SpecialiseInstP :: Type -> Pragma
- Language.Haskell.TH.Syntax: SpecialiseP :: Name -> Type -> Maybe Inline -> Phases -> Pragma
- Language.Haskell.TH.Syntax: SpecifiedSpec :: Specificity
- Language.Haskell.TH.Syntax: StandaloneDerivD :: Maybe DerivStrategy -> Cxt -> Type -> Dec
- Language.Haskell.TH.Syntax: StarT :: Type
- Language.Haskell.TH.Syntax: StaticE :: Exp -> Exp
- Language.Haskell.TH.Syntax: StdCall :: Callconv
- Language.Haskell.TH.Syntax: StockStrategy :: DerivStrategy
- Language.Haskell.TH.Syntax: StrTyLit :: String -> TyLit
- Language.Haskell.TH.Syntax: StringL :: String -> Lit
- Language.Haskell.TH.Syntax: StringPrimL :: [Word8] -> Lit
- Language.Haskell.TH.Syntax: TExp :: Exp -> TExp (a :: TYPE r)
- Language.Haskell.TH.Syntax: TcClsName :: NameSpace
- Language.Haskell.TH.Syntax: TildeP :: Pat -> Pat
- Language.Haskell.TH.Syntax: TupE :: [Maybe Exp] -> Exp
- Language.Haskell.TH.Syntax: TupP :: [Pat] -> Pat
- Language.Haskell.TH.Syntax: TupleT :: Int -> Type
- Language.Haskell.TH.Syntax: TyConI :: Dec -> Info
- Language.Haskell.TH.Syntax: TySynD :: Name -> [TyVarBndr BndrVis] -> Type -> Dec
- Language.Haskell.TH.Syntax: TySynEqn :: Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
- Language.Haskell.TH.Syntax: TySynInstD :: TySynEqn -> Dec
- Language.Haskell.TH.Syntax: TyVarI :: Name -> Type -> Info
- Language.Haskell.TH.Syntax: TyVarSig :: TyVarBndr () -> FamilyResultSig
- Language.Haskell.TH.Syntax: TypeAnnotation :: Name -> AnnTarget
- Language.Haskell.TH.Syntax: TypeDataD :: Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [Con] -> Dec
- Language.Haskell.TH.Syntax: TypeE :: Type -> Exp
- Language.Haskell.TH.Syntax: TypeFamilyHead :: Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> TypeFamilyHead
- Language.Haskell.TH.Syntax: TypeNamespaceSpecifier :: NamespaceSpecifier
- Language.Haskell.TH.Syntax: TypeP :: Type -> Pat
- Language.Haskell.TH.Syntax: TypedBracketE :: Exp -> Exp
- Language.Haskell.TH.Syntax: TypedRuleVar :: Name -> Type -> RuleBndr
- Language.Haskell.TH.Syntax: TypedSpliceE :: Exp -> Exp
- Language.Haskell.TH.Syntax: UInfixE :: Exp -> Exp -> Exp -> Exp
- Language.Haskell.TH.Syntax: UInfixP :: Pat -> Name -> Pat -> Pat
- Language.Haskell.TH.Syntax: UInfixT :: Type -> Name -> Type -> Type
- Language.Haskell.TH.Syntax: UnboundVarE :: Name -> Exp
- Language.Haskell.TH.Syntax: UnboxedSumE :: Exp -> SumAlt -> SumArity -> Exp
- Language.Haskell.TH.Syntax: UnboxedSumP :: Pat -> SumAlt -> SumArity -> Pat
- Language.Haskell.TH.Syntax: UnboxedSumT :: SumArity -> Type
- Language.Haskell.TH.Syntax: UnboxedTupE :: [Maybe Exp] -> Exp
- Language.Haskell.TH.Syntax: UnboxedTupP :: [Pat] -> Pat
- Language.Haskell.TH.Syntax: UnboxedTupleT :: Int -> Type
- Language.Haskell.TH.Syntax: Unidir :: PatSynDir
- Language.Haskell.TH.Syntax: Unsafe :: Safety
- Language.Haskell.TH.Syntax: ValD :: Pat -> Body -> [Dec] -> Dec
- Language.Haskell.TH.Syntax: ValueAnnotation :: Name -> AnnTarget
- Language.Haskell.TH.Syntax: VarE :: Name -> Exp
- Language.Haskell.TH.Syntax: VarI :: Name -> Type -> Maybe Dec -> Info
- Language.Haskell.TH.Syntax: VarName :: NameSpace
- Language.Haskell.TH.Syntax: VarP :: Name -> Pat
- Language.Haskell.TH.Syntax: VarT :: Name -> Type
- Language.Haskell.TH.Syntax: ViaStrategy :: Type -> DerivStrategy
- Language.Haskell.TH.Syntax: ViewP :: Exp -> Pat -> Pat
- Language.Haskell.TH.Syntax: WildCardT :: Type
- Language.Haskell.TH.Syntax: WildP :: Pat
- Language.Haskell.TH.Syntax: WordPrimL :: Integer -> Lit
- Language.Haskell.TH.Syntax: [bytesOffset] :: Bytes -> Word
- Language.Haskell.TH.Syntax: [bytesPtr] :: Bytes -> ForeignPtr Word8
- Language.Haskell.TH.Syntax: [bytesSize] :: Bytes -> Word
- Language.Haskell.TH.Syntax: [examineCode] :: Code (m :: Type -> Type) (a :: TYPE r) -> m (TExp a)
- Language.Haskell.TH.Syntax: [fldParent] :: NameSpace -> !String
- Language.Haskell.TH.Syntax: [loc_end] :: Loc -> CharPos
- Language.Haskell.TH.Syntax: [loc_filename] :: Loc -> String
- Language.Haskell.TH.Syntax: [loc_module] :: Loc -> String
- Language.Haskell.TH.Syntax: [loc_package] :: Loc -> String
- Language.Haskell.TH.Syntax: [loc_start] :: Loc -> CharPos
- Language.Haskell.TH.Syntax: [unQ] :: Q a -> forall (m :: Type -> Type). Quasi m => m a
- Language.Haskell.TH.Syntax: [unType] :: TExp (a :: TYPE r) -> Exp
- Language.Haskell.TH.Syntax: addCorePlugin :: String -> Q ()
- Language.Haskell.TH.Syntax: addDependentFile :: FilePath -> Q ()
- Language.Haskell.TH.Syntax: addForeignFile :: ForeignSrcLang -> String -> Q ()
- Language.Haskell.TH.Syntax: addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
- Language.Haskell.TH.Syntax: addForeignSource :: ForeignSrcLang -> String -> Q ()
- Language.Haskell.TH.Syntax: addModFinalizer :: Q () -> Q ()
- Language.Haskell.TH.Syntax: addTempFile :: String -> Q FilePath
- Language.Haskell.TH.Syntax: addTopDecls :: [Dec] -> Q ()
- Language.Haskell.TH.Syntax: addrToByteArray :: Int -> Addr# -> ByteArray
- Language.Haskell.TH.Syntax: addrToByteArrayName :: Name
- Language.Haskell.TH.Syntax: badIO :: String -> IO a
- Language.Haskell.TH.Syntax: bindCode :: Monad m => m a -> (a -> Code m b) -> Code m b
- Language.Haskell.TH.Syntax: bindCode_ :: Monad m => m a -> Code m b -> Code m b
- Language.Haskell.TH.Syntax: class Lift (t :: TYPE r)
- Language.Haskell.TH.Syntax: class (MonadIO m, MonadFail m) => Quasi (m :: Type -> Type)
- Language.Haskell.TH.Syntax: class Monad m => Quote (m :: Type -> Type)
- Language.Haskell.TH.Syntax: cmpEq :: Ordering -> Bool
- Language.Haskell.TH.Syntax: compareBytes :: Bytes -> Bytes -> Ordering
- Language.Haskell.TH.Syntax: counter :: IORef Uniq
- Language.Haskell.TH.Syntax: data AnnLookup
- Language.Haskell.TH.Syntax: data AnnTarget
- Language.Haskell.TH.Syntax: data Bang
- Language.Haskell.TH.Syntax: data BndrVis
- Language.Haskell.TH.Syntax: data Body
- Language.Haskell.TH.Syntax: data Bytes
- Language.Haskell.TH.Syntax: data Callconv
- Language.Haskell.TH.Syntax: data Clause
- Language.Haskell.TH.Syntax: data Con
- Language.Haskell.TH.Syntax: data Dec
- Language.Haskell.TH.Syntax: data DecidedStrictness
- Language.Haskell.TH.Syntax: data DerivClause
- Language.Haskell.TH.Syntax: data DerivStrategy
- Language.Haskell.TH.Syntax: data DocLoc
- Language.Haskell.TH.Syntax: data Exp
- Language.Haskell.TH.Syntax: data FamilyResultSig
- Language.Haskell.TH.Syntax: data Fixity
- Language.Haskell.TH.Syntax: data FixityDirection
- Language.Haskell.TH.Syntax: data Foreign
- Language.Haskell.TH.Syntax: data ForeignSrcLang
- Language.Haskell.TH.Syntax: data FunDep
- Language.Haskell.TH.Syntax: data Guard
- Language.Haskell.TH.Syntax: data Info
- Language.Haskell.TH.Syntax: data InjectivityAnn
- Language.Haskell.TH.Syntax: data Inline
- Language.Haskell.TH.Syntax: data Lit
- Language.Haskell.TH.Syntax: data Loc
- Language.Haskell.TH.Syntax: data Match
- Language.Haskell.TH.Syntax: data Module
- Language.Haskell.TH.Syntax: data ModuleInfo
- Language.Haskell.TH.Syntax: data Name
- Language.Haskell.TH.Syntax: data NameFlavour
- Language.Haskell.TH.Syntax: data NameIs
- Language.Haskell.TH.Syntax: data NameSpace
- Language.Haskell.TH.Syntax: data NamespaceSpecifier
- Language.Haskell.TH.Syntax: data Overlap
- Language.Haskell.TH.Syntax: data Pat
- Language.Haskell.TH.Syntax: data PatSynArgs
- Language.Haskell.TH.Syntax: data PatSynDir
- Language.Haskell.TH.Syntax: data Phases
- Language.Haskell.TH.Syntax: data Pragma
- Language.Haskell.TH.Syntax: data Range
- Language.Haskell.TH.Syntax: data Role
- Language.Haskell.TH.Syntax: data RuleBndr
- Language.Haskell.TH.Syntax: data RuleMatch
- Language.Haskell.TH.Syntax: data Safety
- Language.Haskell.TH.Syntax: data SourceStrictness
- Language.Haskell.TH.Syntax: data SourceUnpackedness
- Language.Haskell.TH.Syntax: data Specificity
- Language.Haskell.TH.Syntax: data Stmt
- Language.Haskell.TH.Syntax: data TyLit
- Language.Haskell.TH.Syntax: data TySynEqn
- Language.Haskell.TH.Syntax: data TyVarBndr flag
- Language.Haskell.TH.Syntax: data Type
- Language.Haskell.TH.Syntax: data TypeFamilyHead
- Language.Haskell.TH.Syntax: dataToExpQ :: (Quote m, Data a) => (forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
- Language.Haskell.TH.Syntax: dataToPatQ :: (Quote m, Data a) => (forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
- Language.Haskell.TH.Syntax: dataToQa :: (Quote m, Data a) => (Name -> k) -> (Lit -> m q) -> (k -> [m q] -> m q) -> (forall b. Data b => b -> Maybe (m q)) -> a -> m q
- Language.Haskell.TH.Syntax: defaultFixity :: Fixity
- Language.Haskell.TH.Syntax: eqBytes :: Bytes -> Bytes -> Bool
- Language.Haskell.TH.Syntax: extsEnabled :: Q [Extension]
- Language.Haskell.TH.Syntax: falseName :: Name
- Language.Haskell.TH.Syntax: getDoc :: DocLoc -> Q (Maybe String)
- Language.Haskell.TH.Syntax: getPackageRoot :: Q FilePath
- Language.Haskell.TH.Syntax: getQ :: Typeable a => Q (Maybe a)
- Language.Haskell.TH.Syntax: get_cons_names :: Con -> [Name]
- Language.Haskell.TH.Syntax: hoistCode :: Monad m => (forall x. () => m x -> n x) -> Code m a -> Code n a
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b) => Language.Haskell.TH.Syntax.Lift (# a | b #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b) => Language.Haskell.TH.Syntax.Lift (# a, b #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b) => Language.Haskell.TH.Syntax.Lift (Data.Either.Either a b)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b) => Language.Haskell.TH.Syntax.Lift (a, b)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c) => Language.Haskell.TH.Syntax.Lift (# a | b | c #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c) => Language.Haskell.TH.Syntax.Lift (# a, b, c #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c) => Language.Haskell.TH.Syntax.Lift (a, b, c)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d) => Language.Haskell.TH.Syntax.Lift (# a | b | c | d #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d) => Language.Haskell.TH.Syntax.Lift (# a, b, c, d #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d) => Language.Haskell.TH.Syntax.Lift (a, b, c, d)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e) => Language.Haskell.TH.Syntax.Lift (# a | b | c | d | e #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e) => Language.Haskell.TH.Syntax.Lift (# a, b, c, d, e #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e) => Language.Haskell.TH.Syntax.Lift (a, b, c, d, e)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e, Language.Haskell.TH.Syntax.Lift f) => Language.Haskell.TH.Syntax.Lift (# a | b | c | d | e | f #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e, Language.Haskell.TH.Syntax.Lift f) => Language.Haskell.TH.Syntax.Lift (# a, b, c, d, e, f #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e, Language.Haskell.TH.Syntax.Lift f) => Language.Haskell.TH.Syntax.Lift (a, b, c, d, e, f)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e, Language.Haskell.TH.Syntax.Lift f, Language.Haskell.TH.Syntax.Lift g) => Language.Haskell.TH.Syntax.Lift (# a | b | c | d | e | f | g #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e, Language.Haskell.TH.Syntax.Lift f, Language.Haskell.TH.Syntax.Lift g) => Language.Haskell.TH.Syntax.Lift (# a, b, c, d, e, f, g #)
- Language.Haskell.TH.Syntax: instance (Language.Haskell.TH.Syntax.Lift a, Language.Haskell.TH.Syntax.Lift b, Language.Haskell.TH.Syntax.Lift c, Language.Haskell.TH.Syntax.Lift d, Language.Haskell.TH.Syntax.Lift e, Language.Haskell.TH.Syntax.Lift f, Language.Haskell.TH.Syntax.Lift g) => Language.Haskell.TH.Syntax.Lift (a, b, c, d, e, f, g)
- Language.Haskell.TH.Syntax: instance Control.Monad.Fail.MonadFail Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance Control.Monad.Fix.MonadFix Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance Control.Monad.IO.Class.MonadIO Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.AnnLookup
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.AnnTarget
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Bang
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Body
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Bytes
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Callconv
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Clause
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Con
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Dec
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.DecidedStrictness
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.DerivClause
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.DerivStrategy
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.DocLoc
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Exp
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.FamilyResultSig
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Fixity
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.FixityDirection
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Foreign
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.FunDep
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Guard
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Info
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.InjectivityAnn
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Inline
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Lit
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Loc
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Match
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.ModName
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Module
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.ModuleInfo
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Name
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.NameFlavour
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.NameSpace
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.NamespaceSpecifier
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.OccName
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Overlap
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Pat
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.PatSynArgs
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.PatSynDir
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Phases
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.PkgName
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Pragma
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Range
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Role
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.RuleBndr
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.RuleMatch
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Safety
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.SourceStrictness
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.SourceUnpackedness
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Stmt
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.TyLit
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.TySynEqn
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.Type
- Language.Haskell.TH.Syntax: instance Data.Data.Data Language.Haskell.TH.Syntax.TypeFamilyHead
- Language.Haskell.TH.Syntax: instance Data.Data.Data flag => Data.Data.Data (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.TH.Syntax: instance Data.Foldable.Foldable Language.Haskell.TH.Syntax.TyVarBndr
- Language.Haskell.TH.Syntax: instance Data.Traversable.Traversable Language.Haskell.TH.Syntax.TyVarBndr
- Language.Haskell.TH.Syntax: instance GHC.Base.Applicative Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance GHC.Base.Functor Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance GHC.Base.Functor Language.Haskell.TH.Syntax.TyVarBndr
- Language.Haskell.TH.Syntax: instance GHC.Base.Monad Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance GHC.Base.Monoid a => GHC.Base.Monoid (Language.Haskell.TH.Syntax.Q a)
- Language.Haskell.TH.Syntax: instance GHC.Base.Semigroup a => GHC.Base.Semigroup (Language.Haskell.TH.Syntax.Q a)
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.AnnLookup
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.AnnTarget
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Bang
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Body
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Bytes
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Callconv
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Clause
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Con
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Dec
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.DecidedStrictness
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.DerivClause
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.DerivStrategy
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.DocLoc
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Exp
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.FamilyResultSig
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Fixity
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.FixityDirection
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Foreign
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.FunDep
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Guard
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Info
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.InjectivityAnn
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Inline
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Lit
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Loc
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Match
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.ModName
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Module
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.ModuleInfo
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Name
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.NameFlavour
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.NameSpace
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.NamespaceSpecifier
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.OccName
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Overlap
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Pat
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.PatSynArgs
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.PatSynDir
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Phases
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.PkgName
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Pragma
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Range
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Role
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.RuleBndr
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.RuleMatch
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Safety
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.SourceStrictness
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.SourceUnpackedness
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Stmt
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.TyLit
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.TySynEqn
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.Type
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq Language.Haskell.TH.Syntax.TypeFamilyHead
- Language.Haskell.TH.Syntax: instance GHC.Classes.Eq flag => GHC.Classes.Eq (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.AnnLookup
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.AnnTarget
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Bang
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Body
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Bytes
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Callconv
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Clause
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Con
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Dec
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.DecidedStrictness
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.DerivClause
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.DerivStrategy
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.DocLoc
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Exp
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.FamilyResultSig
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Fixity
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.FixityDirection
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Foreign
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.FunDep
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Guard
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Info
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.InjectivityAnn
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Inline
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Lit
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Loc
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Match
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.ModName
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Module
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.ModuleInfo
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Name
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.NameFlavour
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.NameSpace
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.NamespaceSpecifier
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.OccName
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Overlap
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Pat
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.PatSynArgs
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.PatSynDir
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Phases
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.PkgName
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Pragma
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Range
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Role
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.RuleBndr
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.RuleMatch
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Safety
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.SourceStrictness
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.SourceUnpackedness
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Stmt
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.TyLit
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.TySynEqn
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.Type
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord Language.Haskell.TH.Syntax.TypeFamilyHead
- Language.Haskell.TH.Syntax: instance GHC.Classes.Ord flag => GHC.Classes.Ord (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.AnnLookup
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.AnnTarget
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Bang
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Body
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Bytes
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Callconv
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Clause
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Con
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Dec
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.DecidedStrictness
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.DerivClause
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.DerivStrategy
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.DocLoc
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Exp
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.FamilyResultSig
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Fixity
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.FixityDirection
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Foreign
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.FunDep
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Guard
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Info
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.InjectivityAnn
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Inline
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Lit
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Loc
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Match
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.ModName
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Module
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.ModuleInfo
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Name
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.NameFlavour
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.NameSpace
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.NamespaceSpecifier
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.OccName
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Overlap
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Pat
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.PatSynArgs
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.PatSynDir
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Phases
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.PkgName
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Pragma
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Range
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Role
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.RuleBndr
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.RuleMatch
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Safety
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.SourceStrictness
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.SourceUnpackedness
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Stmt
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.TyLit
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.TySynEqn
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.Type
- Language.Haskell.TH.Syntax: instance GHC.Generics.Generic Language.Haskell.TH.Syntax.TypeFamilyHead
- Language.Haskell.TH.Syntax: instance GHC.Real.Integral a => Language.Haskell.TH.Syntax.Lift (GHC.Real.Ratio a)
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.AnnLookup
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.AnnTarget
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Bang
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.BndrVis
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Body
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Bytes
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Callconv
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Clause
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Con
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Dec
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.DecidedStrictness
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.DerivClause
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.DerivStrategy
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.DocLoc
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Exp
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.FamilyResultSig
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Fixity
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.FixityDirection
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Foreign
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.FunDep
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Guard
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Info
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.InjectivityAnn
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Inline
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Lit
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Loc
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Match
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.ModName
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Module
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.ModuleInfo
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Name
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.NameFlavour
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.NameSpace
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.NamespaceSpecifier
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.OccName
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Overlap
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Pat
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.PatSynArgs
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.PatSynDir
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Phases
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.PkgName
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Pragma
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Range
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Role
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.RuleBndr
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.RuleMatch
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Safety
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.SourceStrictness
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.SourceUnpackedness
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Specificity
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Stmt
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.TyLit
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.TySynEqn
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.Type
- Language.Haskell.TH.Syntax: instance GHC.Show.Show Language.Haskell.TH.Syntax.TypeFamilyHead
- Language.Haskell.TH.Syntax: instance GHC.Show.Show flag => GHC.Show.Show (Language.Haskell.TH.Syntax.TyVarBndr flag)
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift (# #)
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift ()
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift Data.Array.Byte.ByteArray
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Base.Void
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Int.Int16
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Int.Int32
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Int.Int64
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Int.Int8
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Num.Integer.Integer
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Num.Natural.Natural
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Prim.Addr#
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Prim.Char#
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Prim.Double#
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Prim.Float#
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Prim.Int#
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Prim.Word#
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Types.Bool
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Types.Char
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Types.Double
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Types.Float
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Types.Int
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Types.Word
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Word.Word16
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Word.Word32
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Word.Word64
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift GHC.Word.Word8
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift a => Language.Haskell.TH.Syntax.Lift (# a #)
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift a => Language.Haskell.TH.Syntax.Lift (GHC.Base.NonEmpty a)
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift a => Language.Haskell.TH.Syntax.Lift (GHC.Maybe.Maybe a)
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Lift a => Language.Haskell.TH.Syntax.Lift [a]
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Quasi GHC.Types.IO
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Quasi Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Quote GHC.Types.IO
- Language.Haskell.TH.Syntax: instance Language.Haskell.TH.Syntax.Quote Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Syntax: instance forall k (a :: k). Language.Haskell.TH.Syntax.Lift (Data.Fixed.Fixed a)
- Language.Haskell.TH.Syntax: isExtEnabled :: Extension -> Q Bool
- Language.Haskell.TH.Syntax: isInstance :: Name -> [Type] -> Q Bool
- Language.Haskell.TH.Syntax: joinCode :: Monad m => m (Code m a) -> Code m a
- Language.Haskell.TH.Syntax: justName :: Name
- Language.Haskell.TH.Syntax: leftName :: Name
- Language.Haskell.TH.Syntax: lift :: (Lift t, Quote m) => t -> m Exp
- Language.Haskell.TH.Syntax: liftCode :: forall a m. m (TExp a) -> Code m a
- Language.Haskell.TH.Syntax: liftData :: (Quote m, Data a) => a -> m Exp
- Language.Haskell.TH.Syntax: liftString :: Quote m => String -> m Exp
- Language.Haskell.TH.Syntax: liftTyped :: forall (m :: Type -> Type). (Lift t, Quote m) => t -> Code m t
- Language.Haskell.TH.Syntax: location :: Q Loc
- Language.Haskell.TH.Syntax: lookupName :: Bool -> String -> Q (Maybe Name)
- Language.Haskell.TH.Syntax: lookupTypeName :: String -> Q (Maybe Name)
- Language.Haskell.TH.Syntax: lookupValueName :: String -> Q (Maybe Name)
- Language.Haskell.TH.Syntax: makeRelativeToProject :: FilePath -> Q FilePath
- Language.Haskell.TH.Syntax: manyName :: Name
- Language.Haskell.TH.Syntax: maxPrecedence :: Int
- Language.Haskell.TH.Syntax: memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt
- Language.Haskell.TH.Syntax: mkModName :: String -> ModName
- Language.Haskell.TH.Syntax: mkName :: String -> Name
- Language.Haskell.TH.Syntax: mkNameG :: NameSpace -> String -> String -> String -> Name
- Language.Haskell.TH.Syntax: mkNameG_d :: String -> String -> String -> Name
- Language.Haskell.TH.Syntax: mkNameG_fld :: String -> String -> String -> String -> Name
- Language.Haskell.TH.Syntax: mkNameG_tc :: String -> String -> String -> Name
- Language.Haskell.TH.Syntax: mkNameG_v :: String -> String -> String -> Name
- Language.Haskell.TH.Syntax: mkNameL :: String -> Uniq -> Name
- Language.Haskell.TH.Syntax: mkNameQ :: String -> String -> Name
- Language.Haskell.TH.Syntax: mkNameS :: String -> Name
- Language.Haskell.TH.Syntax: mkNameU :: String -> Uniq -> Name
- Language.Haskell.TH.Syntax: mkOccName :: String -> OccName
- Language.Haskell.TH.Syntax: mkPkgName :: String -> PkgName
- Language.Haskell.TH.Syntax: mk_tup_name :: Int -> NameSpace -> Bool -> Name
- Language.Haskell.TH.Syntax: modString :: ModName -> String
- Language.Haskell.TH.Syntax: nameBase :: Name -> String
- Language.Haskell.TH.Syntax: nameModule :: Name -> Maybe String
- Language.Haskell.TH.Syntax: namePackage :: Name -> Maybe String
- Language.Haskell.TH.Syntax: nameSpace :: Name -> Maybe NameSpace
- Language.Haskell.TH.Syntax: newDeclarationGroup :: Q [Dec]
- Language.Haskell.TH.Syntax: newName :: Quote m => String -> m Name
- Language.Haskell.TH.Syntax: newNameIO :: String -> IO Name
- Language.Haskell.TH.Syntax: newtype Code (m :: Type -> Type) (a :: TYPE r)
- Language.Haskell.TH.Syntax: newtype ModName
- Language.Haskell.TH.Syntax: newtype OccName
- Language.Haskell.TH.Syntax: newtype PkgName
- Language.Haskell.TH.Syntax: newtype Q a
- Language.Haskell.TH.Syntax: newtype TExp (a :: TYPE r)
- Language.Haskell.TH.Syntax: nonemptyName :: Name
- Language.Haskell.TH.Syntax: nothingName :: Name
- Language.Haskell.TH.Syntax: occString :: OccName -> String
- Language.Haskell.TH.Syntax: oneName :: Name
- Language.Haskell.TH.Syntax: pkgString :: PkgName -> String
- Language.Haskell.TH.Syntax: putDoc :: DocLoc -> String -> Q ()
- Language.Haskell.TH.Syntax: putQ :: Typeable a => a -> Q ()
- Language.Haskell.TH.Syntax: qAddCorePlugin :: Quasi m => String -> m ()
- Language.Haskell.TH.Syntax: qAddDependentFile :: Quasi m => FilePath -> m ()
- Language.Haskell.TH.Syntax: qAddForeignFilePath :: Quasi m => ForeignSrcLang -> String -> m ()
- Language.Haskell.TH.Syntax: qAddModFinalizer :: Quasi m => Q () -> m ()
- Language.Haskell.TH.Syntax: qAddTempFile :: Quasi m => String -> m FilePath
- Language.Haskell.TH.Syntax: qAddTopDecls :: Quasi m => [Dec] -> m ()
- Language.Haskell.TH.Syntax: qExtsEnabled :: Quasi m => m [Extension]
- Language.Haskell.TH.Syntax: qGetDoc :: Quasi m => DocLoc -> m (Maybe String)
- Language.Haskell.TH.Syntax: qGetPackageRoot :: Quasi m => m FilePath
- Language.Haskell.TH.Syntax: qGetQ :: (Quasi m, Typeable a) => m (Maybe a)
- Language.Haskell.TH.Syntax: qIsExtEnabled :: Quasi m => Extension -> m Bool
- Language.Haskell.TH.Syntax: qLocation :: Quasi m => m Loc
- Language.Haskell.TH.Syntax: qLookupName :: Quasi m => Bool -> String -> m (Maybe Name)
- Language.Haskell.TH.Syntax: qNewName :: Quasi m => String -> m Name
- Language.Haskell.TH.Syntax: qPutDoc :: Quasi m => DocLoc -> String -> m ()
- Language.Haskell.TH.Syntax: qPutQ :: (Quasi m, Typeable a) => a -> m ()
- Language.Haskell.TH.Syntax: qRecover :: Quasi m => m a -> m a -> m a
- Language.Haskell.TH.Syntax: qReify :: Quasi m => Name -> m Info
- Language.Haskell.TH.Syntax: qReifyAnnotations :: (Quasi m, Data a) => AnnLookup -> m [a]
- Language.Haskell.TH.Syntax: qReifyConStrictness :: Quasi m => Name -> m [DecidedStrictness]
- Language.Haskell.TH.Syntax: qReifyFixity :: Quasi m => Name -> m (Maybe Fixity)
- Language.Haskell.TH.Syntax: qReifyInstances :: Quasi m => Name -> [Type] -> m [Dec]
- Language.Haskell.TH.Syntax: qReifyModule :: Quasi m => Module -> m ModuleInfo
- Language.Haskell.TH.Syntax: qReifyRoles :: Quasi m => Name -> m [Role]
- Language.Haskell.TH.Syntax: qReifyType :: Quasi m => Name -> m Type
- Language.Haskell.TH.Syntax: qReport :: Quasi m => Bool -> String -> m ()
- Language.Haskell.TH.Syntax: qRunIO :: Quasi m => IO a -> m a
- Language.Haskell.TH.Syntax: recover :: Q a -> Q a -> Q a
- Language.Haskell.TH.Syntax: reify :: Name -> Q Info
- Language.Haskell.TH.Syntax: reifyAnnotations :: Data a => AnnLookup -> Q [a]
- Language.Haskell.TH.Syntax: reifyConStrictness :: Name -> Q [DecidedStrictness]
- Language.Haskell.TH.Syntax: reifyFixity :: Name -> Q (Maybe Fixity)
- Language.Haskell.TH.Syntax: reifyInstances :: Name -> [Type] -> Q [InstanceDec]
- Language.Haskell.TH.Syntax: reifyModule :: Module -> Q ModuleInfo
- Language.Haskell.TH.Syntax: reifyRoles :: Name -> Q [Role]
- Language.Haskell.TH.Syntax: reifyType :: Name -> Q Type
- Language.Haskell.TH.Syntax: report :: Bool -> String -> Q ()
- Language.Haskell.TH.Syntax: reportError :: String -> Q ()
- Language.Haskell.TH.Syntax: reportWarning :: String -> Q ()
- Language.Haskell.TH.Syntax: rightName :: Name
- Language.Haskell.TH.Syntax: runIO :: IO a -> Q a
- Language.Haskell.TH.Syntax: runQ :: Quasi m => Q a -> m a
- Language.Haskell.TH.Syntax: sequenceQ :: Monad m => forall a. () => [m a] -> m [a]
- Language.Haskell.TH.Syntax: showName :: Name -> String
- Language.Haskell.TH.Syntax: showName' :: NameIs -> Name -> String
- Language.Haskell.TH.Syntax: thenCmp :: Ordering -> Ordering -> Ordering
- Language.Haskell.TH.Syntax: trueName :: Name
- Language.Haskell.TH.Syntax: tupleDataName :: Int -> Name
- Language.Haskell.TH.Syntax: tupleTypeName :: Int -> Name
- Language.Haskell.TH.Syntax: type Arity = Int
- Language.Haskell.TH.Syntax: type BangType = (Bang, Type)
- Language.Haskell.TH.Syntax: type CharPos = (Int, Int)
- Language.Haskell.TH.Syntax: type Cxt = [Pred]
- Language.Haskell.TH.Syntax: type FieldExp = (Name, Exp)
- Language.Haskell.TH.Syntax: type FieldPat = (Name, Pat)
- Language.Haskell.TH.Syntax: type InstanceDec = Dec
- Language.Haskell.TH.Syntax: type Kind = Type
- Language.Haskell.TH.Syntax: type ParentName = Name
- Language.Haskell.TH.Syntax: type PatSynType = Type
- Language.Haskell.TH.Syntax: type Pred = Type
- Language.Haskell.TH.Syntax: type Strict = Bang
- Language.Haskell.TH.Syntax: type StrictType = BangType
- Language.Haskell.TH.Syntax: type SumAlt = Int
- Language.Haskell.TH.Syntax: type SumArity = Int
- Language.Haskell.TH.Syntax: type Uniq = Integer
- Language.Haskell.TH.Syntax: type Unlifted = Bool
- Language.Haskell.TH.Syntax: type VarBangType = (Name, Bang, Type)
- Language.Haskell.TH.Syntax: type VarStrictType = VarBangType
- Language.Haskell.TH.Syntax: unTypeCode :: forall a m. Quote m => Code m a -> m Exp
- Language.Haskell.TH.Syntax: unTypeQ :: forall a m. Quote m => m (TExp a) -> m Exp
- Language.Haskell.TH.Syntax: unboxedSumDataName :: SumAlt -> SumArity -> Name
- Language.Haskell.TH.Syntax: unboxedSumTypeName :: SumArity -> Name
- Language.Haskell.TH.Syntax: unboxedTupleDataName :: Int -> Name
- Language.Haskell.TH.Syntax: unboxedTupleTypeName :: Int -> Name
- Language.Haskell.TH.Syntax: unsafeCodeCoerce :: forall a m. Quote m => m Exp -> Code m a
- Language.Haskell.TH.Syntax: unsafeTExpCoerce :: forall a m. Quote m => m Exp -> m (TExp a)
+ GHC.Builtin.Names: enumIntToWord_RDR :: RdrName
+ GHC.Builtin.Names: gHC_INTERNAL_CONTROL_MONAD_ZIP :: Module
+ GHC.Builtin.Names: mkTrAppKey :: Unique
+ GHC.Builtin.Names: mkTrAppName :: Name
+ GHC.Builtin.Names: predError_RDR :: RdrName
+ GHC.Builtin.Names: seqHashKey :: Unique
+ GHC.Builtin.Names: seqHashName :: Name
+ GHC.Builtin.Names: succError_RDR :: RdrName
+ GHC.Builtin.Names: toEnumError_RDR :: RdrName
+ GHC.Builtin.PrimOps: ByteArrayIsWeaklyPinnedOp :: PrimOp
+ GHC.Builtin.PrimOps: DoubleMaxOp :: PrimOp
+ GHC.Builtin.PrimOps: DoubleMinOp :: PrimOp
+ GHC.Builtin.PrimOps: FloatMaxOp :: PrimOp
+ GHC.Builtin.PrimOps: FloatMinOp :: PrimOp
+ GHC.Builtin.PrimOps: MutableByteArrayIsWeaklyPinnedOp :: PrimOp
+ GHC.Builtin.PrimOps: VecFMAdd :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: VecFMSub :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: VecFNMAdd :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: VecFNMSub :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: VecMaxOp :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: VecMinOp :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: VecShuffleOp :: PrimOpVecCat -> Length -> Width -> PrimOp
+ GHC.Builtin.PrimOps: primOpDeprecations :: [(OccName, FastString)]
+ GHC.Builtin.Types: extractPromotedList :: Type -> [Type]
+ GHC.Builtin.Types.Literals: BuiltInSynFamily :: [BuiltInFamRewrite] -> [BuiltInFamInjectivity] -> BuiltInSynFamily
+ GHC.Builtin.Types.Literals: [sfInteract] :: BuiltInSynFamily -> [BuiltInFamInjectivity]
+ GHC.Builtin.Types.Literals: [sfMatchFam] :: BuiltInSynFamily -> [BuiltInFamRewrite]
+ GHC.Builtin.Types.Literals: data BuiltInSynFamily
+ GHC.Builtin.Types.Literals: tryInteractInertFam :: BuiltInSynFamily -> TyCon -> [Type] -> [Type] -> [(CoAxiomRule, TypeEqn)]
+ GHC.Builtin.Types.Literals: tryInteractTopFam :: BuiltInSynFamily -> TyCon -> [Type] -> Type -> [(CoAxiomRule, TypeEqn)]
+ GHC.Builtin.Types.Literals: tryMatchFam :: BuiltInSynFamily -> [Type] -> Maybe (CoAxiomRule, [Type], Type)
+ GHC.Builtin.Types.Literals: typeCharCmpTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeCharToNatTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeConsSymbolTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatAddTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatCmpTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatCoAxiomRules :: UniqFM FastString CoAxiomRule
+ GHC.Builtin.Types.Literals: typeNatDivTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatExpTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatLogTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatModTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatMulTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatSubTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatToCharTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeNatTyCons :: [TyCon]
+ GHC.Builtin.Types.Literals: typeSymbolAppendTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeSymbolCmpTyCon :: TyCon
+ GHC.Builtin.Types.Literals: typeUnconsSymbolTyCon :: TyCon
+ GHC.ByteCode.Types: [bc_spt_entries] :: CompiledByteCode -> ![SptEntry]
+ GHC.Cmm: DWrap :: [(BlockId, a)] -> DWrap a
+ GHC.Cmm: data GenCmmTopInfo (f :: Type -> Type)
+ GHC.Cmm: data GenGenCmmGraph (s :: Type -> Type) (n :: Extensibility -> Extensibility -> Type)
+ GHC.Cmm: newtype DWrap a
+ GHC.Cmm: removeDeterm :: DCmmGroup -> CmmGroup
+ GHC.Cmm: removeDetermDecl :: DCmmDecl -> CmmDecl
+ GHC.Cmm: removeDetermGraph :: DCmmGraph -> CmmGraph
+ GHC.Cmm: topInfoTableD :: forall a (s :: Type -> Type) (n :: Extensibility -> Extensibility -> Type). GenCmmDecl a DCmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
+ GHC.Cmm: type CmmTopInfo = GenCmmTopInfo LabelMap
+ GHC.Cmm: type DCmmDecl = GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph
+ GHC.Cmm: type DCmmGraph = GenGenCmmGraph DWrap CmmNode
+ GHC.Cmm: type DCmmGroup = GenCmmGroup CmmStatics DCmmTopInfo DCmmGraph
+ GHC.Cmm: type DCmmTopInfo = GenCmmTopInfo DWrap
+ GHC.Cmm: type GenCmmGraph (n :: Extensibility -> Extensibility -> Type) = GenGenCmmGraph LabelMap n
+ GHC.Cmm: unDeterm :: DWrap a -> [(BlockId, a)]
+ GHC.Cmm.CLabel: CStubLabel :: Bool -> Module -> FastString -> CStubLabel
+ GHC.Cmm.CLabel: [csl_is_initializer] :: CStubLabel -> Bool
+ GHC.Cmm.CLabel: [csl_module] :: CStubLabel -> Module
+ GHC.Cmm.CLabel: [csl_name] :: CStubLabel -> FastString
+ GHC.Cmm.CLabel: cStubLabel :: CLabel -> Maybe CStubLabel
+ GHC.Cmm.CLabel: data CStubLabel
+ GHC.Cmm.CLabel: fromCStubLabel :: CStubLabel -> CLabel
+ GHC.Cmm.CLabel: instance GHC.Utils.Outputable.Outputable GHC.Cmm.CLabel.CStubLabel
+ GHC.Cmm.CLabel: mapInternalNonDetUniques :: Applicative m => (Unique -> m Unique) -> CLabel -> m CLabel
+ GHC.Cmm.CLabel: toProcDelimiterLbl :: CLabel -> CLabel
+ GHC.Cmm.Expr: [globalRegUse_reg] :: GlobalRegUse -> !GlobalReg
+ GHC.Cmm.Expr: [globalRegUse_type] :: GlobalRegUse -> !CmmType
+ GHC.Cmm.MachOp: MO_FS_Truncate :: Width -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_FW_Bitcast :: Width -> MachOp
+ GHC.Cmm.MachOp: MO_F_Max :: Width -> MachOp
+ GHC.Cmm.MachOp: MO_F_Min :: Width -> MachOp
+ GHC.Cmm.MachOp: MO_SF_Round :: Width -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VF_Broadcast :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VF_Max :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VF_Min :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VF_Shuffle :: Length -> Width -> [Int] -> MachOp
+ GHC.Cmm.MachOp: MO_VS_Max :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VS_Min :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VU_Max :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_VU_Min :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_V_Broadcast :: Length -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_V_Shuffle :: Length -> Width -> [Int] -> MachOp
+ GHC.Cmm.MachOp: MO_WF_Bitcast :: Width -> MachOp
+ GHC.Cmm.MachOp: isCommutableCallishMachOp :: CallishMachOp -> Bool
+ GHC.Cmm.Node: instance GHC.Cmm.Expr.DefinerOfRegs GHC.Cmm.Reg.GlobalRegUse (GHC.Cmm.Node.CmmNode e x)
+ GHC.Cmm.Node: instance GHC.Cmm.Expr.UserOfRegs GHC.Cmm.Reg.GlobalRegUse (GHC.Cmm.Node.CmmNode e x)
+ GHC.Cmm.Reg: GP_ARG_REGS :: GlobalArgRegs
+ GHC.Cmm.Reg: SCALAR_ARG_REGS :: GlobalArgRegs
+ GHC.Cmm.Reg: V16_ARG_REGS :: GlobalArgRegs
+ GHC.Cmm.Reg: V32_ARG_REGS :: GlobalArgRegs
+ GHC.Cmm.Reg: V64_ARG_REGS :: GlobalArgRegs
+ GHC.Cmm.Reg: [globalRegUse_reg] :: GlobalRegUse -> !GlobalReg
+ GHC.Cmm.Reg: [globalRegUse_type] :: GlobalRegUse -> !CmmType
+ GHC.Cmm.Reg: data GlobalArgRegs
+ GHC.Cmm.Reg: instance GHC.Classes.Eq GHC.Cmm.Reg.GlobalArgRegs
+ GHC.Cmm.Reg: instance GHC.Classes.Ord GHC.Cmm.Reg.GlobalArgRegs
+ GHC.Cmm.Reg: instance GHC.Show.Show GHC.Cmm.Reg.GlobalArgRegs
+ GHC.Cmm.Switch: mapSwitchTargetsA :: Applicative m => (Label -> m Label) -> SwitchTargets -> m SwitchTargets
+ GHC.Cmm.Type: cmmCompatType :: CmmType -> CmmType -> Bool
+ GHC.Cmm.Utils: baseExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: blockTicks :: Block CmmNode C C -> [CmmTickish]
+ GHC.Cmm.Utils: cccsExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: cmmAddWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmAndWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmConstrTag1 :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmEqWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmIndex :: Platform -> Width -> CmmExpr -> Int -> CmmExpr
+ GHC.Cmm.Utils: cmmIndexExpr :: Platform -> Width -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmIsNotTagged :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmIsTagged :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmLabelOff :: CLabel -> Int -> CmmLit
+ GHC.Cmm.Utils: cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
+ GHC.Cmm.Utils: cmmLabelOffW :: Platform -> CLabel -> WordOff -> CmmLit
+ GHC.Cmm.Utils: cmmLoadBWord :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmLoadGCWord :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmLoadIndex :: Platform -> CmmType -> CmmExpr -> Int -> CmmExpr
+ GHC.Cmm.Utils: cmmLoadIndexW :: Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
+ GHC.Cmm.Utils: cmmMkAssign :: Platform -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr)
+ GHC.Cmm.Utils: cmmMulWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmNeWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmNegate :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmOffset :: Platform -> CmmExpr -> Int -> CmmExpr
+ GHC.Cmm.Utils: cmmOffsetB :: Platform -> CmmExpr -> ByteOff -> CmmExpr
+ GHC.Cmm.Utils: cmmOffsetExpr :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmOffsetExprB :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmOffsetExprW :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmOffsetLit :: CmmLit -> Int -> CmmLit
+ GHC.Cmm.Utils: cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
+ GHC.Cmm.Utils: cmmOffsetLitW :: Platform -> CmmLit -> WordOff -> CmmLit
+ GHC.Cmm.Utils: cmmOffsetW :: Platform -> CmmExpr -> WordOff -> CmmExpr
+ GHC.Cmm.Utils: cmmOrWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmPointerMask :: Platform -> CmmExpr
+ GHC.Cmm.Utils: cmmQuotWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmRegOff :: CmmReg -> Int -> CmmExpr
+ GHC.Cmm.Utils: cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
+ GHC.Cmm.Utils: cmmRegOffW :: Platform -> CmmReg -> WordOff -> CmmExpr
+ GHC.Cmm.Utils: cmmSLtWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmSubWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmTagMask :: Platform -> CmmExpr
+ GHC.Cmm.Utils: cmmToWord :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmUGeWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmUGtWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmULtWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmUShrWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: cmmUntag :: Platform -> CmmExpr -> CmmExpr
+ GHC.Cmm.Utils: currentNurseryExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: currentTSOExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: foldlGraphBlocks :: (a -> CmmBlock -> a) -> a -> CmmGraph -> a
+ GHC.Cmm.Utils: globalRegUsedIn :: Platform -> GlobalReg -> CmmExpr -> Bool
+ GHC.Cmm.Utils: globalRegsOverlap :: Platform -> GlobalReg -> GlobalReg -> Bool
+ GHC.Cmm.Utils: hpExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: hpLimExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: mAX_PTR_TAG :: Platform -> Int
+ GHC.Cmm.Utils: mapGraphNodes :: (CmmNode C O -> CmmNode C O, CmmNode O O -> CmmNode O O, CmmNode O C -> CmmNode O C) -> CmmGraph -> CmmGraph
+ GHC.Cmm.Utils: mapGraphNodes1 :: (forall (e :: Extensibility) (x :: Extensibility). () => CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph
+ GHC.Cmm.Utils: mkByteStringCLit :: forall (raw :: Bool) info stmt. CLabel -> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
+ GHC.Cmm.Utils: mkDataLits :: forall (raw :: Bool) info stmt. Section -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
+ GHC.Cmm.Utils: mkFileEmbedLit :: forall (raw :: Bool) info stmt. CLabel -> FilePath -> Int -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
+ GHC.Cmm.Utils: mkIntCLit :: Platform -> Int -> CmmLit
+ GHC.Cmm.Utils: mkIntExpr :: Platform -> Int -> CmmExpr
+ GHC.Cmm.Utils: mkLblExpr :: CLabel -> CmmExpr
+ GHC.Cmm.Utils: mkLiveness :: Platform -> [LocalReg] -> Liveness
+ GHC.Cmm.Utils: mkRODataLits :: forall (raw :: Bool) info stmt. CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
+ GHC.Cmm.Utils: mkStgWordCLit :: Platform -> StgWord -> CmmLit
+ GHC.Cmm.Utils: mkWordCLit :: Platform -> Integer -> CmmLit
+ GHC.Cmm.Utils: modifyGraph :: forall (n :: Extensibility -> Extensibility -> Type) (n' :: Extensibility -> Extensibility -> Type). (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
+ GHC.Cmm.Utils: ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
+ GHC.Cmm.Utils: ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
+ GHC.Cmm.Utils: packHalfWordsCLit :: Platform -> StgHalfWord -> StgHalfWord -> CmmLit
+ GHC.Cmm.Utils: primRepCmmType :: Platform -> PrimRep -> CmmType
+ GHC.Cmm.Utils: primRepForeignHint :: PrimRep -> ForeignHint
+ GHC.Cmm.Utils: regUsedIn :: Platform -> CmmReg -> CmmExpr -> Bool
+ GHC.Cmm.Utils: regsOverlap :: Platform -> CmmReg -> CmmReg -> Bool
+ GHC.Cmm.Utils: slotCmmType :: Platform -> SlotTy -> CmmType
+ GHC.Cmm.Utils: spExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: spLimExpr :: Platform -> CmmExpr
+ GHC.Cmm.Utils: tAG_MASK :: Platform -> Int
+ GHC.Cmm.Utils: toBlockList :: CmmGraph -> [CmmBlock]
+ GHC.Cmm.Utils: toBlockListEntryFirst :: CmmGraph -> [CmmBlock]
+ GHC.Cmm.Utils: toBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock]
+ GHC.Cmm.Utils: toBlockMap :: CmmGraph -> LabelMap CmmBlock
+ GHC.Cmm.Utils: typeCmmType :: Platform -> NvUnaryType -> CmmType
+ GHC.Cmm.Utils: typeForeignHint :: NvUnaryType -> ForeignHint
+ GHC.Cmm.Utils: zeroCLit :: Platform -> CmmLit
+ GHC.Cmm.Utils: zeroExpr :: Platform -> CmmExpr
+ GHC.CmmToLlvm.Version: LlvmVersion :: NonEmpty Int -> LlvmVersion
+ GHC.CmmToLlvm.Version: [llvmVersionNE] :: LlvmVersion -> NonEmpty Int
+ GHC.CmmToLlvm.Version: llvmVersionList :: LlvmVersion -> [Int]
+ GHC.CmmToLlvm.Version: llvmVersionStr :: LlvmVersion -> String
+ GHC.CmmToLlvm.Version: llvmVersionSupported :: LlvmVersion -> Bool
+ GHC.CmmToLlvm.Version: newtype LlvmVersion
+ GHC.CmmToLlvm.Version: parseLlvmVersion :: String -> Maybe LlvmVersion
+ GHC.CmmToLlvm.Version: supportedLlvmVersionLowerBound :: LlvmVersion
+ GHC.CmmToLlvm.Version: supportedLlvmVersionUpperBound :: LlvmVersion
+ GHC.CmmToLlvm.Version.Bounds: supportedLlvmVersionLowerBound :: LlvmVersion
+ GHC.CmmToLlvm.Version.Bounds: supportedLlvmVersionUpperBound :: LlvmVersion
+ GHC.Core: isBetterUnfoldingThan :: Unfolding -> Unfolding -> Bool
+ GHC.Core.Coercion: coVarTypesRole :: HasDebugCallStack => CoVar -> (Type, Type, Role)
+ GHC.Core.Coercion: liftingContextSubst :: LiftingContext -> Subst
+ GHC.Core.Coercion: mkAxiomCo :: CoAxiomRule -> [Coercion] -> Coercion
+ GHC.Core.Coercion: mkGReflMCo :: HasDebugCallStack => Role -> Type -> CoercionN -> Coercion
+ GHC.Core.Coercion: mkSelCoResRole :: CoSel -> Role -> Role
+ GHC.Core.Coercion: selectFromType :: HasDebugCallStack => CoSel -> Type -> Type
+ GHC.Core.Coercion.Axiom: BIF_Interact :: FastString -> CoAxiomRule -> (TypeEqn -> Maybe TypeEqn) -> BuiltInFamInjectivity
+ GHC.Core.Coercion.Axiom: BIF_Rewrite :: FastString -> CoAxiomRule -> TyCon -> Arity -> ([Type] -> Maybe ([Type], Type)) -> ([TypeEqn] -> Maybe TypeEqn) -> BuiltInFamRewrite
+ GHC.Core.Coercion.Axiom: BranchedAxiom :: CoAxiom Branched -> BranchIndex -> CoAxiomRule
+ GHC.Core.Coercion.Axiom: BuiltInFamInj :: BuiltInFamInjectivity -> CoAxiomRule
+ GHC.Core.Coercion.Axiom: BuiltInFamRew :: BuiltInFamRewrite -> CoAxiomRule
+ GHC.Core.Coercion.Axiom: UnbranchedAxiom :: CoAxiom Unbranched -> CoAxiomRule
+ GHC.Core.Coercion.Axiom: [bifinj_axr] :: BuiltInFamInjectivity -> CoAxiomRule
+ GHC.Core.Coercion.Axiom: [bifinj_name] :: BuiltInFamInjectivity -> FastString
+ GHC.Core.Coercion.Axiom: [bifinj_proves] :: BuiltInFamInjectivity -> TypeEqn -> Maybe TypeEqn
+ GHC.Core.Coercion.Axiom: [bifrw_arity] :: BuiltInFamRewrite -> Arity
+ GHC.Core.Coercion.Axiom: [bifrw_axr] :: BuiltInFamRewrite -> CoAxiomRule
+ GHC.Core.Coercion.Axiom: [bifrw_fam_tc] :: BuiltInFamRewrite -> TyCon
+ GHC.Core.Coercion.Axiom: [bifrw_match] :: BuiltInFamRewrite -> [Type] -> Maybe ([Type], Type)
+ GHC.Core.Coercion.Axiom: [bifrw_name] :: BuiltInFamRewrite -> FastString
+ GHC.Core.Coercion.Axiom: [bifrw_proves] :: BuiltInFamRewrite -> [TypeEqn] -> Maybe TypeEqn
+ GHC.Core.Coercion.Axiom: [sfInteract] :: BuiltInSynFamily -> [BuiltInFamInjectivity]
+ GHC.Core.Coercion.Axiom: coAxiomRuleArgRoles :: CoAxiomRule -> [Role]
+ GHC.Core.Coercion.Axiom: coAxiomRuleBranch_maybe :: CoAxiomRule -> Maybe (TyCon, Role, CoAxBranch)
+ GHC.Core.Coercion.Axiom: coAxiomRuleRole :: CoAxiomRule -> Role
+ GHC.Core.Coercion.Axiom: data BuiltInFamInjectivity
+ GHC.Core.Coercion.Axiom: data BuiltInFamRewrite
+ GHC.Core.Coercion.Axiom: isNewtypeAxiomRule_maybe :: CoAxiomRule -> Maybe (TyCon, CoAxBranch)
+ GHC.Core.DataCon: HsBang :: SrcUnpackedness -> SrcStrictness -> HsBang
+ GHC.Core.DataCon: data HsBang
+ GHC.Core.DataCon: instance GHC.Utils.Outputable.Outputable Language.Haskell.Syntax.Basic.HsBang
+ GHC.Core.DataCon: mkHsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
+ GHC.Core.FVs: orphNamesOfExprs :: [CoreExpr] -> NameSet
+ GHC.Core.InstEnv: EvCanonical :: CanonicalEvidence
+ GHC.Core.InstEnv: EvNonCanonical :: CanonicalEvidence
+ GHC.Core.InstEnv: data CanonicalEvidence
+ GHC.Core.InstEnv: getCoherentUnifiers :: PotentialUnifiers -> [ClsInst]
+ GHC.Core.InstEnv: instance GHC.Utils.Outputable.Outputable GHC.Core.InstEnv.CanonicalEvidence
+ GHC.Core.Multiplicity: IgnoreMultiplicities :: MultiplicityFlag
+ GHC.Core.Multiplicity: RespectMultiplicities :: MultiplicityFlag
+ GHC.Core.Multiplicity: data MultiplicityFlag
+ GHC.Core.Opt.Monad: [floatJoinsToTop] :: FloatOutSwitches -> Bool
+ GHC.Core.Opt.OccurAnal: DoBinderSwap :: OutVar -> MCoercion -> BinderSwapDecision
+ GHC.Core.Opt.OccurAnal: NoBinderSwap :: BinderSwapDecision
+ GHC.Core.Opt.OccurAnal: data BinderSwapDecision
+ GHC.Core.Opt.OccurAnal: scrutOkForBinderSwap :: OutExpr -> BinderSwapDecision
+ GHC.Core.Opt.Simplify.Env: [seInlineDepth] :: SimplEnv -> !Int
+ GHC.Core.Opt.Simplify.Env: extendCvIdSubst :: SimplEnv -> Id -> OutExpr -> SimplEnv
+ GHC.Core.Opt.Simplify.Env: reSimplifying :: SimplEnv -> Bool
+ GHC.Core.Opt.Simplify.Inline: activeUnfolding :: SimplMode -> Id -> Bool
+ GHC.Core.Opt.Simplify.Utils: [sc_co] :: SimplCont -> OutCoercion
+ GHC.Core.Opt.Simplify.Utils: [sc_opt] :: SimplCont -> Bool
+ GHC.Core.Predicate: isCoVarType :: Type -> Bool
+ GHC.Core.Predicate: isNomEqPred :: PredType -> Bool
+ GHC.Core.Predicate: isReprEqPrimPred :: PredType -> Bool
+ GHC.Core.TyCo.Compare: eqTypeIgnoringMultiplicity :: Type -> Type -> Bool
+ GHC.Core.TyCo.FVs: coVarsOfCoDSet :: Coercion -> DCoVarSet
+ GHC.Core.TyCo.FVs: coVarsOfCosDSet :: [Coercion] -> DCoVarSet
+ GHC.Core.TyCo.Rep: AxiomCo :: CoAxiomRule -> [Coercion] -> Coercion
+ GHC.Core.TyCo.Rep: [uco_deps] :: Coercion -> [Coercion]
+ GHC.Core.TyCo.Rep: [uco_lty] :: Coercion -> Type
+ GHC.Core.TyCo.Rep: [uco_prov] :: Coercion -> UnivCoProvenance
+ GHC.Core.TyCo.Rep: [uco_role] :: Coercion -> Role
+ GHC.Core.TyCo.Rep: [uco_rty] :: Coercion -> Type
+ GHC.Core.TyCo.Rep: instance Control.DeepSeq.NFData GHC.Core.TyCo.Rep.UnivCoProvenance
+ GHC.Core.TyCo.Rep: instance GHC.Classes.Eq GHC.Core.TyCo.Rep.UnivCoProvenance
+ GHC.Core.TyCo.Rep: instance GHC.Classes.Ord GHC.Core.TyCo.Rep.CoSel
+ GHC.Core.TyCo.Rep: instance GHC.Classes.Ord GHC.Core.TyCo.Rep.FunSel
+ GHC.Core.TyCo.Rep: instance GHC.Classes.Ord GHC.Core.TyCo.Rep.UnivCoProvenance
+ GHC.Core.TyCo.Rep: instance GHC.Utils.Binary.Binary GHC.Core.TyCo.Rep.UnivCoProvenance
+ GHC.Core.TyCo.Subst: substDCoVarSet :: Subst -> DCoVarSet -> DCoVarSet
+ GHC.Core.TyCo.Tidy: tidyAvoiding :: [OccName] -> (TidyEnv -> a -> TidyEnv) -> a -> TidyEnv
+ GHC.Core.TyCo.Tidy: tidyFreeTyCoVarX :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
+ GHC.Core.TyCo.Tidy: tidyFreeTyCoVarsX :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
+ GHC.Core.TyCo.Tidy: tidyOpenTypeX :: TidyEnv -> Type -> (TidyEnv, Type)
+ GHC.Core.TyCo.Tidy: tidyOpenTypesX :: TidyEnv -> [Type] -> (TidyEnv, [Type])
+ GHC.Core.TyCon: instance Data.Data.Data GHC.Core.TyCon.PrimOrVoidRep
+ GHC.Core.TyCon: instance GHC.Classes.Eq GHC.Core.TyCon.PrimOrVoidRep
+ GHC.Core.TyCon: instance GHC.Classes.Ord GHC.Core.TyCon.PrimOrVoidRep
+ GHC.Core.TyCon: instance GHC.Show.Show GHC.Core.TyCon.PrimOrVoidRep
+ GHC.Core.Type: expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type
+ GHC.Core.Type: tidyFreeTyCoVarX :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
+ GHC.Core.Type: tidyFreeTyCoVarsX :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
+ GHC.Core.Type: tidyOpenTypeX :: TidyEnv -> Type -> (TidyEnv, Type)
+ GHC.Core.Type: tidyOpenTypesX :: TidyEnv -> [Type] -> (TidyEnv, [Type])
+ GHC.Core.Unfold: uncondInlineJoin :: [Var] -> CoreExpr -> Bool
+ GHC.Core.Utils: mergeCaseAlts :: Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])
+ GHC.Data.FastString: [getLexicalFastString] :: LexicalFastString -> FastString
+ GHC.Data.FastString: instance Control.DeepSeq.NFData GHC.Data.FastString.LexicalFastString
+ GHC.Data.FlatBag: EmptyFlatBag :: FlatBag a
+ GHC.Data.FlatBag: TupleFlatBag :: !a -> !a -> FlatBag a
+ GHC.Data.FlatBag: UnitFlatBag :: !a -> FlatBag a
+ GHC.Data.OsPath: (<.>) :: OsPath -> OsString -> OsPath
+ GHC.Data.OsPath: (</>) :: OsPath -> OsPath -> OsPath
+ GHC.Data.OsPath: data OsString
+ GHC.Data.OsPath: decodeUtf :: MonadThrow m => OsPath -> m FilePath
+ GHC.Data.OsPath: encodeUtf :: MonadThrow m => FilePath -> m OsPath
+ GHC.Data.OsPath: os :: String -> OsString
+ GHC.Data.OsPath: type OsPath = OsString
+ GHC.Data.OsPath: unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
+ GHC.Data.OsPath: unsafeEncodeUtf :: HasCallStack => String -> OsString
+ GHC.Data.Pair: unzipPairs :: [Pair a] -> ([a], [a])
+ GHC.Data.Stream: hoistEff :: (Applicative m, Monad n) => (forall x. () => m x -> n x) -> Stream m a b -> Stream n a b
+ GHC.Data.Stream: liftEff :: Monad m => m b -> Stream m a b
+ GHC.Data.Strict: maybe :: b -> (a -> b) -> Maybe a -> b
+ GHC.Data.StringBuffer: findHashOffset :: StringBuffer -> Int
+ GHC.Driver.DynFlags: Opt_ExposeOverloadedUnfoldings :: GeneralFlag
+ GHC.Driver.DynFlags: Opt_ObjectDeterminism :: GeneralFlag
+ GHC.Driver.DynFlags: Opt_WarnViewPatternSignatures :: WarningFlag
+ GHC.Driver.DynFlags: ReexportedModule :: ModuleName -> ModuleName -> ReexportedModule
+ GHC.Driver.DynFlags: [ifCompression] :: DynFlags -> Int
+ GHC.Driver.DynFlags: [reexportFrom] :: ReexportedModule -> ModuleName
+ GHC.Driver.DynFlags: [reexportTo] :: ReexportedModule -> ModuleName
+ GHC.Driver.DynFlags: data ReexportedModule
+ GHC.Driver.DynFlags: instance GHC.Utils.Outputable.Outputable GHC.Driver.DynFlags.ReexportedModule
+ GHC.Driver.DynFlags: isSse4_1Enabled :: DynFlags -> Bool
+ GHC.Driver.Errors.Types: [DriverInstantiationNodeInDependencyGeneration] :: InstantiatedUnit -> DriverMessage
+ GHC.Driver.Errors.Types: [DriverModuleGraphCycle] :: [ModuleGraphNode] -> DriverMessage
+ GHC.Driver.Errors.Types: [DriverNoConfiguredLLVMToolchain] :: DriverMessage
+ GHC.Driver.Flags: Deprecated :: Deprecation
+ GHC.Driver.Flags: ExtensionDeprecatedFor :: [Extension] -> ExtensionDeprecation
+ GHC.Driver.Flags: ExtensionFlagDeprecated :: String -> ExtensionDeprecation
+ GHC.Driver.Flags: ExtensionFlagDeprecatedCond :: TurnOnFlag -> String -> ExtensionDeprecation
+ GHC.Driver.Flags: ExtensionNotDeprecated :: ExtensionDeprecation
+ GHC.Driver.Flags: NotDeprecated :: Deprecation
+ GHC.Driver.Flags: Opt_ExposeOverloadedUnfoldings :: GeneralFlag
+ GHC.Driver.Flags: Opt_ObjectDeterminism :: GeneralFlag
+ GHC.Driver.Flags: Opt_WarnViewPatternSignatures :: WarningFlag
+ GHC.Driver.Flags: data Deprecation
+ GHC.Driver.Flags: data ExtensionDeprecation
+ GHC.Driver.Flags: deprecation :: ExtensionDeprecation -> Deprecation
+ GHC.Driver.Flags: extensionDeprecation :: Extension -> ExtensionDeprecation
+ GHC.Driver.Flags: extensionName :: Extension -> String
+ GHC.Driver.Flags: extensionNames :: Extension -> [(ExtensionDeprecation, String)]
+ GHC.Driver.Flags: glasgowExtsFlags :: [Extension]
+ GHC.Driver.Flags: impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
+ GHC.Driver.Flags: impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
+ GHC.Driver.Flags: impliedXFlags :: [(Extension, TurnOnFlag, Extension)]
+ GHC.Driver.Flags: instance GHC.Classes.Eq GHC.Driver.Flags.Deprecation
+ GHC.Driver.Flags: instance GHC.Classes.Eq GHC.Driver.Flags.ExtensionDeprecation
+ GHC.Driver.Flags: instance GHC.Classes.Ord GHC.Driver.Flags.Deprecation
+ GHC.Driver.Flags: turnOff :: TurnOnFlag
+ GHC.Driver.Flags: turnOn :: TurnOnFlag
+ GHC.Driver.Flags: type TurnOnFlag = Bool
+ GHC.Driver.Flags: validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]
+ GHC.Driver.Plugins: [spInitialised] :: StaticPlugin -> Bool
+ GHC.Driver.Session: Opt_ExposeOverloadedUnfoldings :: GeneralFlag
+ GHC.Driver.Session: Opt_ObjectDeterminism :: GeneralFlag
+ GHC.Driver.Session: Opt_WarnViewPatternSignatures :: WarningFlag
+ GHC.Driver.Session: [ifCompression] :: DynFlags -> Int
+ GHC.Driver.Session: [platformMisc_targetRTSLinkerOnlySupportsSharedLibs] :: PlatformMisc -> Bool
+ GHC.Driver.Session: sTargetRTSLinkerOnlySupportsSharedLibs :: Settings -> Bool
+ GHC.ForeignSrcLang: instance Data.Binary.Class.Binary GHC.Internal.ForeignSrcLang.ForeignSrcLang
+ GHC.Hs: [am_mod] :: AnnsModule -> EpToken "module"
+ GHC.Hs: [am_sig] :: AnnsModule -> EpToken "signature"
+ GHC.Hs: [am_where] :: AnnsModule -> EpToken "where"
+ GHC.Hs.Basic: instance GHC.Utils.Binary.Binary Language.Haskell.Syntax.Basic.Fixity
+ GHC.Hs.Basic: instance GHC.Utils.Binary.Binary Language.Haskell.Syntax.Basic.FixityDirection
+ GHC.Hs.Basic: instance GHC.Utils.Outputable.Outputable Language.Haskell.Syntax.Basic.Fixity
+ GHC.Hs.Basic: instance GHC.Utils.Outputable.Outputable Language.Haskell.Syntax.Basic.FixityDirection
+ GHC.Hs.Basic: instance GHC.Utils.Outputable.Outputable Language.Haskell.Syntax.Basic.LexicalFixity
+ GHC.Hs.Binds: ActivationAnn :: EpToken "[" -> EpToken "]" -> Maybe (EpToken "~") -> Maybe EpaLocation -> ActivationAnn
+ GHC.Hs.Binds: AnnPSB :: EpToken "pattern" -> Maybe (EpToken "{") -> Maybe (EpToken "}") -> Maybe (EpUniToken "<-" "\8592") -> Maybe (EpToken "=") -> AnnPSB
+ GHC.Hs.Binds: AnnSpecSig :: EpaLocation -> EpToken "#-}" -> TokDcolon -> ActivationAnn -> AnnSpecSig
+ GHC.Hs.Binds: [aa_closec] :: ActivationAnn -> EpToken "]"
+ GHC.Hs.Binds: [aa_openc] :: ActivationAnn -> EpToken "["
+ GHC.Hs.Binds: [aa_tilde] :: ActivationAnn -> Maybe (EpToken "~")
+ GHC.Hs.Binds: [aa_val] :: ActivationAnn -> Maybe EpaLocation
+ GHC.Hs.Binds: [ap_closec] :: AnnPSB -> Maybe (EpToken "}")
+ GHC.Hs.Binds: [ap_equal] :: AnnPSB -> Maybe (EpToken "=")
+ GHC.Hs.Binds: [ap_larrow] :: AnnPSB -> Maybe (EpUniToken "<-" "\8592")
+ GHC.Hs.Binds: [ap_openc] :: AnnPSB -> Maybe (EpToken "{")
+ GHC.Hs.Binds: [ap_pattern] :: AnnPSB -> EpToken "pattern"
+ GHC.Hs.Binds: [asDefault] :: AnnSig -> Maybe (EpToken "default")
+ GHC.Hs.Binds: [asPattern] :: AnnSig -> Maybe (EpToken "pattern")
+ GHC.Hs.Binds: [ass_act] :: AnnSpecSig -> ActivationAnn
+ GHC.Hs.Binds: [ass_close] :: AnnSpecSig -> EpToken "#-}"
+ GHC.Hs.Binds: [ass_dcolon] :: AnnSpecSig -> TokDcolon
+ GHC.Hs.Binds: [ass_open] :: AnnSpecSig -> EpaLocation
+ GHC.Hs.Binds: data ActivationAnn
+ GHC.Hs.Binds: data AnnPSB
+ GHC.Hs.Binds: data AnnSpecSig
+ GHC.Hs.Binds: instance Data.Data.Data GHC.Hs.Binds.ActivationAnn
+ GHC.Hs.Binds: instance Data.Data.Data GHC.Hs.Binds.AnnPSB
+ GHC.Hs.Binds: instance Data.Data.Data GHC.Hs.Binds.AnnSpecSig
+ GHC.Hs.Binds: instance GHC.Classes.Eq GHC.Hs.Binds.ActivationAnn
+ GHC.Hs.Binds: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Binds.ActivationAnn
+ GHC.Hs.Binds: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Binds.AnnPSB
+ GHC.Hs.Binds: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Binds.AnnSpecSig
+ GHC.Hs.Binds: instance GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Extension.XRec pass (Language.Haskell.Syntax.Extension.IdP pass)) => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Binds.RecordPatSynField pass)
+ GHC.Hs.Decls: ActivationAnn :: EpToken "[" -> EpToken "]" -> Maybe (EpToken "~") -> Maybe EpaLocation -> ActivationAnn
+ GHC.Hs.Decls: AnnClassDecl :: EpToken "class" -> [EpToken "("] -> [EpToken ")"] -> EpToken "|" -> EpToken "where" -> EpToken "{" -> EpToken "}" -> [EpToken ";"] -> AnnClassDecl
+ GHC.Hs.Decls: AnnClsInstDecl :: EpToken "instance" -> EpToken "where" -> EpToken "{" -> [EpToken ";"] -> EpToken "}" -> AnnClsInstDecl
+ GHC.Hs.Decls: AnnConDeclGADT :: [EpToken "("] -> [EpToken ")"] -> TokDcolon -> AnnConDeclGADT
+ GHC.Hs.Decls: AnnConDeclH98 :: TokForall -> EpToken "." -> TokDarrow -> AnnConDeclH98
+ GHC.Hs.Decls: AnnDataDefn :: [EpToken "("] -> [EpToken ")"] -> EpToken "type" -> EpToken "newtype" -> EpToken "data" -> EpToken "instance" -> TokDcolon -> EpToken "where" -> EpToken "{" -> EpToken "}" -> EpToken "=" -> AnnDataDefn
+ GHC.Hs.Decls: AnnFamilyDecl :: [EpToken "("] -> [EpToken ")"] -> EpToken "type" -> EpToken "data" -> EpToken "family" -> TokDcolon -> EpToken "=" -> EpToken "|" -> EpToken "where" -> EpToken "{" -> EpToken ".." -> EpToken "}" -> AnnFamilyDecl
+ GHC.Hs.Decls: AnnSynDecl :: [EpToken "("] -> [EpToken ")"] -> EpToken "type" -> EpToken "=" -> AnnSynDecl
+ GHC.Hs.Decls: [aa_closec] :: ActivationAnn -> EpToken "]"
+ GHC.Hs.Decls: [aa_openc] :: ActivationAnn -> EpToken "["
+ GHC.Hs.Decls: [aa_tilde] :: ActivationAnn -> Maybe (EpToken "~")
+ GHC.Hs.Decls: [aa_val] :: ActivationAnn -> Maybe EpaLocation
+ GHC.Hs.Decls: [acd_class] :: AnnClassDecl -> EpToken "class"
+ GHC.Hs.Decls: [acd_closec] :: AnnClassDecl -> EpToken "}"
+ GHC.Hs.Decls: [acd_closep] :: AnnClassDecl -> [EpToken ")"]
+ GHC.Hs.Decls: [acd_openc] :: AnnClassDecl -> EpToken "{"
+ GHC.Hs.Decls: [acd_openp] :: AnnClassDecl -> [EpToken "("]
+ GHC.Hs.Decls: [acd_semis] :: AnnClassDecl -> [EpToken ";"]
+ GHC.Hs.Decls: [acd_vbar] :: AnnClassDecl -> EpToken "|"
+ GHC.Hs.Decls: [acd_where] :: AnnClassDecl -> EpToken "where"
+ GHC.Hs.Decls: [acdg_closep] :: AnnConDeclGADT -> [EpToken ")"]
+ GHC.Hs.Decls: [acdg_dcolon] :: AnnConDeclGADT -> TokDcolon
+ GHC.Hs.Decls: [acdg_openp] :: AnnConDeclGADT -> [EpToken "("]
+ GHC.Hs.Decls: [acdh_darrow] :: AnnConDeclH98 -> TokDarrow
+ GHC.Hs.Decls: [acdh_dot] :: AnnConDeclH98 -> EpToken "."
+ GHC.Hs.Decls: [acdh_forall] :: AnnConDeclH98 -> TokForall
+ GHC.Hs.Decls: [acid_closec] :: AnnClsInstDecl -> EpToken "}"
+ GHC.Hs.Decls: [acid_instance] :: AnnClsInstDecl -> EpToken "instance"
+ GHC.Hs.Decls: [acid_openc] :: AnnClsInstDecl -> EpToken "{"
+ GHC.Hs.Decls: [acid_semis] :: AnnClsInstDecl -> [EpToken ";"]
+ GHC.Hs.Decls: [acid_where] :: AnnClsInstDecl -> EpToken "where"
+ GHC.Hs.Decls: [afd_closec] :: AnnFamilyDecl -> EpToken "}"
+ GHC.Hs.Decls: [afd_closep] :: AnnFamilyDecl -> [EpToken ")"]
+ GHC.Hs.Decls: [afd_data] :: AnnFamilyDecl -> EpToken "data"
+ GHC.Hs.Decls: [afd_dcolon] :: AnnFamilyDecl -> TokDcolon
+ GHC.Hs.Decls: [afd_dotdot] :: AnnFamilyDecl -> EpToken ".."
+ GHC.Hs.Decls: [afd_equal] :: AnnFamilyDecl -> EpToken "="
+ GHC.Hs.Decls: [afd_family] :: AnnFamilyDecl -> EpToken "family"
+ GHC.Hs.Decls: [afd_openc] :: AnnFamilyDecl -> EpToken "{"
+ GHC.Hs.Decls: [afd_openp] :: AnnFamilyDecl -> [EpToken "("]
+ GHC.Hs.Decls: [afd_type] :: AnnFamilyDecl -> EpToken "type"
+ GHC.Hs.Decls: [afd_vbar] :: AnnFamilyDecl -> EpToken "|"
+ GHC.Hs.Decls: [afd_where] :: AnnFamilyDecl -> EpToken "where"
+ GHC.Hs.Decls: [andd_closec] :: AnnDataDefn -> EpToken "}"
+ GHC.Hs.Decls: [andd_closep] :: AnnDataDefn -> [EpToken ")"]
+ GHC.Hs.Decls: [andd_data] :: AnnDataDefn -> EpToken "data"
+ GHC.Hs.Decls: [andd_dcolon] :: AnnDataDefn -> TokDcolon
+ GHC.Hs.Decls: [andd_equal] :: AnnDataDefn -> EpToken "="
+ GHC.Hs.Decls: [andd_instance] :: AnnDataDefn -> EpToken "instance"
+ GHC.Hs.Decls: [andd_newtype] :: AnnDataDefn -> EpToken "newtype"
+ GHC.Hs.Decls: [andd_openc] :: AnnDataDefn -> EpToken "{"
+ GHC.Hs.Decls: [andd_openp] :: AnnDataDefn -> [EpToken "("]
+ GHC.Hs.Decls: [andd_type] :: AnnDataDefn -> EpToken "type"
+ GHC.Hs.Decls: [andd_where] :: AnnDataDefn -> EpToken "where"
+ GHC.Hs.Decls: [asd_closes] :: AnnSynDecl -> [EpToken ")"]
+ GHC.Hs.Decls: [asd_equal] :: AnnSynDecl -> EpToken "="
+ GHC.Hs.Decls: [asd_opens] :: AnnSynDecl -> [EpToken "("]
+ GHC.Hs.Decls: [asd_type] :: AnnSynDecl -> EpToken "type"
+ GHC.Hs.Decls: [defd_class] :: DefaultDecl pass -> Maybe (LIdP pass)
+ GHC.Hs.Decls: [defd_defaults] :: DefaultDecl pass -> [LHsType pass]
+ GHC.Hs.Decls: [defd_ext] :: DefaultDecl pass -> XCDefaultDecl pass
+ GHC.Hs.Decls: [ra_equal] :: HsRuleAnn -> EpToken "="
+ GHC.Hs.Decls: data ActivationAnn
+ GHC.Hs.Decls: data AnnClassDecl
+ GHC.Hs.Decls: data AnnClsInstDecl
+ GHC.Hs.Decls: data AnnConDeclGADT
+ GHC.Hs.Decls: data AnnConDeclH98
+ GHC.Hs.Decls: data AnnDataDefn
+ GHC.Hs.Decls: data AnnFamilyDecl
+ GHC.Hs.Decls: data AnnSynDecl
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnClassDecl
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnClsInstDecl
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnConDeclGADT
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnConDeclH98
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnDataDefn
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnFamilyDecl
+ GHC.Hs.Decls: instance Data.Data.Data GHC.Hs.Decls.AnnSynDecl
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnClassDecl
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnClsInstDecl
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnConDeclGADT
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnConDeclH98
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnDataDefn
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnFamilyDecl
+ GHC.Hs.Decls: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Decls.AnnSynDecl
+ GHC.Hs.Decls: type AnnDerivDecl = (EpToken "deriving", EpToken "instance")
+ GHC.Hs.Expr: AnnArithSeq :: EpToken "[" -> Maybe (EpToken ",") -> EpToken ".." -> EpToken "]" -> AnnArithSeq
+ GHC.Hs.Expr: AnnFunRhs :: EpToken "!" -> [EpToken "("] -> [EpToken ")"] -> AnnFunRhs
+ GHC.Hs.Expr: AnnTransStmt :: EpToken "then" -> Maybe (EpToken "group") -> Maybe (EpToken "by") -> Maybe (EpToken "using") -> AnnTransStmt
+ GHC.Hs.Expr: ApplicativeArgMany :: XApplicativeArgMany idL -> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> HsDoFlavour -> ApplicativeArg idL
+ GHC.Hs.Expr: ApplicativeArgOne :: XApplicativeArgOne idL -> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
+ GHC.Hs.Expr: ApplicativeStmt :: XApplicativeStmt idL idR -> [(SyntaxExpr idR, ApplicativeArg idL)] -> Maybe (SyntaxExpr idR) -> ApplicativeStmt idL idR
+ GHC.Hs.Expr: BracketHasE :: hasE -> BracketAnn noE hasE
+ GHC.Hs.Expr: BracketNoE :: noE -> BracketAnn noE hasE
+ GHC.Hs.Expr: EpAnnLam :: EpToken "\\" -> Maybe EpaLocation -> EpAnnLam
+ GHC.Hs.Expr: HsRecSelRn :: FieldOcc GhcRn -> XXExprGhcRn
+ GHC.Hs.Expr: HsRecSelTc :: FieldOcc GhcTc -> XXExprGhcTc
+ GHC.Hs.Expr: XApplicativeArg :: !XXApplicativeArg idL -> ApplicativeArg idL
+ GHC.Hs.Expr: [aas_close] :: AnnArithSeq -> EpToken "]"
+ GHC.Hs.Expr: [aas_comma] :: AnnArithSeq -> Maybe (EpToken ",")
+ GHC.Hs.Expr: [aas_dotdot] :: AnnArithSeq -> EpToken ".."
+ GHC.Hs.Expr: [aas_open] :: AnnArithSeq -> EpToken "["
+ GHC.Hs.Expr: [afr_closes] :: AnnFunRhs -> [EpToken ")"]
+ GHC.Hs.Expr: [afr_opens] :: AnnFunRhs -> [EpToken "("]
+ GHC.Hs.Expr: [afr_strict] :: AnnFunRhs -> EpToken "!"
+ GHC.Hs.Expr: [app_arg_pattern] :: ApplicativeArg idL -> LPat idL
+ GHC.Hs.Expr: [app_stmts] :: ApplicativeArg idL -> [ExprLStmt idL]
+ GHC.Hs.Expr: [arg_expr] :: ApplicativeArg idL -> LHsExpr idL
+ GHC.Hs.Expr: [ats_by] :: AnnTransStmt -> Maybe (EpToken "by")
+ GHC.Hs.Expr: [ats_group] :: AnnTransStmt -> Maybe (EpToken "group")
+ GHC.Hs.Expr: [ats_then] :: AnnTransStmt -> EpToken "then"
+ GHC.Hs.Expr: [ats_using] :: AnnTransStmt -> Maybe (EpToken "using")
+ GHC.Hs.Expr: [bv_pattern] :: ApplicativeArg idL -> LPat idL
+ GHC.Hs.Expr: [epl_case] :: EpAnnLam -> Maybe EpaLocation
+ GHC.Hs.Expr: [epl_lambda] :: EpAnnLam -> EpToken "\\"
+ GHC.Hs.Expr: [final_expr] :: ApplicativeArg idL -> HsExpr idL
+ GHC.Hs.Expr: [is_body_stmt] :: ApplicativeArg idL -> Bool
+ GHC.Hs.Expr: [stmt_context] :: ApplicativeArg idL -> HsDoFlavour
+ GHC.Hs.Expr: [xarg_app_arg_many] :: ApplicativeArg idL -> XApplicativeArgMany idL
+ GHC.Hs.Expr: [xarg_app_arg_one] :: ApplicativeArg idL -> XApplicativeArgOne idL
+ GHC.Hs.Expr: arrowToHsExpr :: HsArrowOf (LocatedA (HsExpr GhcRn)) GhcRn -> LocatedA (HsExpr GhcRn)
+ GHC.Hs.Expr: data AnnArithSeq
+ GHC.Hs.Expr: data AnnFunRhs
+ GHC.Hs.Expr: data AnnTransStmt
+ GHC.Hs.Expr: data ApplicativeArg idL
+ GHC.Hs.Expr: data ApplicativeStmt idL idR
+ GHC.Hs.Expr: data BracketAnn noE hasE
+ GHC.Hs.Expr: data EpAnnLam
+ GHC.Hs.Expr: instance (Data.Data.Data noE, Data.Data.Data hasE) => Data.Data.Data (GHC.Hs.Expr.BracketAnn noE hasE)
+ GHC.Hs.Expr: instance (GHC.Parser.Annotation.NoAnn n, GHC.Parser.Annotation.NoAnn h) => GHC.Parser.Annotation.NoAnn (GHC.Hs.Expr.BracketAnn n h)
+ GHC.Hs.Expr: instance Data.Data.Data GHC.Hs.Expr.AnnArithSeq
+ GHC.Hs.Expr: instance Data.Data.Data GHC.Hs.Expr.AnnFunRhs
+ GHC.Hs.Expr: instance Data.Data.Data GHC.Hs.Expr.AnnTransStmt
+ GHC.Hs.Expr: instance Data.Data.Data GHC.Hs.Expr.EpAnnLam
+ GHC.Hs.Expr: instance GHC.Hs.Extension.OutputableBndrId idL => GHC.Utils.Outputable.Outputable (GHC.Hs.Expr.ApplicativeArg (GHC.Hs.Extension.GhcPass idL))
+ GHC.Hs.Expr: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Expr.AnnArithSeq
+ GHC.Hs.Expr: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Expr.AnnFunRhs
+ GHC.Hs.Expr: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Expr.AnnTransStmt
+ GHC.Hs.Expr: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Expr.EpAnnLam
+ GHC.Hs.ImpExp: type IEThingWithAnns = (EpToken "(", EpToken "..", EpToken ",", EpToken ")")
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeArg GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeArg GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeArg GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcPs GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcPs GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcPs GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcRn GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcRn GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcRn GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcTc GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcTc GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (GHC.Hs.Expr.ApplicativeStmt GHC.Hs.Extension.GhcTc GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrowOf (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Expr.HsExpr GHC.Hs.Extension.GhcPs)) GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrowOf (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Expr.HsExpr GHC.Hs.Extension.GhcRn)) GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrowOf (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Expr.HsExpr GHC.Hs.Extension.GhcTc)) GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrowOf (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Type.HsType GHC.Hs.Extension.GhcPs)) GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrowOf (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Type.HsType GHC.Hs.Extension.GhcRn)) GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsArrowOf (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Type.HsType GHC.Hs.Extension.GhcTc)) GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsBndrKind GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsBndrKind GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsBndrKind GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsBndrVar GHC.Hs.Extension.GhcPs)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsBndrVar GHC.Hs.Extension.GhcRn)
+ GHC.Hs.Instances: instance Data.Data.Data (Language.Haskell.Syntax.Type.HsBndrVar GHC.Hs.Extension.GhcTc)
+ GHC.Hs.Lit: instance GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XXOverLit p) => GHC.Classes.Eq (Language.Haskell.Syntax.Lit.HsOverLit p)
+ GHC.Hs.Lit: instance GHC.Classes.Ord (Language.Haskell.Syntax.Extension.XXOverLit p) => GHC.Classes.Ord (Language.Haskell.Syntax.Lit.HsOverLit p)
+ GHC.Hs.Lit: negateOverLitVal :: OverLitVal -> OverLitVal
+ GHC.Hs.Pat: OrPat :: XOrPat p -> NonEmpty (LPat p) -> Pat p
+ GHC.Hs.Pat: [rec_ext] :: HsRecFields p arg -> !XHsRecFields p
+ GHC.Hs.Pat: isIrrefutableHsPat :: forall (p :: Pass). IsPass p => Bool -> (ConLikeP (GhcPass p) -> Bool) -> LPat (GhcPass p) -> Bool
+ GHC.Hs.Specificity: instance Control.DeepSeq.NFData Language.Haskell.Syntax.Specificity.ForAllTyFlag
+ GHC.Hs.Specificity: instance Control.DeepSeq.NFData Language.Haskell.Syntax.Specificity.Specificity
+ GHC.Hs.Specificity: instance GHC.Utils.Binary.Binary Language.Haskell.Syntax.Specificity.ForAllTyFlag
+ GHC.Hs.Specificity: instance GHC.Utils.Binary.Binary Language.Haskell.Syntax.Specificity.Specificity
+ GHC.Hs.Specificity: instance GHC.Utils.Outputable.Outputable Language.Haskell.Syntax.Specificity.ForAllTyFlag
+ GHC.Hs.Type: AnnTyVarBndr :: [EpaLocation] -> [EpaLocation] -> EpToken "'" -> TokDcolon -> AnnTyVarBndr
+ GHC.Hs.Type: HsBndrKind :: !XBndrKind pass -> LHsKind pass -> HsBndrKind pass
+ GHC.Hs.Type: HsBndrNoKind :: !XBndrNoKind pass -> HsBndrKind pass
+ GHC.Hs.Type: HsBndrVar :: !XBndrVar pass -> !LIdP pass -> HsBndrVar pass
+ GHC.Hs.Type: HsBndrWildCard :: !XBndrWildCard pass -> HsBndrVar pass
+ GHC.Hs.Type: HsTvb :: XTyVarBndr pass -> flag -> HsBndrVar pass -> HsBndrKind pass -> HsTyVarBndr flag pass
+ GHC.Hs.Type: XBndrKind :: !XXBndrKind pass -> HsBndrKind pass
+ GHC.Hs.Type: XBndrVar :: !XXBndrVar pass -> HsBndrVar pass
+ GHC.Hs.Type: XBndrVis :: !XXBndrVis pass -> HsBndrVis pass
+ GHC.Hs.Type: [atv_closes] :: AnnTyVarBndr -> [EpaLocation]
+ GHC.Hs.Type: [atv_dcolon] :: AnnTyVarBndr -> TokDcolon
+ GHC.Hs.Type: [atv_opens] :: AnnTyVarBndr -> [EpaLocation]
+ GHC.Hs.Type: [atv_tv] :: AnnTyVarBndr -> EpToken "'"
+ GHC.Hs.Type: [tvb_ext] :: HsTyVarBndr flag pass -> XTyVarBndr pass
+ GHC.Hs.Type: [tvb_flag] :: HsTyVarBndr flag pass -> flag
+ GHC.Hs.Type: [tvb_kind] :: HsTyVarBndr flag pass -> HsBndrKind pass
+ GHC.Hs.Type: [tvb_var] :: HsTyVarBndr flag pass -> HsBndrVar pass
+ GHC.Hs.Type: data AnnTyVarBndr
+ GHC.Hs.Type: data HsArrowOf mult pass
+ GHC.Hs.Type: data HsBndrKind pass
+ GHC.Hs.Type: data HsBndrVar pass
+ GHC.Hs.Type: expandHsArrow :: (LocatedN Name -> t GhcRn) -> HsArrowOf (LocatedA (t GhcRn)) GhcRn -> LocatedA (t GhcRn)
+ GHC.Hs.Type: fieldOccLRdrName :: forall (p :: Pass). IsPass p => FieldOcc (GhcPass p) -> LocatedN RdrName
+ GHC.Hs.Type: fieldOccRdrName :: forall (p :: Pass). IsPass p => FieldOcc (GhcPass p) -> RdrName
+ GHC.Hs.Type: hsBndrKind :: forall flag (pass :: Pass). HsTyVarBndr flag (GhcPass pass) -> HsBndrKind (GhcPass pass)
+ GHC.Hs.Type: hsBndrVar :: forall flag (pass :: Pass). HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
+ GHC.Hs.Type: hsTyVarLName :: forall flag (p :: Pass). HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
+ GHC.Hs.Type: instance (GHC.Utils.Outputable.Outputable mult, GHC.Hs.Extension.OutputableBndrId pass) => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Type.HsArrowOf mult (GHC.Hs.Extension.GhcPass pass))
+ GHC.Hs.Type: instance Data.Data.Data GHC.Hs.Type.AnnTyVarBndr
+ GHC.Hs.Type: instance GHC.Hs.Extension.OutputableBndrId p => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Type.HsBndrVar (GHC.Hs.Extension.GhcPass p))
+ GHC.Hs.Type: instance GHC.Hs.Extension.OutputableBndrId pass => GHC.Utils.Outputable.OutputableBndr (GHC.Types.SrcLoc.GenLocated GHC.Types.SrcLoc.SrcSpan (Language.Haskell.Syntax.Type.FieldOcc (GHC.Hs.Extension.GhcPass pass)))
+ GHC.Hs.Type: instance GHC.Hs.Extension.OutputableBndrId pass => GHC.Utils.Outputable.OutputableBndr (Language.Haskell.Syntax.Type.FieldOcc (GHC.Hs.Extension.GhcPass pass))
+ GHC.Hs.Type: instance GHC.Hs.Type.OutputableBndrFlag Language.Haskell.Syntax.Specificity.Specificity p
+ GHC.Hs.Type: instance GHC.Parser.Annotation.NoAnn GHC.Hs.Type.AnnTyVarBndr
+ GHC.Hs.Type: instance GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Extension.XRec pass (Language.Haskell.Syntax.Extension.IdP pass)) => GHC.Utils.Outputable.Outputable (Language.Haskell.Syntax.Type.FieldOcc pass)
+ GHC.Hs.Type: type EpAnnForallInvis = EpAnn (TokForall, EpToken ".")
+ GHC.Hs.Type: type EpAnnForallVis = EpAnn (TokForall, TokRarrow)
+ GHC.Hs.Type: type HsArrow pass = HsArrowOf LHsType pass pass
+ GHC.Hs.Utils: nlAscribe :: RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
+ GHC.HsToCore.Pmc.Solver.Types: type CompleteMatch = CompleteMatchX Name
+ GHC.HsToCore.Pmc.Types: GdAlt :: !GrdDag -> !GrdDag -> GrdDag
+ GHC.HsToCore.Pmc.Types: GdEnd :: GrdDag
+ GHC.HsToCore.Pmc.Types: GdOne :: !PmGrd -> GrdDag
+ GHC.HsToCore.Pmc.Types: GdSeq :: !GrdDag -> !GrdDag -> GrdDag
+ GHC.HsToCore.Pmc.Types: alternativesGrdDags :: NonEmpty GrdDag -> GrdDag
+ GHC.HsToCore.Pmc.Types: consGrdDag :: PmGrd -> GrdDag -> GrdDag
+ GHC.HsToCore.Pmc.Types: data GrdDag
+ GHC.HsToCore.Pmc.Types: gdSeq :: GrdDag -> GrdDag -> GrdDag
+ GHC.HsToCore.Pmc.Types: instance GHC.Utils.Outputable.Outputable GHC.HsToCore.Pmc.Types.GrdDag
+ GHC.HsToCore.Pmc.Types: sequenceGrdDags :: [GrdDag] -> GrdDag
+ GHC.HsToCore.Pmc.Types: sequencePmGrds :: [PmGrd] -> GrdDag
+ GHC.Iface.Syntax: IfaceDefaultAlt :: IfaceConAlt
+ GHC.Iface.Syntax: IfaceImport :: ImpDeclSpec -> ImpIfaceList -> IfaceImport
+ GHC.Iface.Syntax: ImpIfaceAll :: ImpIfaceList
+ GHC.Iface.Syntax: ImpIfaceEverythingBut :: !NameSet -> ImpIfaceList
+ GHC.Iface.Syntax: ImpIfaceExplicit :: !IfGlobalRdrEnv -> ImpIfaceList
+ GHC.Iface.Syntax: [ifDefaultCls] :: IfaceDefault -> IfaceTyCon
+ GHC.Iface.Syntax: [ifDefaultTys] :: IfaceDefault -> [IfaceType]
+ GHC.Iface.Syntax: [ifDefaultWarn] :: IfaceDefault -> Maybe IfaceWarningTxt
+ GHC.Iface.Syntax: data IfaceDefault
+ GHC.Iface.Syntax: data IfaceImport
+ GHC.Iface.Syntax: data ImpIfaceList
+ GHC.Iface.Syntax: instance Control.DeepSeq.NFData GHC.Iface.Syntax.IfaceDefault
+ GHC.Iface.Syntax: instance Control.DeepSeq.NFData GHC.Iface.Syntax.IfaceImport
+ GHC.Iface.Syntax: instance Control.DeepSeq.NFData GHC.Iface.Syntax.ImpIfaceList
+ GHC.Iface.Syntax: instance GHC.Utils.Binary.Binary GHC.Iface.Syntax.IfaceDefault
+ GHC.Iface.Syntax: instance GHC.Utils.Outputable.Outputable GHC.Iface.Syntax.IfaceDefault
+ GHC.Iface.Type: IfLclName :: LexicalFastString -> IfLclName
+ GHC.Iface.Type: IfaceAR_B :: IfExtName -> BranchIndex -> IfaceAxiomRule
+ GHC.Iface.Type: IfaceAR_U :: IfExtName -> IfaceAxiomRule
+ GHC.Iface.Type: IfaceAR_X :: IfLclName -> IfaceAxiomRule
+ GHC.Iface.Type: IfaceAxiomCo :: IfaceAxiomRule -> [IfaceCoercion] -> IfaceCoercion
+ GHC.Iface.Type: [getIfLclName] :: IfLclName -> LexicalFastString
+ GHC.Iface.Type: data IfaceAxiomRule
+ GHC.Iface.Type: getIfaceType :: HasCallStack => ReadBinHandle -> IO IfaceType
+ GHC.Iface.Type: ifLclNameFS :: IfLclName -> FastString
+ GHC.Iface.Type: ifaceTypeSharedByte :: Word8
+ GHC.Iface.Type: instance Control.DeepSeq.NFData GHC.Iface.Type.IfLclName
+ GHC.Iface.Type: instance Control.DeepSeq.NFData GHC.Iface.Type.IfaceAxiomRule
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfLclName
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfaceAppArgs
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfaceAxiomRule
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfaceBndr
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfaceCoercion
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfaceMCoercion
+ GHC.Iface.Type: instance GHC.Classes.Eq GHC.Iface.Type.IfaceType
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfLclName
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceAppArgs
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceAxiomRule
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceBndr
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceCoercion
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceMCoercion
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceTyCon
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceTyConInfo
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceTyConSort
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceTyLit
+ GHC.Iface.Type: instance GHC.Classes.Ord GHC.Iface.Type.IfaceType
+ GHC.Iface.Type: instance GHC.Show.Show GHC.Iface.Type.IfLclName
+ GHC.Iface.Type: instance GHC.Utils.Binary.Binary GHC.Iface.Type.IfLclName
+ GHC.Iface.Type: instance GHC.Utils.Binary.Binary GHC.Iface.Type.IfaceAxiomRule
+ GHC.Iface.Type: instance GHC.Utils.Outputable.Outputable GHC.Iface.Type.IfLclName
+ GHC.Iface.Type: mkIfLclName :: FastString -> IfLclName
+ GHC.Iface.Type: newtype IfLclName
+ GHC.Iface.Type: putIfaceType :: WriteBinHandle -> IfaceType -> IO ()
+ GHC.Internal.ForeignSrcLang: LangAsm :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: LangC :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: LangCxx :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: LangJs :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: LangObjc :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: LangObjcxx :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: RawObject :: ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: data ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: instance GHC.Classes.Eq GHC.Internal.ForeignSrcLang.ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: instance GHC.Generics.Generic GHC.Internal.ForeignSrcLang.ForeignSrcLang
+ GHC.Internal.ForeignSrcLang: instance GHC.Show.Show GHC.Internal.ForeignSrcLang.ForeignSrcLang
+ GHC.Internal.LanguageExtensions: AllowAmbiguousTypes :: Extension
+ GHC.Internal.LanguageExtensions: AlternativeLayoutRule :: Extension
+ GHC.Internal.LanguageExtensions: AlternativeLayoutRuleTransitional :: Extension
+ GHC.Internal.LanguageExtensions: ApplicativeDo :: Extension
+ GHC.Internal.LanguageExtensions: Arrows :: Extension
+ GHC.Internal.LanguageExtensions: AutoDeriveTypeable :: Extension
+ GHC.Internal.LanguageExtensions: BangPatterns :: Extension
+ GHC.Internal.LanguageExtensions: BinaryLiterals :: Extension
+ GHC.Internal.LanguageExtensions: BlockArguments :: Extension
+ GHC.Internal.LanguageExtensions: CApiFFI :: Extension
+ GHC.Internal.LanguageExtensions: CUSKs :: Extension
+ GHC.Internal.LanguageExtensions: ConstrainedClassMethods :: Extension
+ GHC.Internal.LanguageExtensions: ConstraintKinds :: Extension
+ GHC.Internal.LanguageExtensions: Cpp :: Extension
+ GHC.Internal.LanguageExtensions: DataKinds :: Extension
+ GHC.Internal.LanguageExtensions: DatatypeContexts :: Extension
+ GHC.Internal.LanguageExtensions: DeepSubsumption :: Extension
+ GHC.Internal.LanguageExtensions: DefaultSignatures :: Extension
+ GHC.Internal.LanguageExtensions: DeriveAnyClass :: Extension
+ GHC.Internal.LanguageExtensions: DeriveDataTypeable :: Extension
+ GHC.Internal.LanguageExtensions: DeriveFoldable :: Extension
+ GHC.Internal.LanguageExtensions: DeriveFunctor :: Extension
+ GHC.Internal.LanguageExtensions: DeriveGeneric :: Extension
+ GHC.Internal.LanguageExtensions: DeriveLift :: Extension
+ GHC.Internal.LanguageExtensions: DeriveTraversable :: Extension
+ GHC.Internal.LanguageExtensions: DerivingStrategies :: Extension
+ GHC.Internal.LanguageExtensions: DerivingVia :: Extension
+ GHC.Internal.LanguageExtensions: DisambiguateRecordFields :: Extension
+ GHC.Internal.LanguageExtensions: DoAndIfThenElse :: Extension
+ GHC.Internal.LanguageExtensions: DuplicateRecordFields :: Extension
+ GHC.Internal.LanguageExtensions: EmptyCase :: Extension
+ GHC.Internal.LanguageExtensions: EmptyDataDecls :: Extension
+ GHC.Internal.LanguageExtensions: EmptyDataDeriving :: Extension
+ GHC.Internal.LanguageExtensions: ExistentialQuantification :: Extension
+ GHC.Internal.LanguageExtensions: ExplicitForAll :: Extension
+ GHC.Internal.LanguageExtensions: ExplicitNamespaces :: Extension
+ GHC.Internal.LanguageExtensions: ExtendedDefaultRules :: Extension
+ GHC.Internal.LanguageExtensions: ExtendedLiterals :: Extension
+ GHC.Internal.LanguageExtensions: FieldSelectors :: Extension
+ GHC.Internal.LanguageExtensions: FlexibleContexts :: Extension
+ GHC.Internal.LanguageExtensions: FlexibleInstances :: Extension
+ GHC.Internal.LanguageExtensions: ForeignFunctionInterface :: Extension
+ GHC.Internal.LanguageExtensions: FunctionalDependencies :: Extension
+ GHC.Internal.LanguageExtensions: GADTSyntax :: Extension
+ GHC.Internal.LanguageExtensions: GADTs :: Extension
+ GHC.Internal.LanguageExtensions: GHCForeignImportPrim :: Extension
+ GHC.Internal.LanguageExtensions: GeneralizedNewtypeDeriving :: Extension
+ GHC.Internal.LanguageExtensions: HexFloatLiterals :: Extension
+ GHC.Internal.LanguageExtensions: ImplicitParams :: Extension
+ GHC.Internal.LanguageExtensions: ImplicitPrelude :: Extension
+ GHC.Internal.LanguageExtensions: ImportQualifiedPost :: Extension
+ GHC.Internal.LanguageExtensions: ImpredicativeTypes :: Extension
+ GHC.Internal.LanguageExtensions: IncoherentInstances :: Extension
+ GHC.Internal.LanguageExtensions: InstanceSigs :: Extension
+ GHC.Internal.LanguageExtensions: InterruptibleFFI :: Extension
+ GHC.Internal.LanguageExtensions: JavaScriptFFI :: Extension
+ GHC.Internal.LanguageExtensions: KindSignatures :: Extension
+ GHC.Internal.LanguageExtensions: LambdaCase :: Extension
+ GHC.Internal.LanguageExtensions: LexicalNegation :: Extension
+ GHC.Internal.LanguageExtensions: LiberalTypeSynonyms :: Extension
+ GHC.Internal.LanguageExtensions: LinearTypes :: Extension
+ GHC.Internal.LanguageExtensions: ListTuplePuns :: Extension
+ GHC.Internal.LanguageExtensions: MagicHash :: Extension
+ GHC.Internal.LanguageExtensions: MonadComprehensions :: Extension
+ GHC.Internal.LanguageExtensions: MonoLocalBinds :: Extension
+ GHC.Internal.LanguageExtensions: MonomorphismRestriction :: Extension
+ GHC.Internal.LanguageExtensions: MultiParamTypeClasses :: Extension
+ GHC.Internal.LanguageExtensions: MultiWayIf :: Extension
+ GHC.Internal.LanguageExtensions: MultilineStrings :: Extension
+ GHC.Internal.LanguageExtensions: NPlusKPatterns :: Extension
+ GHC.Internal.LanguageExtensions: NamedDefaults :: Extension
+ GHC.Internal.LanguageExtensions: NamedFieldPuns :: Extension
+ GHC.Internal.LanguageExtensions: NamedWildCards :: Extension
+ GHC.Internal.LanguageExtensions: NegativeLiterals :: Extension
+ GHC.Internal.LanguageExtensions: NondecreasingIndentation :: Extension
+ GHC.Internal.LanguageExtensions: NullaryTypeClasses :: Extension
+ GHC.Internal.LanguageExtensions: NumDecimals :: Extension
+ GHC.Internal.LanguageExtensions: NumericUnderscores :: Extension
+ GHC.Internal.LanguageExtensions: OrPatterns :: Extension
+ GHC.Internal.LanguageExtensions: OverlappingInstances :: Extension
+ GHC.Internal.LanguageExtensions: OverloadedLabels :: Extension
+ GHC.Internal.LanguageExtensions: OverloadedLists :: Extension
+ GHC.Internal.LanguageExtensions: OverloadedRecordDot :: Extension
+ GHC.Internal.LanguageExtensions: OverloadedRecordUpdate :: Extension
+ GHC.Internal.LanguageExtensions: OverloadedStrings :: Extension
+ GHC.Internal.LanguageExtensions: PackageImports :: Extension
+ GHC.Internal.LanguageExtensions: ParallelArrays :: Extension
+ GHC.Internal.LanguageExtensions: ParallelListComp :: Extension
+ GHC.Internal.LanguageExtensions: PartialTypeSignatures :: Extension
+ GHC.Internal.LanguageExtensions: PatternGuards :: Extension
+ GHC.Internal.LanguageExtensions: PatternSynonyms :: Extension
+ GHC.Internal.LanguageExtensions: PolyKinds :: Extension
+ GHC.Internal.LanguageExtensions: PostfixOperators :: Extension
+ GHC.Internal.LanguageExtensions: QualifiedDo :: Extension
+ GHC.Internal.LanguageExtensions: QuantifiedConstraints :: Extension
+ GHC.Internal.LanguageExtensions: QuasiQuotes :: Extension
+ GHC.Internal.LanguageExtensions: RankNTypes :: Extension
+ GHC.Internal.LanguageExtensions: RebindableSyntax :: Extension
+ GHC.Internal.LanguageExtensions: RecordWildCards :: Extension
+ GHC.Internal.LanguageExtensions: RecursiveDo :: Extension
+ GHC.Internal.LanguageExtensions: RelaxedLayout :: Extension
+ GHC.Internal.LanguageExtensions: RelaxedPolyRec :: Extension
+ GHC.Internal.LanguageExtensions: RequiredTypeArguments :: Extension
+ GHC.Internal.LanguageExtensions: RoleAnnotations :: Extension
+ GHC.Internal.LanguageExtensions: ScopedTypeVariables :: Extension
+ GHC.Internal.LanguageExtensions: StandaloneDeriving :: Extension
+ GHC.Internal.LanguageExtensions: StandaloneKindSignatures :: Extension
+ GHC.Internal.LanguageExtensions: StarIsType :: Extension
+ GHC.Internal.LanguageExtensions: StaticPointers :: Extension
+ GHC.Internal.LanguageExtensions: Strict :: Extension
+ GHC.Internal.LanguageExtensions: StrictData :: Extension
+ GHC.Internal.LanguageExtensions: TemplateHaskell :: Extension
+ GHC.Internal.LanguageExtensions: TemplateHaskellQuotes :: Extension
+ GHC.Internal.LanguageExtensions: TraditionalRecordSyntax :: Extension
+ GHC.Internal.LanguageExtensions: TransformListComp :: Extension
+ GHC.Internal.LanguageExtensions: TupleSections :: Extension
+ GHC.Internal.LanguageExtensions: TypeAbstractions :: Extension
+ GHC.Internal.LanguageExtensions: TypeApplications :: Extension
+ GHC.Internal.LanguageExtensions: TypeData :: Extension
+ GHC.Internal.LanguageExtensions: TypeFamilies :: Extension
+ GHC.Internal.LanguageExtensions: TypeFamilyDependencies :: Extension
+ GHC.Internal.LanguageExtensions: TypeInType :: Extension
+ GHC.Internal.LanguageExtensions: TypeOperators :: Extension
+ GHC.Internal.LanguageExtensions: TypeSynonymInstances :: Extension
+ GHC.Internal.LanguageExtensions: UnboxedSums :: Extension
+ GHC.Internal.LanguageExtensions: UnboxedTuples :: Extension
+ GHC.Internal.LanguageExtensions: UndecidableInstances :: Extension
+ GHC.Internal.LanguageExtensions: UndecidableSuperClasses :: Extension
+ GHC.Internal.LanguageExtensions: UnicodeSyntax :: Extension
+ GHC.Internal.LanguageExtensions: UnliftedDatatypes :: Extension
+ GHC.Internal.LanguageExtensions: UnliftedFFITypes :: Extension
+ GHC.Internal.LanguageExtensions: UnliftedNewtypes :: Extension
+ GHC.Internal.LanguageExtensions: ViewPatterns :: Extension
+ GHC.Internal.LanguageExtensions: data Extension
+ GHC.Internal.LanguageExtensions: instance GHC.Classes.Eq GHC.Internal.LanguageExtensions.Extension
+ GHC.Internal.LanguageExtensions: instance GHC.Classes.Ord GHC.Internal.LanguageExtensions.Extension
+ GHC.Internal.LanguageExtensions: instance GHC.Enum.Bounded GHC.Internal.LanguageExtensions.Extension
+ GHC.Internal.LanguageExtensions: instance GHC.Enum.Enum GHC.Internal.LanguageExtensions.Extension
+ GHC.Internal.LanguageExtensions: instance GHC.Generics.Generic GHC.Internal.LanguageExtensions.Extension
+ GHC.Internal.LanguageExtensions: instance GHC.Show.Show GHC.Internal.LanguageExtensions.Extension
+ GHC.Internal.Lexeme: isVarSymChar :: Char -> Bool
+ GHC.Internal.Lexeme: okSymChar :: Char -> Bool
+ GHC.Internal.Lexeme: startsConId :: Char -> Bool
+ GHC.Internal.Lexeme: startsConSym :: Char -> Bool
+ GHC.Internal.Lexeme: startsVarId :: Char -> Bool
+ GHC.Internal.Lexeme: startsVarSym :: Char -> Bool
+ GHC.Internal.Lexeme: startsVarSymASCII :: Char -> Bool
+ GHC.Internal.TH.Lib.Map: data Map k a
+ GHC.Internal.TH.Lib.Map: empty :: Map k a
+ GHC.Internal.TH.Lib.Map: insert :: Ord k => k -> a -> Map k a -> Map k a
+ GHC.Internal.TH.Lib.Map: lookup :: Ord k => k -> Map k a -> Maybe a
+ GHC.Internal.TH.Ppr: ForallInvis :: ForallVisFlag
+ GHC.Internal.TH.Ppr: ForallVis :: ForallVisFlag
+ GHC.Internal.TH.Ppr: TANormal :: Type -> TypeArg
+ GHC.Internal.TH.Ppr: TyArg :: Kind -> TypeArg
+ GHC.Internal.TH.Ppr: appPrec :: Precedence
+ GHC.Internal.TH.Ppr: bar :: Doc
+ GHC.Internal.TH.Ppr: bytesToString :: [Word8] -> String
+ GHC.Internal.TH.Ppr: class Ppr a
+ GHC.Internal.TH.Ppr: class PprFlag flag
+ GHC.Internal.TH.Ppr: commaSep :: Ppr a => [a] -> Doc
+ GHC.Internal.TH.Ppr: commaSepApplied :: [Name] -> Doc
+ GHC.Internal.TH.Ppr: commaSepWith :: (a -> Doc) -> [a] -> Doc
+ GHC.Internal.TH.Ppr: data ForallVisFlag
+ GHC.Internal.TH.Ppr: data TypeArg
+ GHC.Internal.TH.Ppr: fromTANormal :: TypeArg -> Maybe Type
+ GHC.Internal.TH.Ppr: funPrec :: Precedence
+ GHC.Internal.TH.Ppr: hashParens :: Doc -> Doc
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Ppr.TypeArg
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Bang
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Clause
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Con
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Dec
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.DecidedStrictness
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Exp
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.FamilyResultSig
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Foreign
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.FunDep
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Info
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.InjectivityAnn
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Inline
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Lit
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Loc
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Match
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Module
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.ModuleInfo
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Name
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Pat
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.PatSynArgs
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.PatSynDir
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Phases
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Pragma
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Range
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Role
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.RuleBndr
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.RuleMatch
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.SourceStrictness
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Stmt
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.TyLit
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr GHC.Internal.TH.Syntax.Type
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.Ppr a => GHC.Internal.TH.Ppr.Ppr [a]
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.PprFlag ()
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.PprFlag GHC.Internal.TH.Syntax.BndrVis
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.PprFlag GHC.Internal.TH.Syntax.Specificity
+ GHC.Internal.TH.Ppr: instance GHC.Internal.TH.Ppr.PprFlag flag => GHC.Internal.TH.Ppr.Ppr (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ GHC.Internal.TH.Ppr: instance GHC.Show.Show GHC.Internal.TH.Ppr.ForallVisFlag
+ GHC.Internal.TH.Ppr: isStarT :: Type -> Bool
+ GHC.Internal.TH.Ppr: isSymOcc :: Name -> Bool
+ GHC.Internal.TH.Ppr: nestDepth :: Int
+ GHC.Internal.TH.Ppr: noPrec :: Precedence
+ GHC.Internal.TH.Ppr: opPrec :: Precedence
+ GHC.Internal.TH.Ppr: parensIf :: Bool -> Doc -> Doc
+ GHC.Internal.TH.Ppr: ppr :: Ppr a => a -> Doc
+ GHC.Internal.TH.Ppr: pprBangType :: BangType -> Doc
+ GHC.Internal.TH.Ppr: pprBndrVis :: BndrVis -> Doc -> Doc
+ GHC.Internal.TH.Ppr: pprBody :: Bool -> Body -> Doc
+ GHC.Internal.TH.Ppr: pprClause :: Bool -> Clause -> Doc
+ GHC.Internal.TH.Ppr: pprCtxWith :: Ppr a => (Precedence -> a -> Doc) -> [a] -> Doc
+ GHC.Internal.TH.Ppr: pprCxt :: Cxt -> Doc
+ GHC.Internal.TH.Ppr: pprExp :: Precedence -> Exp -> Doc
+ GHC.Internal.TH.Ppr: pprFields :: [(Name, Exp)] -> Doc
+ GHC.Internal.TH.Ppr: pprFixity :: Name -> Fixity -> NamespaceSpecifier -> Doc
+ GHC.Internal.TH.Ppr: pprForall :: [TyVarBndr Specificity] -> Cxt -> Doc
+ GHC.Internal.TH.Ppr: pprForall' :: PprFlag flag => ForallVisFlag -> [TyVarBndr flag] -> Cxt -> Doc
+ GHC.Internal.TH.Ppr: pprForallVis :: [TyVarBndr ()] -> Cxt -> Doc
+ GHC.Internal.TH.Ppr: pprFunArgType :: Type -> Doc
+ GHC.Internal.TH.Ppr: pprGadtRHS :: [(Strict, Type)] -> Type -> Doc
+ GHC.Internal.TH.Ppr: pprGuarded :: Doc -> (Guard, Exp) -> Doc
+ GHC.Internal.TH.Ppr: pprInfixExp :: Exp -> Doc
+ GHC.Internal.TH.Ppr: pprInfixT :: Precedence -> Type -> Doc
+ GHC.Internal.TH.Ppr: pprLit :: Precedence -> Lit -> Doc
+ GHC.Internal.TH.Ppr: pprMatchPat :: Pat -> Doc
+ GHC.Internal.TH.Ppr: pprMaybeExp :: Precedence -> Maybe Exp -> Doc
+ GHC.Internal.TH.Ppr: pprNamespaceSpecifier :: NamespaceSpecifier -> Doc
+ GHC.Internal.TH.Ppr: pprParendType :: Type -> Doc
+ GHC.Internal.TH.Ppr: pprParendTypeArg :: TypeArg -> Doc
+ GHC.Internal.TH.Ppr: pprPat :: Precedence -> Pat -> Doc
+ GHC.Internal.TH.Ppr: pprPatSynSig :: Name -> PatSynType -> Doc
+ GHC.Internal.TH.Ppr: pprPatSynType :: PatSynType -> Doc
+ GHC.Internal.TH.Ppr: pprPrefixOcc :: Name -> Doc
+ GHC.Internal.TH.Ppr: pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc
+ GHC.Internal.TH.Ppr: pprStrictType :: (Strict, Type) -> Doc
+ GHC.Internal.TH.Ppr: pprString :: String -> Doc
+ GHC.Internal.TH.Ppr: pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc
+ GHC.Internal.TH.Ppr: pprTyLit :: TyLit -> Doc
+ GHC.Internal.TH.Ppr: pprTyVarBndr :: PprFlag flag => TyVarBndr flag -> Doc
+ GHC.Internal.TH.Ppr: pprType :: Precedence -> Type -> Doc
+ GHC.Internal.TH.Ppr: pprVarBangType :: VarBangType -> Doc
+ GHC.Internal.TH.Ppr: pprVarStrictType :: (Name, Strict, Type) -> Doc
+ GHC.Internal.TH.Ppr: ppr_bndrs :: PprFlag flag => Maybe [TyVarBndr flag] -> Doc
+ GHC.Internal.TH.Ppr: ppr_ctx_preds_with :: Ppr a => (Precedence -> a -> Doc) -> Precedence -> [a] -> Doc
+ GHC.Internal.TH.Ppr: ppr_cxt_preds :: Precedence -> Cxt -> Doc
+ GHC.Internal.TH.Ppr: ppr_data :: Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc
+ GHC.Internal.TH.Ppr: ppr_dec :: Bool -> Dec -> Doc
+ GHC.Internal.TH.Ppr: ppr_deriv_clause :: DerivClause -> Doc
+ GHC.Internal.TH.Ppr: ppr_deriv_strategy :: DerivStrategy -> Doc
+ GHC.Internal.TH.Ppr: ppr_list :: Ppr a => [a] -> Doc
+ GHC.Internal.TH.Ppr: ppr_newtype :: Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause] -> Doc
+ GHC.Internal.TH.Ppr: ppr_overlap :: Overlap -> Doc
+ GHC.Internal.TH.Ppr: ppr_sig :: Name -> Type -> Doc
+ GHC.Internal.TH.Ppr: ppr_tf_head :: TypeFamilyHead -> Doc
+ GHC.Internal.TH.Ppr: ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc
+ GHC.Internal.TH.Ppr: ppr_type_data :: Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc
+ GHC.Internal.TH.Ppr: ppr_typedef :: String -> Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc
+ GHC.Internal.TH.Ppr: pprint :: Ppr a => a -> String
+ GHC.Internal.TH.Ppr: qualPrec :: Precedence
+ GHC.Internal.TH.Ppr: quoteParens :: Doc -> Doc
+ GHC.Internal.TH.Ppr: semiSep :: Ppr a => [a] -> Doc
+ GHC.Internal.TH.Ppr: semiSepWith :: (a -> Doc) -> [a] -> Doc
+ GHC.Internal.TH.Ppr: sepWith :: Doc -> (a -> Doc) -> [a] -> Doc
+ GHC.Internal.TH.Ppr: showtextl :: Show a => a -> Doc
+ GHC.Internal.TH.Ppr: sigPrec :: Precedence
+ GHC.Internal.TH.Ppr: split :: Type -> (Type, [TypeArg])
+ GHC.Internal.TH.Ppr: type Precedence = Int
+ GHC.Internal.TH.Ppr: unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc
+ GHC.Internal.TH.Ppr: unopPrec :: Precedence
+ GHC.Internal.TH.Ppr: where_clause :: [Dec] -> Doc
+ GHC.Internal.TH.PprLib: ($$) :: Doc -> Doc -> Doc
+ GHC.Internal.TH.PprLib: ($+$) :: Doc -> Doc -> Doc
+ GHC.Internal.TH.PprLib: (<+>) :: Doc -> Doc -> Doc
+ GHC.Internal.TH.PprLib: (<>) :: Doc -> Doc -> Doc
+ GHC.Internal.TH.PprLib: arrow :: Doc
+ GHC.Internal.TH.PprLib: braces :: Doc -> Doc
+ GHC.Internal.TH.PprLib: brackets :: Doc -> Doc
+ GHC.Internal.TH.PprLib: cat :: [Doc] -> Doc
+ GHC.Internal.TH.PprLib: char :: Char -> Doc
+ GHC.Internal.TH.PprLib: colon :: Doc
+ GHC.Internal.TH.PprLib: comma :: Doc
+ GHC.Internal.TH.PprLib: data PprM a
+ GHC.Internal.TH.PprLib: dcolon :: Doc
+ GHC.Internal.TH.PprLib: double :: Double -> Doc
+ GHC.Internal.TH.PprLib: doubleQuotes :: Doc -> Doc
+ GHC.Internal.TH.PprLib: empty :: Doc
+ GHC.Internal.TH.PprLib: equals :: Doc
+ GHC.Internal.TH.PprLib: fcat :: [Doc] -> Doc
+ GHC.Internal.TH.PprLib: float :: Float -> Doc
+ GHC.Internal.TH.PprLib: fsep :: [Doc] -> Doc
+ GHC.Internal.TH.PprLib: hang :: Doc -> Int -> Doc -> Doc
+ GHC.Internal.TH.PprLib: hcat :: [Doc] -> Doc
+ GHC.Internal.TH.PprLib: hsep :: [Doc] -> Doc
+ GHC.Internal.TH.PprLib: infixl 5 $+$
+ GHC.Internal.TH.PprLib: infixl 6 <+>
+ GHC.Internal.TH.PprLib: instance GHC.Base.Applicative GHC.Internal.TH.PprLib.PprM
+ GHC.Internal.TH.PprLib: instance GHC.Base.Functor GHC.Internal.TH.PprLib.PprM
+ GHC.Internal.TH.PprLib: instance GHC.Base.Monad GHC.Internal.TH.PprLib.PprM
+ GHC.Internal.TH.PprLib: instance GHC.Show.Show GHC.Internal.TH.PprLib.Doc
+ GHC.Internal.TH.PprLib: int :: Int -> Doc
+ GHC.Internal.TH.PprLib: integer :: Integer -> Doc
+ GHC.Internal.TH.PprLib: isEmpty :: Doc -> PprM Bool
+ GHC.Internal.TH.PprLib: lbrace :: Doc
+ GHC.Internal.TH.PprLib: lbrack :: Doc
+ GHC.Internal.TH.PprLib: lparen :: Doc
+ GHC.Internal.TH.PprLib: nest :: Int -> Doc -> Doc
+ GHC.Internal.TH.PprLib: parens :: Doc -> Doc
+ GHC.Internal.TH.PprLib: pprName :: Name -> Doc
+ GHC.Internal.TH.PprLib: pprName' :: NameIs -> Name -> Doc
+ GHC.Internal.TH.PprLib: ptext :: String -> Doc
+ GHC.Internal.TH.PprLib: punctuate :: Doc -> [Doc] -> [Doc]
+ GHC.Internal.TH.PprLib: quotes :: Doc -> Doc
+ GHC.Internal.TH.PprLib: rational :: Rational -> Doc
+ GHC.Internal.TH.PprLib: rbrace :: Doc
+ GHC.Internal.TH.PprLib: rbrack :: Doc
+ GHC.Internal.TH.PprLib: rparen :: Doc
+ GHC.Internal.TH.PprLib: semi :: Doc
+ GHC.Internal.TH.PprLib: sep :: [Doc] -> Doc
+ GHC.Internal.TH.PprLib: space :: Doc
+ GHC.Internal.TH.PprLib: text :: String -> Doc
+ GHC.Internal.TH.PprLib: to_HPJ_Doc :: Doc -> Doc
+ GHC.Internal.TH.PprLib: type Doc = PprM Doc
+ GHC.Internal.TH.PprLib: vcat :: [Doc] -> Doc
+ GHC.Internal.TH.Syntax: AllPhases :: Phases
+ GHC.Internal.TH.Syntax: Alone :: NameIs
+ GHC.Internal.TH.Syntax: AnnLookupModule :: Module -> AnnLookup
+ GHC.Internal.TH.Syntax: AnnLookupName :: Name -> AnnLookup
+ GHC.Internal.TH.Syntax: AnnP :: AnnTarget -> Exp -> Pragma
+ GHC.Internal.TH.Syntax: AnyclassStrategy :: DerivStrategy
+ GHC.Internal.TH.Syntax: AppE :: Exp -> Exp -> Exp
+ GHC.Internal.TH.Syntax: AppKindT :: Type -> Kind -> Type
+ GHC.Internal.TH.Syntax: AppT :: Type -> Type -> Type
+ GHC.Internal.TH.Syntax: AppTypeE :: Exp -> Type -> Exp
+ GHC.Internal.TH.Syntax: Applied :: NameIs
+ GHC.Internal.TH.Syntax: ArgDoc :: Name -> Int -> DocLoc
+ GHC.Internal.TH.Syntax: ArithSeqE :: Range -> Exp
+ GHC.Internal.TH.Syntax: ArrowT :: Type
+ GHC.Internal.TH.Syntax: AsP :: Name -> Pat -> Pat
+ GHC.Internal.TH.Syntax: Bang :: SourceUnpackedness -> SourceStrictness -> Bang
+ GHC.Internal.TH.Syntax: BangP :: Pat -> Pat
+ GHC.Internal.TH.Syntax: BeforePhase :: Int -> Phases
+ GHC.Internal.TH.Syntax: BindS :: Pat -> Exp -> Stmt
+ GHC.Internal.TH.Syntax: BndrInvis :: BndrVis
+ GHC.Internal.TH.Syntax: BndrReq :: BndrVis
+ GHC.Internal.TH.Syntax: Bytes :: ForeignPtr Word8 -> Word -> Word -> Bytes
+ GHC.Internal.TH.Syntax: BytesPrimL :: Bytes -> Lit
+ GHC.Internal.TH.Syntax: CApi :: Callconv
+ GHC.Internal.TH.Syntax: CCall :: Callconv
+ GHC.Internal.TH.Syntax: CaseE :: Exp -> [Match] -> Exp
+ GHC.Internal.TH.Syntax: CharL :: Char -> Lit
+ GHC.Internal.TH.Syntax: CharPrimL :: Char -> Lit
+ GHC.Internal.TH.Syntax: CharTyLit :: Char -> TyLit
+ GHC.Internal.TH.Syntax: ClassD :: Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [Dec] -> Dec
+ GHC.Internal.TH.Syntax: ClassI :: Dec -> [InstanceDec] -> Info
+ GHC.Internal.TH.Syntax: ClassOpI :: Name -> Type -> ParentName -> Info
+ GHC.Internal.TH.Syntax: Clause :: [Pat] -> Body -> [Dec] -> Clause
+ GHC.Internal.TH.Syntax: ClosedTypeFamilyD :: TypeFamilyHead -> [TySynEqn] -> Dec
+ GHC.Internal.TH.Syntax: Code :: m (TExp a) -> Code (m :: Type -> Type) (a :: TYPE r)
+ GHC.Internal.TH.Syntax: CompE :: [Stmt] -> Exp
+ GHC.Internal.TH.Syntax: CompleteP :: [Name] -> Maybe Name -> Pragma
+ GHC.Internal.TH.Syntax: ConE :: Name -> Exp
+ GHC.Internal.TH.Syntax: ConLike :: RuleMatch
+ GHC.Internal.TH.Syntax: ConP :: Name -> [Type] -> [Pat] -> Pat
+ GHC.Internal.TH.Syntax: ConT :: Name -> Type
+ GHC.Internal.TH.Syntax: CondE :: Exp -> Exp -> Exp -> Exp
+ GHC.Internal.TH.Syntax: ConstrainedE :: [Exp] -> Exp -> Exp
+ GHC.Internal.TH.Syntax: ConstraintT :: Type
+ GHC.Internal.TH.Syntax: DataConI :: Name -> Type -> ParentName -> Info
+ GHC.Internal.TH.Syntax: DataD :: Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [Con] -> [DerivClause] -> Dec
+ GHC.Internal.TH.Syntax: DataFamilyD :: Name -> [TyVarBndr BndrVis] -> Maybe Kind -> Dec
+ GHC.Internal.TH.Syntax: DataInstD :: Cxt -> Maybe [TyVarBndr ()] -> Type -> Maybe Kind -> [Con] -> [DerivClause] -> Dec
+ GHC.Internal.TH.Syntax: DataName :: NameSpace
+ GHC.Internal.TH.Syntax: DataNamespaceSpecifier :: NamespaceSpecifier
+ GHC.Internal.TH.Syntax: DecidedLazy :: DecidedStrictness
+ GHC.Internal.TH.Syntax: DecidedStrict :: DecidedStrictness
+ GHC.Internal.TH.Syntax: DecidedUnpack :: DecidedStrictness
+ GHC.Internal.TH.Syntax: DeclDoc :: Name -> DocLoc
+ GHC.Internal.TH.Syntax: DefaultD :: [Type] -> Dec
+ GHC.Internal.TH.Syntax: DefaultSigD :: Name -> Type -> Dec
+ GHC.Internal.TH.Syntax: DerivClause :: Maybe DerivStrategy -> Cxt -> DerivClause
+ GHC.Internal.TH.Syntax: DoE :: Maybe ModName -> [Stmt] -> Exp
+ GHC.Internal.TH.Syntax: DoublePrimL :: Rational -> Lit
+ GHC.Internal.TH.Syntax: EqualityT :: Type
+ GHC.Internal.TH.Syntax: ExplBidir :: [Clause] -> PatSynDir
+ GHC.Internal.TH.Syntax: ExportF :: Callconv -> String -> Name -> Type -> Foreign
+ GHC.Internal.TH.Syntax: FamilyI :: Dec -> [InstanceDec] -> Info
+ GHC.Internal.TH.Syntax: Fixity :: Int -> FixityDirection -> Fixity
+ GHC.Internal.TH.Syntax: FldName :: !String -> NameSpace
+ GHC.Internal.TH.Syntax: FloatPrimL :: Rational -> Lit
+ GHC.Internal.TH.Syntax: ForallC :: [TyVarBndr Specificity] -> Cxt -> Con -> Con
+ GHC.Internal.TH.Syntax: ForallE :: [TyVarBndr Specificity] -> Exp -> Exp
+ GHC.Internal.TH.Syntax: ForallT :: [TyVarBndr Specificity] -> Cxt -> Type -> Type
+ GHC.Internal.TH.Syntax: ForallVisE :: [TyVarBndr ()] -> Exp -> Exp
+ GHC.Internal.TH.Syntax: ForallVisT :: [TyVarBndr ()] -> Type -> Type
+ GHC.Internal.TH.Syntax: ForeignD :: Foreign -> Dec
+ GHC.Internal.TH.Syntax: FromPhase :: Int -> Phases
+ GHC.Internal.TH.Syntax: FromR :: Exp -> Range
+ GHC.Internal.TH.Syntax: FromThenR :: Exp -> Exp -> Range
+ GHC.Internal.TH.Syntax: FromThenToR :: Exp -> Exp -> Exp -> Range
+ GHC.Internal.TH.Syntax: FromToR :: Exp -> Exp -> Range
+ GHC.Internal.TH.Syntax: FunD :: Name -> [Clause] -> Dec
+ GHC.Internal.TH.Syntax: FunDep :: [Name] -> [Name] -> FunDep
+ GHC.Internal.TH.Syntax: FunLike :: RuleMatch
+ GHC.Internal.TH.Syntax: GadtC :: [Name] -> [BangType] -> Type -> Con
+ GHC.Internal.TH.Syntax: GetFieldE :: Exp -> String -> Exp
+ GHC.Internal.TH.Syntax: GuardedB :: [(Guard, Exp)] -> Body
+ GHC.Internal.TH.Syntax: ImplBidir :: PatSynDir
+ GHC.Internal.TH.Syntax: ImplicitParamBindD :: String -> Exp -> Dec
+ GHC.Internal.TH.Syntax: ImplicitParamT :: String -> Type -> Type
+ GHC.Internal.TH.Syntax: ImplicitParamVarE :: String -> Exp
+ GHC.Internal.TH.Syntax: ImportF :: Callconv -> Safety -> String -> Name -> Type -> Foreign
+ GHC.Internal.TH.Syntax: Incoherent :: Overlap
+ GHC.Internal.TH.Syntax: InferR :: Role
+ GHC.Internal.TH.Syntax: InferredSpec :: Specificity
+ GHC.Internal.TH.Syntax: Infix :: NameIs
+ GHC.Internal.TH.Syntax: InfixC :: BangType -> Name -> BangType -> Con
+ GHC.Internal.TH.Syntax: InfixD :: Fixity -> NamespaceSpecifier -> Name -> Dec
+ GHC.Internal.TH.Syntax: InfixE :: Maybe Exp -> Exp -> Maybe Exp -> Exp
+ GHC.Internal.TH.Syntax: InfixL :: FixityDirection
+ GHC.Internal.TH.Syntax: InfixN :: FixityDirection
+ GHC.Internal.TH.Syntax: InfixP :: Pat -> Name -> Pat -> Pat
+ GHC.Internal.TH.Syntax: InfixPatSyn :: Name -> Name -> PatSynArgs
+ GHC.Internal.TH.Syntax: InfixR :: FixityDirection
+ GHC.Internal.TH.Syntax: InfixT :: Type -> Name -> Type -> Type
+ GHC.Internal.TH.Syntax: InjectivityAnn :: Name -> [Name] -> InjectivityAnn
+ GHC.Internal.TH.Syntax: Inlinable :: Inline
+ GHC.Internal.TH.Syntax: Inline :: Inline
+ GHC.Internal.TH.Syntax: InlineP :: Name -> Inline -> RuleMatch -> Phases -> Pragma
+ GHC.Internal.TH.Syntax: InstDoc :: Type -> DocLoc
+ GHC.Internal.TH.Syntax: InstanceD :: Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
+ GHC.Internal.TH.Syntax: IntPrimL :: Integer -> Lit
+ GHC.Internal.TH.Syntax: IntegerL :: Integer -> Lit
+ GHC.Internal.TH.Syntax: Interruptible :: Safety
+ GHC.Internal.TH.Syntax: InvisP :: Type -> Pat
+ GHC.Internal.TH.Syntax: JavaScript :: Callconv
+ GHC.Internal.TH.Syntax: KiSigD :: Name -> Kind -> Dec
+ GHC.Internal.TH.Syntax: KindSig :: Kind -> FamilyResultSig
+ GHC.Internal.TH.Syntax: KindedTV :: Name -> flag -> Kind -> TyVarBndr flag
+ GHC.Internal.TH.Syntax: LabelE :: String -> Exp
+ GHC.Internal.TH.Syntax: LamCaseE :: [Match] -> Exp
+ GHC.Internal.TH.Syntax: LamCasesE :: [Clause] -> Exp
+ GHC.Internal.TH.Syntax: LamE :: [Pat] -> Exp -> Exp
+ GHC.Internal.TH.Syntax: LangAsm :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: LangC :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: LangCxx :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: LangJs :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: LangObjc :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: LangObjcxx :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: LetE :: [Dec] -> Exp -> Exp
+ GHC.Internal.TH.Syntax: LetS :: [Dec] -> Stmt
+ GHC.Internal.TH.Syntax: LineP :: Int -> String -> Pragma
+ GHC.Internal.TH.Syntax: ListE :: [Exp] -> Exp
+ GHC.Internal.TH.Syntax: ListP :: [Pat] -> Pat
+ GHC.Internal.TH.Syntax: ListT :: Type
+ GHC.Internal.TH.Syntax: LitE :: Lit -> Exp
+ GHC.Internal.TH.Syntax: LitP :: Lit -> Pat
+ GHC.Internal.TH.Syntax: LitT :: TyLit -> Type
+ GHC.Internal.TH.Syntax: Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
+ GHC.Internal.TH.Syntax: MDoE :: Maybe ModName -> [Stmt] -> Exp
+ GHC.Internal.TH.Syntax: Match :: Pat -> Body -> [Dec] -> Match
+ GHC.Internal.TH.Syntax: ModName :: String -> ModName
+ GHC.Internal.TH.Syntax: Module :: PkgName -> ModName -> Module
+ GHC.Internal.TH.Syntax: ModuleAnnotation :: AnnTarget
+ GHC.Internal.TH.Syntax: ModuleDoc :: DocLoc
+ GHC.Internal.TH.Syntax: ModuleInfo :: [Module] -> ModuleInfo
+ GHC.Internal.TH.Syntax: MulArrowT :: Type
+ GHC.Internal.TH.Syntax: MultiIfE :: [(Guard, Exp)] -> Exp
+ GHC.Internal.TH.Syntax: Name :: OccName -> NameFlavour -> Name
+ GHC.Internal.TH.Syntax: NameG :: NameSpace -> PkgName -> ModName -> NameFlavour
+ GHC.Internal.TH.Syntax: NameL :: !Uniq -> NameFlavour
+ GHC.Internal.TH.Syntax: NameQ :: ModName -> NameFlavour
+ GHC.Internal.TH.Syntax: NameS :: NameFlavour
+ GHC.Internal.TH.Syntax: NameU :: !Uniq -> NameFlavour
+ GHC.Internal.TH.Syntax: NewtypeD :: Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> Con -> [DerivClause] -> Dec
+ GHC.Internal.TH.Syntax: NewtypeInstD :: Cxt -> Maybe [TyVarBndr ()] -> Type -> Maybe Kind -> Con -> [DerivClause] -> Dec
+ GHC.Internal.TH.Syntax: NewtypeStrategy :: DerivStrategy
+ GHC.Internal.TH.Syntax: NoBindS :: Exp -> Stmt
+ GHC.Internal.TH.Syntax: NoInline :: Inline
+ GHC.Internal.TH.Syntax: NoNamespaceSpecifier :: NamespaceSpecifier
+ GHC.Internal.TH.Syntax: NoSig :: FamilyResultSig
+ GHC.Internal.TH.Syntax: NoSourceStrictness :: SourceStrictness
+ GHC.Internal.TH.Syntax: NoSourceUnpackedness :: SourceUnpackedness
+ GHC.Internal.TH.Syntax: NominalR :: Role
+ GHC.Internal.TH.Syntax: NormalB :: Exp -> Body
+ GHC.Internal.TH.Syntax: NormalC :: Name -> [BangType] -> Con
+ GHC.Internal.TH.Syntax: NormalG :: Exp -> Guard
+ GHC.Internal.TH.Syntax: NumTyLit :: Integer -> TyLit
+ GHC.Internal.TH.Syntax: OccName :: String -> OccName
+ GHC.Internal.TH.Syntax: OpaqueP :: Name -> Pragma
+ GHC.Internal.TH.Syntax: OpenTypeFamilyD :: TypeFamilyHead -> Dec
+ GHC.Internal.TH.Syntax: OrP :: NonEmpty Pat -> Pat
+ GHC.Internal.TH.Syntax: Overlappable :: Overlap
+ GHC.Internal.TH.Syntax: Overlapping :: Overlap
+ GHC.Internal.TH.Syntax: Overlaps :: Overlap
+ GHC.Internal.TH.Syntax: ParS :: [[Stmt]] -> Stmt
+ GHC.Internal.TH.Syntax: ParensE :: Exp -> Exp
+ GHC.Internal.TH.Syntax: ParensP :: Pat -> Pat
+ GHC.Internal.TH.Syntax: ParensT :: Type -> Type
+ GHC.Internal.TH.Syntax: PatG :: [Stmt] -> Guard
+ GHC.Internal.TH.Syntax: PatSynD :: Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
+ GHC.Internal.TH.Syntax: PatSynI :: Name -> PatSynType -> Info
+ GHC.Internal.TH.Syntax: PatSynSigD :: Name -> PatSynType -> Dec
+ GHC.Internal.TH.Syntax: PhantomR :: Role
+ GHC.Internal.TH.Syntax: PkgName :: String -> PkgName
+ GHC.Internal.TH.Syntax: PlainTV :: Name -> flag -> TyVarBndr flag
+ GHC.Internal.TH.Syntax: PragmaD :: Pragma -> Dec
+ GHC.Internal.TH.Syntax: PrefixPatSyn :: [Name] -> PatSynArgs
+ GHC.Internal.TH.Syntax: Prim :: Callconv
+ GHC.Internal.TH.Syntax: PrimTyConI :: Name -> Arity -> Unlifted -> Info
+ GHC.Internal.TH.Syntax: ProjectionE :: NonEmpty String -> Exp
+ GHC.Internal.TH.Syntax: PromotedConsT :: Type
+ GHC.Internal.TH.Syntax: PromotedInfixT :: Type -> Name -> Type -> Type
+ GHC.Internal.TH.Syntax: PromotedNilT :: Type
+ GHC.Internal.TH.Syntax: PromotedT :: Name -> Type
+ GHC.Internal.TH.Syntax: PromotedTupleT :: Int -> Type
+ GHC.Internal.TH.Syntax: PromotedUInfixT :: Type -> Name -> Type -> Type
+ GHC.Internal.TH.Syntax: Q :: (forall (m :: Type -> Type). Quasi m => m a) -> Q a
+ GHC.Internal.TH.Syntax: RationalL :: Rational -> Lit
+ GHC.Internal.TH.Syntax: RawObject :: ForeignSrcLang
+ GHC.Internal.TH.Syntax: RecC :: Name -> [VarBangType] -> Con
+ GHC.Internal.TH.Syntax: RecConE :: Name -> [FieldExp] -> Exp
+ GHC.Internal.TH.Syntax: RecGadtC :: [Name] -> [VarBangType] -> Type -> Con
+ GHC.Internal.TH.Syntax: RecP :: Name -> [FieldPat] -> Pat
+ GHC.Internal.TH.Syntax: RecS :: [Stmt] -> Stmt
+ GHC.Internal.TH.Syntax: RecUpdE :: Exp -> [FieldExp] -> Exp
+ GHC.Internal.TH.Syntax: RecordPatSyn :: [Name] -> PatSynArgs
+ GHC.Internal.TH.Syntax: RepresentationalR :: Role
+ GHC.Internal.TH.Syntax: RoleAnnotD :: Name -> [Role] -> Dec
+ GHC.Internal.TH.Syntax: RuleP :: String -> Maybe [TyVarBndr ()] -> [RuleBndr] -> Exp -> Exp -> Phases -> Pragma
+ GHC.Internal.TH.Syntax: RuleVar :: Name -> RuleBndr
+ GHC.Internal.TH.Syntax: SCCP :: Name -> Maybe String -> Pragma
+ GHC.Internal.TH.Syntax: Safe :: Safety
+ GHC.Internal.TH.Syntax: SigD :: Name -> Type -> Dec
+ GHC.Internal.TH.Syntax: SigE :: Exp -> Type -> Exp
+ GHC.Internal.TH.Syntax: SigP :: Pat -> Type -> Pat
+ GHC.Internal.TH.Syntax: SigT :: Type -> Kind -> Type
+ GHC.Internal.TH.Syntax: SourceLazy :: SourceStrictness
+ GHC.Internal.TH.Syntax: SourceNoUnpack :: SourceUnpackedness
+ GHC.Internal.TH.Syntax: SourceStrict :: SourceStrictness
+ GHC.Internal.TH.Syntax: SourceUnpack :: SourceUnpackedness
+ GHC.Internal.TH.Syntax: SpecialiseInstP :: Type -> Pragma
+ GHC.Internal.TH.Syntax: SpecialiseP :: Name -> Type -> Maybe Inline -> Phases -> Pragma
+ GHC.Internal.TH.Syntax: SpecifiedSpec :: Specificity
+ GHC.Internal.TH.Syntax: StandaloneDerivD :: Maybe DerivStrategy -> Cxt -> Type -> Dec
+ GHC.Internal.TH.Syntax: StarT :: Type
+ GHC.Internal.TH.Syntax: StaticE :: Exp -> Exp
+ GHC.Internal.TH.Syntax: StdCall :: Callconv
+ GHC.Internal.TH.Syntax: StockStrategy :: DerivStrategy
+ GHC.Internal.TH.Syntax: StrTyLit :: String -> TyLit
+ GHC.Internal.TH.Syntax: StringL :: String -> Lit
+ GHC.Internal.TH.Syntax: StringPrimL :: [Word8] -> Lit
+ GHC.Internal.TH.Syntax: TExp :: Exp -> TExp (a :: TYPE r)
+ GHC.Internal.TH.Syntax: TcClsName :: NameSpace
+ GHC.Internal.TH.Syntax: TildeP :: Pat -> Pat
+ GHC.Internal.TH.Syntax: TupE :: [Maybe Exp] -> Exp
+ GHC.Internal.TH.Syntax: TupP :: [Pat] -> Pat
+ GHC.Internal.TH.Syntax: TupleT :: Int -> Type
+ GHC.Internal.TH.Syntax: TyConI :: Dec -> Info
+ GHC.Internal.TH.Syntax: TySynD :: Name -> [TyVarBndr BndrVis] -> Type -> Dec
+ GHC.Internal.TH.Syntax: TySynEqn :: Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
+ GHC.Internal.TH.Syntax: TySynInstD :: TySynEqn -> Dec
+ GHC.Internal.TH.Syntax: TyVarI :: Name -> Type -> Info
+ GHC.Internal.TH.Syntax: TyVarSig :: TyVarBndr () -> FamilyResultSig
+ GHC.Internal.TH.Syntax: TypeAnnotation :: Name -> AnnTarget
+ GHC.Internal.TH.Syntax: TypeDataD :: Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [Con] -> Dec
+ GHC.Internal.TH.Syntax: TypeE :: Type -> Exp
+ GHC.Internal.TH.Syntax: TypeFamilyHead :: Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> TypeFamilyHead
+ GHC.Internal.TH.Syntax: TypeNamespaceSpecifier :: NamespaceSpecifier
+ GHC.Internal.TH.Syntax: TypeP :: Type -> Pat
+ GHC.Internal.TH.Syntax: TypedBracketE :: Exp -> Exp
+ GHC.Internal.TH.Syntax: TypedRuleVar :: Name -> Type -> RuleBndr
+ GHC.Internal.TH.Syntax: TypedSpliceE :: Exp -> Exp
+ GHC.Internal.TH.Syntax: UInfixE :: Exp -> Exp -> Exp -> Exp
+ GHC.Internal.TH.Syntax: UInfixP :: Pat -> Name -> Pat -> Pat
+ GHC.Internal.TH.Syntax: UInfixT :: Type -> Name -> Type -> Type
+ GHC.Internal.TH.Syntax: UnboundVarE :: Name -> Exp
+ GHC.Internal.TH.Syntax: UnboxedSumE :: Exp -> SumAlt -> SumArity -> Exp
+ GHC.Internal.TH.Syntax: UnboxedSumP :: Pat -> SumAlt -> SumArity -> Pat
+ GHC.Internal.TH.Syntax: UnboxedSumT :: SumArity -> Type
+ GHC.Internal.TH.Syntax: UnboxedTupE :: [Maybe Exp] -> Exp
+ GHC.Internal.TH.Syntax: UnboxedTupP :: [Pat] -> Pat
+ GHC.Internal.TH.Syntax: UnboxedTupleT :: Int -> Type
+ GHC.Internal.TH.Syntax: Unidir :: PatSynDir
+ GHC.Internal.TH.Syntax: Unsafe :: Safety
+ GHC.Internal.TH.Syntax: ValD :: Pat -> Body -> [Dec] -> Dec
+ GHC.Internal.TH.Syntax: ValueAnnotation :: Name -> AnnTarget
+ GHC.Internal.TH.Syntax: VarE :: Name -> Exp
+ GHC.Internal.TH.Syntax: VarI :: Name -> Type -> Maybe Dec -> Info
+ GHC.Internal.TH.Syntax: VarName :: NameSpace
+ GHC.Internal.TH.Syntax: VarP :: Name -> Pat
+ GHC.Internal.TH.Syntax: VarT :: Name -> Type
+ GHC.Internal.TH.Syntax: ViaStrategy :: Type -> DerivStrategy
+ GHC.Internal.TH.Syntax: ViewP :: Exp -> Pat -> Pat
+ GHC.Internal.TH.Syntax: WildCardT :: Type
+ GHC.Internal.TH.Syntax: WildP :: Pat
+ GHC.Internal.TH.Syntax: WordPrimL :: Integer -> Lit
+ GHC.Internal.TH.Syntax: [bytesOffset] :: Bytes -> Word
+ GHC.Internal.TH.Syntax: [bytesPtr] :: Bytes -> ForeignPtr Word8
+ GHC.Internal.TH.Syntax: [bytesSize] :: Bytes -> Word
+ GHC.Internal.TH.Syntax: [examineCode] :: Code (m :: Type -> Type) (a :: TYPE r) -> m (TExp a)
+ GHC.Internal.TH.Syntax: [fldParent] :: NameSpace -> !String
+ GHC.Internal.TH.Syntax: [loc_end] :: Loc -> CharPos
+ GHC.Internal.TH.Syntax: [loc_filename] :: Loc -> String
+ GHC.Internal.TH.Syntax: [loc_module] :: Loc -> String
+ GHC.Internal.TH.Syntax: [loc_package] :: Loc -> String
+ GHC.Internal.TH.Syntax: [loc_start] :: Loc -> CharPos
+ GHC.Internal.TH.Syntax: [unQ] :: Q a -> forall (m :: Type -> Type). Quasi m => m a
+ GHC.Internal.TH.Syntax: [unType] :: TExp (a :: TYPE r) -> Exp
+ GHC.Internal.TH.Syntax: addCorePlugin :: String -> Q ()
+ GHC.Internal.TH.Syntax: addDependentFile :: FilePath -> Q ()
+ GHC.Internal.TH.Syntax: addForeignFile :: ForeignSrcLang -> String -> Q ()
+ GHC.Internal.TH.Syntax: addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
+ GHC.Internal.TH.Syntax: addForeignSource :: ForeignSrcLang -> String -> Q ()
+ GHC.Internal.TH.Syntax: addModFinalizer :: Q () -> Q ()
+ GHC.Internal.TH.Syntax: addTempFile :: String -> Q FilePath
+ GHC.Internal.TH.Syntax: addTopDecls :: [Dec] -> Q ()
+ GHC.Internal.TH.Syntax: badIO :: String -> IO a
+ GHC.Internal.TH.Syntax: bindCode :: Monad m => m a -> (a -> Code m b) -> Code m b
+ GHC.Internal.TH.Syntax: bindCode_ :: Monad m => m a -> Code m b -> Code m b
+ GHC.Internal.TH.Syntax: class (MonadIO m, MonadFail m) => Quasi (m :: Type -> Type)
+ GHC.Internal.TH.Syntax: class Monad m => Quote (m :: Type -> Type)
+ GHC.Internal.TH.Syntax: cmpEq :: Ordering -> Bool
+ GHC.Internal.TH.Syntax: compareBytes :: Bytes -> Bytes -> Ordering
+ GHC.Internal.TH.Syntax: counter :: IORef Uniq
+ GHC.Internal.TH.Syntax: data AnnLookup
+ GHC.Internal.TH.Syntax: data AnnTarget
+ GHC.Internal.TH.Syntax: data Bang
+ GHC.Internal.TH.Syntax: data BndrVis
+ GHC.Internal.TH.Syntax: data Body
+ GHC.Internal.TH.Syntax: data Bytes
+ GHC.Internal.TH.Syntax: data Callconv
+ GHC.Internal.TH.Syntax: data Clause
+ GHC.Internal.TH.Syntax: data Con
+ GHC.Internal.TH.Syntax: data Dec
+ GHC.Internal.TH.Syntax: data DecidedStrictness
+ GHC.Internal.TH.Syntax: data DerivClause
+ GHC.Internal.TH.Syntax: data DerivStrategy
+ GHC.Internal.TH.Syntax: data DocLoc
+ GHC.Internal.TH.Syntax: data Exp
+ GHC.Internal.TH.Syntax: data FamilyResultSig
+ GHC.Internal.TH.Syntax: data Fixity
+ GHC.Internal.TH.Syntax: data FixityDirection
+ GHC.Internal.TH.Syntax: data Foreign
+ GHC.Internal.TH.Syntax: data ForeignSrcLang
+ GHC.Internal.TH.Syntax: data FunDep
+ GHC.Internal.TH.Syntax: data Guard
+ GHC.Internal.TH.Syntax: data Info
+ GHC.Internal.TH.Syntax: data InjectivityAnn
+ GHC.Internal.TH.Syntax: data Inline
+ GHC.Internal.TH.Syntax: data Lit
+ GHC.Internal.TH.Syntax: data Loc
+ GHC.Internal.TH.Syntax: data Match
+ GHC.Internal.TH.Syntax: data Module
+ GHC.Internal.TH.Syntax: data ModuleInfo
+ GHC.Internal.TH.Syntax: data Name
+ GHC.Internal.TH.Syntax: data NameFlavour
+ GHC.Internal.TH.Syntax: data NameIs
+ GHC.Internal.TH.Syntax: data NameSpace
+ GHC.Internal.TH.Syntax: data NamespaceSpecifier
+ GHC.Internal.TH.Syntax: data Overlap
+ GHC.Internal.TH.Syntax: data Pat
+ GHC.Internal.TH.Syntax: data PatSynArgs
+ GHC.Internal.TH.Syntax: data PatSynDir
+ GHC.Internal.TH.Syntax: data Phases
+ GHC.Internal.TH.Syntax: data Pragma
+ GHC.Internal.TH.Syntax: data Range
+ GHC.Internal.TH.Syntax: data Role
+ GHC.Internal.TH.Syntax: data RuleBndr
+ GHC.Internal.TH.Syntax: data RuleMatch
+ GHC.Internal.TH.Syntax: data Safety
+ GHC.Internal.TH.Syntax: data SourceStrictness
+ GHC.Internal.TH.Syntax: data SourceUnpackedness
+ GHC.Internal.TH.Syntax: data Specificity
+ GHC.Internal.TH.Syntax: data Stmt
+ GHC.Internal.TH.Syntax: data TyLit
+ GHC.Internal.TH.Syntax: data TySynEqn
+ GHC.Internal.TH.Syntax: data TyVarBndr flag
+ GHC.Internal.TH.Syntax: data Type
+ GHC.Internal.TH.Syntax: data TypeFamilyHead
+ GHC.Internal.TH.Syntax: defaultFixity :: Fixity
+ GHC.Internal.TH.Syntax: eqBytes :: Bytes -> Bytes -> Bool
+ GHC.Internal.TH.Syntax: extsEnabled :: Q [Extension]
+ GHC.Internal.TH.Syntax: getDoc :: DocLoc -> Q (Maybe String)
+ GHC.Internal.TH.Syntax: getPackageRoot :: Q FilePath
+ GHC.Internal.TH.Syntax: getQ :: Typeable a => Q (Maybe a)
+ GHC.Internal.TH.Syntax: get_cons_names :: Con -> [Name]
+ GHC.Internal.TH.Syntax: hoistCode :: Monad m => (forall x. () => m x -> n x) -> Code m a -> Code n a
+ GHC.Internal.TH.Syntax: instance Control.Monad.Fail.MonadFail GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance Control.Monad.Fix.MonadFix GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance Control.Monad.IO.Class.MonadIO GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.AnnLookup
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.AnnTarget
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Bang
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.BndrVis
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Body
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Bytes
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Callconv
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Clause
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Con
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Dec
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.DecidedStrictness
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.DerivClause
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.DerivStrategy
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.DocLoc
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Exp
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.FamilyResultSig
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Fixity
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.FixityDirection
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Foreign
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.FunDep
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Guard
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Info
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.InjectivityAnn
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Inline
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Lit
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Loc
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Match
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.ModName
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Module
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.ModuleInfo
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Name
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.NameFlavour
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.NameSpace
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.NamespaceSpecifier
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.OccName
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Overlap
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Pat
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.PatSynArgs
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.PatSynDir
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Phases
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.PkgName
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Pragma
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Range
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Role
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.RuleBndr
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.RuleMatch
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Safety
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Specificity
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Stmt
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.TyLit
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.TySynEqn
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.Type
+ GHC.Internal.TH.Syntax: instance Data.Data.Data GHC.Internal.TH.Syntax.TypeFamilyHead
+ GHC.Internal.TH.Syntax: instance Data.Data.Data flag => Data.Data.Data (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ GHC.Internal.TH.Syntax: instance Data.Foldable.Foldable GHC.Internal.TH.Syntax.TyVarBndr
+ GHC.Internal.TH.Syntax: instance Data.Traversable.Traversable GHC.Internal.TH.Syntax.TyVarBndr
+ GHC.Internal.TH.Syntax: instance GHC.Base.Applicative GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance GHC.Base.Functor GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance GHC.Base.Functor GHC.Internal.TH.Syntax.TyVarBndr
+ GHC.Internal.TH.Syntax: instance GHC.Base.Monad GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance GHC.Base.Monoid a => GHC.Base.Monoid (GHC.Internal.TH.Syntax.Q a)
+ GHC.Internal.TH.Syntax: instance GHC.Base.Semigroup a => GHC.Base.Semigroup (GHC.Internal.TH.Syntax.Q a)
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.AnnLookup
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.AnnTarget
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Bang
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.BndrVis
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Body
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Bytes
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Callconv
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Clause
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Con
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Dec
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.DecidedStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.DerivClause
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.DerivStrategy
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.DocLoc
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Exp
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.FamilyResultSig
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Fixity
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.FixityDirection
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Foreign
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.FunDep
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Guard
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Info
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.InjectivityAnn
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Inline
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Lit
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Loc
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Match
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.ModName
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Module
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.ModuleInfo
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Name
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.NameFlavour
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.NameSpace
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.NamespaceSpecifier
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.OccName
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Overlap
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Pat
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.PatSynArgs
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.PatSynDir
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Phases
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.PkgName
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Pragma
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Range
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Role
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.RuleBndr
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.RuleMatch
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Safety
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.SourceStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Specificity
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Stmt
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.TyLit
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.TySynEqn
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.Type
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq GHC.Internal.TH.Syntax.TypeFamilyHead
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Eq flag => GHC.Classes.Eq (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.AnnLookup
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.AnnTarget
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Bang
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.BndrVis
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Body
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Bytes
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Callconv
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Clause
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Con
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Dec
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.DecidedStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.DerivClause
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.DerivStrategy
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.DocLoc
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Exp
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.FamilyResultSig
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Fixity
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.FixityDirection
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Foreign
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.FunDep
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Guard
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Info
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.InjectivityAnn
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Inline
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Lit
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Loc
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Match
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.ModName
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Module
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.ModuleInfo
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Name
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.NameFlavour
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.NameSpace
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.NamespaceSpecifier
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.OccName
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Overlap
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Pat
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.PatSynArgs
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.PatSynDir
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Phases
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.PkgName
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Pragma
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Range
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Role
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.RuleBndr
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.RuleMatch
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Safety
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.SourceStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Specificity
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Stmt
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.TyLit
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.TySynEqn
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.Type
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord GHC.Internal.TH.Syntax.TypeFamilyHead
+ GHC.Internal.TH.Syntax: instance GHC.Classes.Ord flag => GHC.Classes.Ord (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.AnnLookup
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.AnnTarget
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Bang
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.BndrVis
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Body
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Bytes
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Callconv
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Clause
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Con
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Dec
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.DecidedStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.DerivClause
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.DerivStrategy
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.DocLoc
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Exp
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.FamilyResultSig
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Fixity
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.FixityDirection
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Foreign
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.FunDep
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Guard
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Info
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.InjectivityAnn
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Inline
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Lit
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Loc
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Match
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.ModName
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Module
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.ModuleInfo
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Name
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.NameFlavour
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.NameSpace
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.NamespaceSpecifier
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.OccName
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Overlap
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Pat
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.PatSynArgs
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.PatSynDir
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Phases
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.PkgName
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Pragma
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Range
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Role
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.RuleBndr
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.RuleMatch
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Safety
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.SourceStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Specificity
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Stmt
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.TyLit
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.TySynEqn
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.Type
+ GHC.Internal.TH.Syntax: instance GHC.Generics.Generic GHC.Internal.TH.Syntax.TypeFamilyHead
+ GHC.Internal.TH.Syntax: instance GHC.Internal.TH.Syntax.Quasi GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance GHC.Internal.TH.Syntax.Quasi GHC.Types.IO
+ GHC.Internal.TH.Syntax: instance GHC.Internal.TH.Syntax.Quote GHC.Internal.TH.Syntax.Q
+ GHC.Internal.TH.Syntax: instance GHC.Internal.TH.Syntax.Quote GHC.Types.IO
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.AnnLookup
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.AnnTarget
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Bang
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.BndrVis
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Body
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Bytes
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Callconv
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Clause
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Con
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Dec
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.DecidedStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.DerivClause
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.DerivStrategy
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.DocLoc
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Exp
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.FamilyResultSig
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Fixity
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.FixityDirection
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Foreign
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.FunDep
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Guard
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Info
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.InjectivityAnn
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Inline
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Lit
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Loc
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Match
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.ModName
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Module
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.ModuleInfo
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Name
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.NameFlavour
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.NameSpace
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.NamespaceSpecifier
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.OccName
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Overlap
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Pat
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.PatSynArgs
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.PatSynDir
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Phases
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.PkgName
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Pragma
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Range
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Role
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.RuleBndr
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.RuleMatch
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Safety
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.SourceStrictness
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Specificity
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Stmt
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.TyLit
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.TySynEqn
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.Type
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show GHC.Internal.TH.Syntax.TypeFamilyHead
+ GHC.Internal.TH.Syntax: instance GHC.Show.Show flag => GHC.Show.Show (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ GHC.Internal.TH.Syntax: isExtEnabled :: Extension -> Q Bool
+ GHC.Internal.TH.Syntax: isInstance :: Name -> [Type] -> Q Bool
+ GHC.Internal.TH.Syntax: joinCode :: Monad m => m (Code m a) -> Code m a
+ GHC.Internal.TH.Syntax: liftCode :: forall a m. m (TExp a) -> Code m a
+ GHC.Internal.TH.Syntax: location :: Q Loc
+ GHC.Internal.TH.Syntax: lookupName :: Bool -> String -> Q (Maybe Name)
+ GHC.Internal.TH.Syntax: lookupTypeName :: String -> Q (Maybe Name)
+ GHC.Internal.TH.Syntax: lookupValueName :: String -> Q (Maybe Name)
+ GHC.Internal.TH.Syntax: manyName :: Name
+ GHC.Internal.TH.Syntax: maxPrecedence :: Int
+ GHC.Internal.TH.Syntax: memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt
+ GHC.Internal.TH.Syntax: mkModName :: String -> ModName
+ GHC.Internal.TH.Syntax: mkName :: String -> Name
+ GHC.Internal.TH.Syntax: mkNameG :: NameSpace -> String -> String -> String -> Name
+ GHC.Internal.TH.Syntax: mkNameG_d :: String -> String -> String -> Name
+ GHC.Internal.TH.Syntax: mkNameG_fld :: String -> String -> String -> String -> Name
+ GHC.Internal.TH.Syntax: mkNameG_tc :: String -> String -> String -> Name
+ GHC.Internal.TH.Syntax: mkNameG_v :: String -> String -> String -> Name
+ GHC.Internal.TH.Syntax: mkNameL :: String -> Uniq -> Name
+ GHC.Internal.TH.Syntax: mkNameQ :: String -> String -> Name
+ GHC.Internal.TH.Syntax: mkNameS :: String -> Name
+ GHC.Internal.TH.Syntax: mkNameU :: String -> Uniq -> Name
+ GHC.Internal.TH.Syntax: mkOccName :: String -> OccName
+ GHC.Internal.TH.Syntax: mkPkgName :: String -> PkgName
+ GHC.Internal.TH.Syntax: mk_tup_name :: Int -> NameSpace -> Bool -> Name
+ GHC.Internal.TH.Syntax: modString :: ModName -> String
+ GHC.Internal.TH.Syntax: nameBase :: Name -> String
+ GHC.Internal.TH.Syntax: nameModule :: Name -> Maybe String
+ GHC.Internal.TH.Syntax: namePackage :: Name -> Maybe String
+ GHC.Internal.TH.Syntax: nameSpace :: Name -> Maybe NameSpace
+ GHC.Internal.TH.Syntax: newDeclarationGroup :: Q [Dec]
+ GHC.Internal.TH.Syntax: newName :: Quote m => String -> m Name
+ GHC.Internal.TH.Syntax: newNameIO :: String -> IO Name
+ GHC.Internal.TH.Syntax: newtype Code (m :: Type -> Type) (a :: TYPE r)
+ GHC.Internal.TH.Syntax: newtype ModName
+ GHC.Internal.TH.Syntax: newtype OccName
+ GHC.Internal.TH.Syntax: newtype PkgName
+ GHC.Internal.TH.Syntax: newtype Q a
+ GHC.Internal.TH.Syntax: newtype TExp (a :: TYPE r)
+ GHC.Internal.TH.Syntax: occString :: OccName -> String
+ GHC.Internal.TH.Syntax: oneName :: Name
+ GHC.Internal.TH.Syntax: pkgString :: PkgName -> String
+ GHC.Internal.TH.Syntax: putDoc :: DocLoc -> String -> Q ()
+ GHC.Internal.TH.Syntax: putQ :: Typeable a => a -> Q ()
+ GHC.Internal.TH.Syntax: qAddCorePlugin :: Quasi m => String -> m ()
+ GHC.Internal.TH.Syntax: qAddDependentFile :: Quasi m => FilePath -> m ()
+ GHC.Internal.TH.Syntax: qAddForeignFilePath :: Quasi m => ForeignSrcLang -> String -> m ()
+ GHC.Internal.TH.Syntax: qAddModFinalizer :: Quasi m => Q () -> m ()
+ GHC.Internal.TH.Syntax: qAddTempFile :: Quasi m => String -> m FilePath
+ GHC.Internal.TH.Syntax: qAddTopDecls :: Quasi m => [Dec] -> m ()
+ GHC.Internal.TH.Syntax: qExtsEnabled :: Quasi m => m [Extension]
+ GHC.Internal.TH.Syntax: qGetDoc :: Quasi m => DocLoc -> m (Maybe String)
+ GHC.Internal.TH.Syntax: qGetPackageRoot :: Quasi m => m FilePath
+ GHC.Internal.TH.Syntax: qGetQ :: (Quasi m, Typeable a) => m (Maybe a)
+ GHC.Internal.TH.Syntax: qIsExtEnabled :: Quasi m => Extension -> m Bool
+ GHC.Internal.TH.Syntax: qLocation :: Quasi m => m Loc
+ GHC.Internal.TH.Syntax: qLookupName :: Quasi m => Bool -> String -> m (Maybe Name)
+ GHC.Internal.TH.Syntax: qNewName :: Quasi m => String -> m Name
+ GHC.Internal.TH.Syntax: qPutDoc :: Quasi m => DocLoc -> String -> m ()
+ GHC.Internal.TH.Syntax: qPutQ :: (Quasi m, Typeable a) => a -> m ()
+ GHC.Internal.TH.Syntax: qRecover :: Quasi m => m a -> m a -> m a
+ GHC.Internal.TH.Syntax: qReify :: Quasi m => Name -> m Info
+ GHC.Internal.TH.Syntax: qReifyAnnotations :: (Quasi m, Data a) => AnnLookup -> m [a]
+ GHC.Internal.TH.Syntax: qReifyConStrictness :: Quasi m => Name -> m [DecidedStrictness]
+ GHC.Internal.TH.Syntax: qReifyFixity :: Quasi m => Name -> m (Maybe Fixity)
+ GHC.Internal.TH.Syntax: qReifyInstances :: Quasi m => Name -> [Type] -> m [Dec]
+ GHC.Internal.TH.Syntax: qReifyModule :: Quasi m => Module -> m ModuleInfo
+ GHC.Internal.TH.Syntax: qReifyRoles :: Quasi m => Name -> m [Role]
+ GHC.Internal.TH.Syntax: qReifyType :: Quasi m => Name -> m Type
+ GHC.Internal.TH.Syntax: qReport :: Quasi m => Bool -> String -> m ()
+ GHC.Internal.TH.Syntax: qRunIO :: Quasi m => IO a -> m a
+ GHC.Internal.TH.Syntax: recover :: Q a -> Q a -> Q a
+ GHC.Internal.TH.Syntax: reify :: Name -> Q Info
+ GHC.Internal.TH.Syntax: reifyAnnotations :: Data a => AnnLookup -> Q [a]
+ GHC.Internal.TH.Syntax: reifyConStrictness :: Name -> Q [DecidedStrictness]
+ GHC.Internal.TH.Syntax: reifyFixity :: Name -> Q (Maybe Fixity)
+ GHC.Internal.TH.Syntax: reifyInstances :: Name -> [Type] -> Q [InstanceDec]
+ GHC.Internal.TH.Syntax: reifyModule :: Module -> Q ModuleInfo
+ GHC.Internal.TH.Syntax: reifyRoles :: Name -> Q [Role]
+ GHC.Internal.TH.Syntax: reifyType :: Name -> Q Type
+ GHC.Internal.TH.Syntax: report :: Bool -> String -> Q ()
+ GHC.Internal.TH.Syntax: reportError :: String -> Q ()
+ GHC.Internal.TH.Syntax: reportWarning :: String -> Q ()
+ GHC.Internal.TH.Syntax: runIO :: IO a -> Q a
+ GHC.Internal.TH.Syntax: runQ :: Quasi m => Q a -> m a
+ GHC.Internal.TH.Syntax: sequenceQ :: Monad m => forall a. () => [m a] -> m [a]
+ GHC.Internal.TH.Syntax: showName :: Name -> String
+ GHC.Internal.TH.Syntax: showName' :: NameIs -> Name -> String
+ GHC.Internal.TH.Syntax: thenCmp :: Ordering -> Ordering -> Ordering
+ GHC.Internal.TH.Syntax: tupleDataName :: Int -> Name
+ GHC.Internal.TH.Syntax: tupleTypeName :: Int -> Name
+ GHC.Internal.TH.Syntax: type Arity = Int
+ GHC.Internal.TH.Syntax: type BangType = (Bang, Type)
+ GHC.Internal.TH.Syntax: type CharPos = (Int, Int)
+ GHC.Internal.TH.Syntax: type Cxt = [Pred]
+ GHC.Internal.TH.Syntax: type FieldExp = (Name, Exp)
+ GHC.Internal.TH.Syntax: type FieldPat = (Name, Pat)
+ GHC.Internal.TH.Syntax: type InstanceDec = Dec
+ GHC.Internal.TH.Syntax: type Kind = Type
+ GHC.Internal.TH.Syntax: type ParentName = Name
+ GHC.Internal.TH.Syntax: type PatSynType = Type
+ GHC.Internal.TH.Syntax: type Pred = Type
+ GHC.Internal.TH.Syntax: type Strict = Bang
+ GHC.Internal.TH.Syntax: type StrictType = BangType
+ GHC.Internal.TH.Syntax: type SumAlt = Int
+ GHC.Internal.TH.Syntax: type SumArity = Int
+ GHC.Internal.TH.Syntax: type Uniq = Integer
+ GHC.Internal.TH.Syntax: type Unlifted = Bool
+ GHC.Internal.TH.Syntax: type VarBangType = (Name, Bang, Type)
+ GHC.Internal.TH.Syntax: type VarStrictType = VarBangType
+ GHC.Internal.TH.Syntax: unTypeCode :: forall a m. Quote m => Code m a -> m Exp
+ GHC.Internal.TH.Syntax: unTypeQ :: forall a m. Quote m => m (TExp a) -> m Exp
+ GHC.Internal.TH.Syntax: unboxedSumDataName :: SumAlt -> SumArity -> Name
+ GHC.Internal.TH.Syntax: unboxedSumTypeName :: SumArity -> Name
+ GHC.Internal.TH.Syntax: unboxedTupleDataName :: Int -> Name
+ GHC.Internal.TH.Syntax: unboxedTupleTypeName :: Int -> Name
+ GHC.Internal.TH.Syntax: unsafeCodeCoerce :: forall a m. Quote m => m Exp -> Code m a
+ GHC.Internal.TH.Syntax: unsafeTExpCoerce :: forall a m. Quote m => m Exp -> m (TExp a)
+ GHC.JS.Ident: instance GHC.Utils.Outputable.Outputable GHC.JS.Ident.Ident
+ GHC.JS.Ident: name :: FastString -> Ident
+ GHC.JS.JStg.Syntax: global :: FastString -> JStgExpr
+ GHC.JS.JStg.Syntax: local :: FastString -> JStgExpr
+ GHC.JS.Make: math_max :: [JStgExpr] -> JStgExpr
+ GHC.JS.Make: math_min :: [JStgExpr] -> JStgExpr
+ GHC.JS.Make: typeOf :: JStgExpr -> JStgExpr
+ GHC.LanguageExtensions: instance Data.Binary.Class.Binary GHC.Internal.LanguageExtensions.Extension
+ GHC.LanguageExtensions.Type: MultilineStrings :: Extension
+ GHC.LanguageExtensions.Type: NamedDefaults :: Extension
+ GHC.LanguageExtensions.Type: OrPatterns :: Extension
+ GHC.Linker.Types: ForeignObject :: LinkableObjectSort
+ GHC.Linker.Types: LazyBCOs :: CompiledByteCode -> [FilePath] -> LinkablePart
+ GHC.Linker.Types: Linkable :: !UTCTime -> !Module -> NonEmpty LinkablePart -> Linkable
+ GHC.Linker.Types: ModuleObject :: LinkableObjectSort
+ GHC.Linker.Types: [linkableParts] :: Linkable -> NonEmpty LinkablePart
+ GHC.Linker.Types: data LinkableObjectSort
+ GHC.Linker.Types: data LinkablePart
+ GHC.Linker.Types: instance GHC.Utils.Outputable.Outputable GHC.Linker.Types.LinkablePart
+ GHC.Linker.Types: isNativeCode :: LinkablePart -> Bool
+ GHC.Linker.Types: isNativeLib :: LinkablePart -> Bool
+ GHC.Linker.Types: linkableBCOs :: Linkable -> [CompiledByteCode]
+ GHC.Linker.Types: linkableFiles :: Linkable -> [FilePath]
+ GHC.Linker.Types: linkableFilterByteCode :: Linkable -> Maybe Linkable
+ GHC.Linker.Types: linkableFilterNative :: Linkable -> Maybe Linkable
+ GHC.Linker.Types: linkableIsNativeCodeOnly :: Linkable -> Bool
+ GHC.Linker.Types: linkableLibs :: Linkable -> [LinkablePart]
+ GHC.Linker.Types: linkableNativeParts :: Linkable -> [LinkablePart]
+ GHC.Linker.Types: linkablePartAllBCOs :: LinkablePart -> [CompiledByteCode]
+ GHC.Linker.Types: linkablePartPath :: LinkablePart -> Maybe FilePath
+ GHC.Linker.Types: linkablePartitionParts :: Linkable -> ([LinkablePart], [LinkablePart])
+ GHC.Linker.Types: partitionLinkables :: [Linkable] -> ([Linkable], [Linkable])
+ GHC.Parser.Annotation: ListBanana :: EpUniToken "(|" "\10631" -> EpUniToken "|)" "\10632" -> AnnListBrackets
+ GHC.Parser.Annotation: ListBraces :: EpToken "{" -> EpToken "}" -> AnnListBrackets
+ GHC.Parser.Annotation: ListNone :: AnnListBrackets
+ GHC.Parser.Annotation: ListParens :: EpToken "(" -> EpToken ")" -> AnnListBrackets
+ GHC.Parser.Annotation: ListSquare :: EpToken "[" -> EpToken "]" -> AnnListBrackets
+ GHC.Parser.Annotation: NameNoAdornment :: NameAdornment
+ GHC.Parser.Annotation: [al_brackets] :: AnnList a -> !AnnListBrackets
+ GHC.Parser.Annotation: [al_semis] :: AnnList a -> [EpToken ";"]
+ GHC.Parser.Annotation: [apr_loc1] :: AnnPragma -> EpaLocation
+ GHC.Parser.Annotation: [apr_loc2] :: AnnPragma -> EpaLocation
+ GHC.Parser.Annotation: [apr_module] :: AnnPragma -> EpToken "module"
+ GHC.Parser.Annotation: [apr_squares] :: AnnPragma -> (EpToken "[", EpToken "]")
+ GHC.Parser.Annotation: [apr_type] :: AnnPragma -> EpToken "type"
+ GHC.Parser.Annotation: [nann_arrow] :: NameAnn -> TokRarrow
+ GHC.Parser.Annotation: [nann_parensh] :: NameAnn -> (EpToken "(#", EpToken "#)")
+ GHC.Parser.Annotation: data AnnListBrackets
+ GHC.Parser.Annotation: getEpTokenLoc :: forall (tok :: Symbol). EpToken tok -> EpaLocation
+ GHC.Parser.Annotation: getEpTokenLocs :: forall (tok :: Symbol). [EpToken tok] -> [EpaLocation]
+ GHC.Parser.Annotation: getEpUniTokenLoc :: forall (tok :: Symbol) (toku :: Symbol). EpUniToken tok toku -> EpaLocation
+ GHC.Parser.Annotation: instance (GHC.Parser.Annotation.NoAnn a, GHC.Parser.Annotation.NoAnn b, GHC.Parser.Annotation.NoAnn c) => GHC.Parser.Annotation.NoAnn (a, b, c)
+ GHC.Parser.Annotation: instance (GHC.Parser.Annotation.NoAnn a, GHC.Parser.Annotation.NoAnn b, GHC.Parser.Annotation.NoAnn c, GHC.Parser.Annotation.NoAnn d) => GHC.Parser.Annotation.NoAnn (a, b, c, d)
+ GHC.Parser.Annotation: instance (GHC.TypeLits.KnownSymbol tok, GHC.TypeLits.KnownSymbol utok) => GHC.Utils.Outputable.Outputable (GHC.Parser.Annotation.EpUniToken tok utok)
+ GHC.Parser.Annotation: instance Data.Data.Data GHC.Parser.Annotation.AnnListBrackets
+ GHC.Parser.Annotation: instance Data.Data.Data a => Data.Data.Data (GHC.Parser.Annotation.AnnList a)
+ GHC.Parser.Annotation: instance GHC.Classes.Eq (GHC.Parser.Annotation.EpUniToken tok utok)
+ GHC.Parser.Annotation: instance GHC.Classes.Eq GHC.Parser.Annotation.AnnListBrackets
+ GHC.Parser.Annotation: instance GHC.Classes.Eq a => GHC.Classes.Eq (GHC.Parser.Annotation.AnnList a)
+ GHC.Parser.Annotation: instance GHC.Parser.Annotation.HasLoc (GHC.Parser.Annotation.EpToken tok)
+ GHC.Parser.Annotation: instance GHC.Parser.Annotation.HasLoc (GHC.Parser.Annotation.EpUniToken tok utok)
+ GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn ()
+ GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn GHC.Types.SourceText.SourceText
+ GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn a => GHC.Parser.Annotation.NoAnn (Data.Either.Either a b)
+ GHC.Parser.Annotation: instance GHC.Parser.Annotation.NoAnn a => GHC.Parser.Annotation.NoAnn (GHC.Parser.Annotation.AnnList a)
+ GHC.Parser.Annotation: instance GHC.TypeLits.KnownSymbol tok => GHC.Utils.Outputable.Outputable (GHC.Parser.Annotation.EpToken tok)
+ GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable GHC.Parser.Annotation.AnnListBrackets
+ GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable GHC.Parser.Annotation.AnnParen
+ GHC.Parser.Annotation: instance GHC.Utils.Outputable.Outputable a => GHC.Utils.Outputable.Outputable (GHC.Parser.Annotation.AnnList a)
+ GHC.Parser.Annotation: listLocation :: [LocatedAn an a] -> EpaLocation
+ GHC.Parser.Annotation: ta_location :: TrailingAnn -> EpaLocation
+ GHC.Parser.Annotation: type LocatedLC = GenLocated SrcSpanAnnLC
+ GHC.Parser.Annotation: type LocatedLI = GenLocated SrcSpanAnnLI
+ GHC.Parser.Annotation: type LocatedLS = GenLocated SrcSpanAnnLS
+ GHC.Parser.Annotation: type LocatedLW = GenLocated SrcSpanAnnLW
+ GHC.Parser.Annotation: type SrcSpanAnnLC = EpAnn AnnList [EpToken ","]
+ GHC.Parser.Annotation: type SrcSpanAnnLI = EpAnn AnnList (EpToken "hiding", [EpToken ","])
+ GHC.Parser.Annotation: type SrcSpanAnnLS = EpAnn AnnList ()
+ GHC.Parser.Annotation: type SrcSpanAnnLW = EpAnn AnnList EpToken "where"
+ GHC.Parser.Annotation: type TokDarrow = EpUniToken "=>" "\8658"
+ GHC.Parser.Annotation: type TokDcolon = EpUniToken "::" "\8759"
+ GHC.Parser.Annotation: type TokForall = EpUniToken "forall" "\8704"
+ GHC.Parser.Annotation: type TokRarrow = EpUniToken "->" "\8594"
+ GHC.Parser.Annotation: widenAnchorT :: forall (tok :: Symbol). EpaLocation -> EpToken tok -> EpaLocation
+ GHC.Parser.Annotation: widenLocatedAnL :: EpAnn an -> [EpaLocation] -> EpAnn an
+ GHC.Parser.Annotation: widenSpanL :: SrcSpan -> [EpaLocation] -> SrcSpan
+ GHC.Parser.Annotation: widenSpanT :: forall (tok :: Symbol). SrcSpan -> EpToken tok -> SrcSpan
+ GHC.Parser.Errors.Types: PETS_ConstraintContext :: !LocatedA (PatBuilder GhcPs) -> PsErrTypeSyntaxDetails
+ GHC.Parser.Errors.Types: PETS_ForallTelescope :: !HsForAllTelescope GhcPs -> !LocatedA (PatBuilder GhcPs) -> PsErrTypeSyntaxDetails
+ GHC.Parser.Errors.Types: PETS_FunctionArrow :: !LocatedA (PatBuilder GhcPs) -> !HsArrowOf (LocatedA (PatBuilder GhcPs)) GhcPs -> !LocatedA (PatBuilder GhcPs) -> PsErrTypeSyntaxDetails
+ GHC.Parser.Errors.Types: PETS_Multiplicity :: !EpToken "%" -> !LocatedA (PatBuilder GhcPs) -> PsErrTypeSyntaxDetails
+ GHC.Parser.Errors.Types: PsErrIllegalOrPat :: LPat GhcPs -> PsMessage
+ GHC.Parser.Errors.Types: PsErrOrPatInExpr :: !LPat GhcPs -> PsMessage
+ GHC.Parser.Errors.Types: PsErrTypeSyntaxInPat :: !PsErrTypeSyntaxDetails -> PsMessage
+ GHC.Parser.Errors.Types: PsWarnViewPatternSignatures :: !LPat GhcPs -> !LPat GhcPs -> PsMessage
+ GHC.Parser.Errors.Types: data PsErrTypeSyntaxDetails
+ GHC.Parser.Lexer: ITstringMulti :: SourceText -> FastString -> Token
+ GHC.Parser.Lexer: MultilineStringsBit :: ExtBits
+ GHC.Parser.Lexer: OrPatternsBit :: ExtBits
+ GHC.Parser.Lexer: RequiredTypeArgumentsBit :: ExtBits
+ GHC.Parser.Lexer: ViewPatternsBit :: ExtBits
+ GHC.Parser.Lexer: getParserOpts :: MonadP m => m ParserOpts
+ GHC.Parser.Lexer: instance GHC.Show.Show GHC.Parser.Lexer.AlexInput
+ GHC.Parser.Lexer: mkParensEpToks :: RealSrcSpan -> (EpToken "(", EpToken ")")
+ GHC.Parser.Lexer: mkParensLocs :: RealSrcSpan -> (EpaLocation, EpaLocation)
+ GHC.Parser.PostProcess: [ArrowIsFunType] :: forall lhs. ArrowParsingMode lhs lhs
+ GHC.Parser.PostProcess: [ArrowIsViewPat] :: forall rhs. ArrowParsingMode (HsExpr GhcPs) rhs
+ GHC.Parser.PostProcess: checkContextPV :: DisambECP b => LocatedA b -> PV (LocatedC [LocatedA b])
+ GHC.Parser.PostProcess: data ArrowParsingMode lhs rhs
+ GHC.Parser.PostProcess: ecpFromPat :: LPat GhcPs -> ECP
+ GHC.Parser.PostProcess: ecpFromPat' :: DisambECP b => LPat GhcPs -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsArrowPV :: DisambECP b => SrcSpan -> ArrowParsingMode lhs b -> LocatedA lhs -> HsArrowOf (LocatedA b) GhcPs -> LocatedA b -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsForallPV :: DisambECP b => SrcSpan -> HsForAllTelescope GhcPs -> LocatedA b -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsMultPV :: DisambECP b => EpToken "%" -> LocatedA b -> PV (TokRarrow -> HsArrowOf (LocatedA b) GhcPs)
+ GHC.Parser.PostProcess: mkMDo :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs
+ GHC.Parser.PostProcess: mkQualPV :: DisambECP b => SrcSpan -> LocatedC [LocatedA b] -> LocatedA b -> PV (LocatedA b)
+ GHC.Parser.PostProcess: setTelescopeBndrsNameSpace :: NameSpace -> HsForAllTelescope GhcPs -> HsForAllTelescope GhcPs
+ GHC.Parser.PostProcess: withArrowParsingMode :: DisambECP b => (forall lhs. DisambECP lhs => ArrowParsingMode lhs b -> PV r) -> PV r
+ GHC.Parser.PostProcess: withArrowParsingMode' :: DisambECP b => (forall lhs. DisambECP lhs => ArrowParsingMode lhs b -> PV (LocatedA b)) -> PV (LocatedA b)
+ GHC.Parser.PostProcess.Haddock: instance GHC.Parser.PostProcess.Haddock.HasHaddock (GHC.Parser.Annotation.LocatedLI [GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.ImpExp.IE GHC.Hs.Extension.GhcPs)])
+ GHC.Parser.String: StringLexError :: LexErr -> BufPos -> StringLexError
+ GHC.Parser.String: data StringLexError
+ GHC.Parser.String: instance GHC.Parser.String.HasChar (GHC.Types.Char, x)
+ GHC.Parser.String: instance GHC.Parser.String.HasChar GHC.Types.Char
+ GHC.Parser.String: isDoubleSmartQuote :: Char -> Bool
+ GHC.Parser.String: isSingleSmartQuote :: Char -> Bool
+ GHC.Parser.String: lexMultilineString :: Int -> StringBuffer -> Either StringLexError String
+ GHC.Parser.String: lexString :: Int -> StringBuffer -> Either StringLexError String
+ GHC.Platform: [platformMisc_targetRTSLinkerOnlySupportsSharedLibs] :: PlatformMisc -> Bool
+ GHC.Platform: isPPC :: Arch -> Bool
+ GHC.Platform.ArchOS: isPPC :: Arch -> Bool
+ GHC.Platform.Reg: VirtualRegV128 :: {-# UNPACK #-} !Unique -> VirtualReg
+ GHC.Platform.Reg: [virtualRegUnique] :: VirtualReg -> {-# UNPACK #-} !Unique
+ GHC.Platform.Reg.Class: NoVectors :: RegArch
+ GHC.Platform.Reg.Class: RegClass :: Int -> RegClass
+ GHC.Platform.Reg.Class: Separate :: RegArch
+ GHC.Platform.Reg.Class: Unified :: RegArch
+ GHC.Platform.Reg.Class: data RegArch
+ GHC.Platform.Reg.Class: instance GHC.Classes.Eq GHC.Platform.Reg.Class.RegArch
+ GHC.Platform.Reg.Class: instance GHC.Classes.Ord GHC.Platform.Reg.Class.RegArch
+ GHC.Platform.Reg.Class: instance GHC.Classes.Ord GHC.Platform.Reg.Class.RegClass
+ GHC.Platform.Reg.Class: instance GHC.Show.Show GHC.Platform.Reg.Class.RegArch
+ GHC.Platform.Reg.Class: instance GHC.Show.Show GHC.Platform.Reg.Class.RegClass
+ GHC.Platform.Reg.Class: instance GHC.Utils.Outputable.Outputable GHC.Platform.Reg.Class.RegArch
+ GHC.Platform.Reg.Class: newtype RegClass
+ GHC.Platform.Reg.Class: registerArch :: Arch -> RegArch
+ GHC.Platform.Reg.Class.NoVectors: allRegClasses :: [RegClass]
+ GHC.Platform.Reg.Class.NoVectors: data RegClass
+ GHC.Platform.Reg.Class.NoVectors: pattern RcFloat :: RegClass
+ GHC.Platform.Reg.Class.NoVectors: pattern RcInteger :: RegClass
+ GHC.Platform.Reg.Class.NoVectors: pprRegClass :: RegClass -> SDoc
+ GHC.Platform.Reg.Class.Separate: allRegClasses :: [RegClass]
+ GHC.Platform.Reg.Class.Separate: data RegClass
+ GHC.Platform.Reg.Class.Separate: pattern RcFloat :: RegClass
+ GHC.Platform.Reg.Class.Separate: pattern RcInteger :: RegClass
+ GHC.Platform.Reg.Class.Separate: pattern RcVector :: RegClass
+ GHC.Platform.Reg.Class.Separate: pprRegClass :: RegClass -> SDoc
+ GHC.Platform.Reg.Class.Unified: allRegClasses :: [RegClass]
+ GHC.Platform.Reg.Class.Unified: data RegClass
+ GHC.Platform.Reg.Class.Unified: pattern RcFloatOrVector :: RegClass
+ GHC.Platform.Reg.Class.Unified: pattern RcInteger :: RegClass
+ GHC.Platform.Reg.Class.Unified: pprRegClass :: RegClass -> SDoc
+ GHC.Runtime.Interpreter.Types: ExtWasm :: !WasmInterp -> ExtInterp
+ GHC.Runtime.Interpreter.Types: WasmInterpConfig :: !FilePath -> FilePath -> ![String] -> !Platform -> !Bool -> !String -> !UnitState -> WasmInterpConfig
+ GHC.Runtime.Interpreter.Types: [interpLock] :: InterpProcess -> !MVar ()
+ GHC.Runtime.Interpreter.Types: [wasmInterpDyLD] :: WasmInterpConfig -> !FilePath
+ GHC.Runtime.Interpreter.Types: [wasmInterpHsSoSuffix] :: WasmInterpConfig -> !String
+ GHC.Runtime.Interpreter.Types: [wasmInterpLibDir] :: WasmInterpConfig -> FilePath
+ GHC.Runtime.Interpreter.Types: [wasmInterpOpts] :: WasmInterpConfig -> ![String]
+ GHC.Runtime.Interpreter.Types: [wasmInterpProfiled] :: WasmInterpConfig -> !Bool
+ GHC.Runtime.Interpreter.Types: [wasmInterpTargetPlatform] :: WasmInterpConfig -> !Platform
+ GHC.Runtime.Interpreter.Types: [wasmInterpUnitState] :: WasmInterpConfig -> !UnitState
+ GHC.Runtime.Interpreter.Types: data WasmInterpConfig
+ GHC.Runtime.Interpreter.Types: type WasmInterp = ExtInterpState WasmInterpConfig ()
+ GHC.Settings: [platformMisc_targetRTSLinkerOnlySupportsSharedLibs] :: PlatformMisc -> Bool
+ GHC.Settings: sTargetRTSLinkerOnlySupportsSharedLibs :: Settings -> Bool
+ GHC.Settings.Utils: getGlobalPackageDb :: FilePath -> RawSettings -> Either String FilePath
+ GHC.Stg.Syntax: JumpedTo :: UpdateFlag
+ GHC.Stg.Syntax: instance GHC.Classes.Eq GHC.Stg.Syntax.UpdateFlag
+ GHC.Stg.Syntax: instance GHC.Show.Show GHC.Stg.Syntax.UpdateFlag
+ GHC.StgToCmm.CgUtils: baseRegOffset :: Platform -> GlobalReg -> Int
+ GHC.StgToCmm.CgUtils: fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl
+ GHC.StgToCmm.CgUtils: get_GlobalReg_addr :: Platform -> GlobalReg -> CmmExpr
+ GHC.StgToCmm.CgUtils: get_Regtable_addr_from_offset :: Platform -> Int -> CmmExpr
+ GHC.StgToCmm.CgUtils: regTableOffset :: Platform -> Int -> CmmExpr
+ GHC.StgToCmm.CgUtils: type CgStream = Stream UniqDSMT IO
+ GHC.StgToCmm.Config: [stgToCmmAllowArith64] :: StgToCmmConfig -> !Bool
+ GHC.StgToCmm.Config: [stgToCmmAllowQuot64] :: StgToCmmConfig -> !Bool
+ GHC.StgToCmm.Config: [stgToCmmObjectDeterminism] :: StgToCmmConfig -> !Bool
+ GHC.StgToJS.Symbols: apply :: FastString
+ GHC.StgToJS.Symbols: arguments :: JStgExpr
+ GHC.StgToJS.Symbols: argumentsStr :: FastString
+ GHC.StgToJS.Symbols: arr :: FastString
+ GHC.StgToJS.Symbols: ccStr :: FastString
+ GHC.StgToJS.Symbols: console :: JStgExpr
+ GHC.StgToJS.Symbols: consoleStr :: FastString
+ GHC.StgToJS.Symbols: d1 :: JStgExpr
+ GHC.StgToJS.Symbols: d1Str :: FastString
+ GHC.StgToJS.Symbols: d2 :: JStgExpr
+ GHC.StgToJS.Symbols: d2Str :: FastString
+ GHC.StgToJS.Symbols: d3 :: JStgExpr
+ GHC.StgToJS.Symbols: d3Str :: FastString
+ GHC.StgToJS.Symbols: dv :: FastString
+ GHC.StgToJS.Symbols: excepStr :: FastString
+ GHC.StgToJS.Symbols: except :: JStgExpr
+ GHC.StgToJS.Symbols: exceptStr :: Ident
+ GHC.StgToJS.Symbols: f :: FastString
+ GHC.StgToJS.Symbols: f3 :: FastString
+ GHC.StgToJS.Symbols: f6 :: FastString
+ GHC.StgToJS.Symbols: getFloat32 :: FastString
+ GHC.StgToJS.Symbols: getFloat64 :: FastString
+ GHC.StgToJS.Symbols: getInt16 :: FastString
+ GHC.StgToJS.Symbols: getInt32 :: FastString
+ GHC.StgToJS.Symbols: getUint16 :: FastString
+ GHC.StgToJS.Symbols: getUint32 :: FastString
+ GHC.StgToJS.Symbols: ghcjsArray :: FastString
+ GHC.StgToJS.Symbols: hasOwnProperty :: FastString
+ GHC.StgToJS.Symbols: hd :: JStgExpr
+ GHC.StgToJS.Symbols: hdAp00 :: JStgExpr
+ GHC.StgToJS.Symbols: hdAp00FastStr :: FastString
+ GHC.StgToJS.Symbols: hdAp00Str :: Ident
+ GHC.StgToJS.Symbols: hdAp10 :: JStgExpr
+ GHC.StgToJS.Symbols: hdAp11Fast :: FastString
+ GHC.StgToJS.Symbols: hdAp1EntryStr :: Ident
+ GHC.StgToJS.Symbols: hdAp22FastStr :: FastString
+ GHC.StgToJS.Symbols: hdAp2EntryStr :: Ident
+ GHC.StgToJS.Symbols: hdAp33FastStr :: FastString
+ GHC.StgToJS.Symbols: hdAp3EntryStr :: Ident
+ GHC.StgToJS.Symbols: hdApGen :: JStgExpr
+ GHC.StgToJS.Symbols: hdApGenFastStr :: Ident
+ GHC.StgToJS.Symbols: hdApGenStr :: Ident
+ GHC.StgToJS.Symbols: hdApply :: JStgExpr
+ GHC.StgToJS.Symbols: hdApplyStr :: FastString
+ GHC.StgToJS.Symbols: hdAtomicModifyMutVar2Str :: FastString
+ GHC.StgToJS.Symbols: hdAtomicModifyMutVarStr :: FastString
+ GHC.StgToJS.Symbols: hdAtomicallyEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdAtomicallyEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdAtomicallyStr :: FastString
+ GHC.StgToJS.Symbols: hdB :: ByteString
+ GHC.StgToJS.Symbols: hdBSwap64Str :: FastString
+ GHC.StgToJS.Symbols: hdBh :: JStgExpr
+ GHC.StgToJS.Symbols: hdBhStr :: FastString
+ GHC.StgToJS.Symbols: hdBlackHole :: JStgExpr
+ GHC.StgToJS.Symbols: hdBlackHoleLNE :: JStgExpr
+ GHC.StgToJS.Symbols: hdBlackHoleLNEStr :: Ident
+ GHC.StgToJS.Symbols: hdBlackHoleStr :: Ident
+ GHC.StgToJS.Symbols: hdBlackHoleTrap :: JStgExpr
+ GHC.StgToJS.Symbols: hdBlackHoleTrapStr :: Ident
+ GHC.StgToJS.Symbols: hdBlockOnBlackHoleStr :: FastString
+ GHC.StgToJS.Symbols: hdBuildCCSPtrStr :: FastString
+ GHC.StgToJS.Symbols: hdBuildObject :: JStgExpr
+ GHC.StgToJS.Symbols: hdBuildObjectStr :: FastString
+ GHC.StgToJS.Symbols: hdC :: JStgExpr
+ GHC.StgToJS.Symbols: hdC0 :: JStgExpr
+ GHC.StgToJS.Symbols: hdC0Str :: Ident
+ GHC.StgToJS.Symbols: hdCAFsResetStr :: Ident
+ GHC.StgToJS.Symbols: hdCAFsStr :: Ident
+ GHC.StgToJS.Symbols: hdCSel :: JStgExpr
+ GHC.StgToJS.Symbols: hdCSelStr :: FastString
+ GHC.StgToJS.Symbols: hdCStr :: Ident
+ GHC.StgToJS.Symbols: hdCallDynamicStr :: FastString
+ GHC.StgToJS.Symbols: hdCastDoubleToWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdCastFloatToWord32Str :: FastString
+ GHC.StgToJS.Symbols: hdCastWord32ToFloatStr :: FastString
+ GHC.StgToJS.Symbols: hdCastWord64ToDoubleStr :: FastString
+ GHC.StgToJS.Symbols: hdCatchEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdCatchStmStr :: FastString
+ GHC.StgToJS.Symbols: hdCatchStr :: FastString
+ GHC.StgToJS.Symbols: hdCheckObj :: JStgExpr
+ GHC.StgToJS.Symbols: hdCheckOverlapByteArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdClearCCSStr :: FastString
+ GHC.StgToJS.Symbols: hdClosureTypeName :: JStgExpr
+ GHC.StgToJS.Symbols: hdClosureTypeNameStr :: Ident
+ GHC.StgToJS.Symbols: hdClz16Str :: FastString
+ GHC.StgToJS.Symbols: hdClz32Str :: FastString
+ GHC.StgToJS.Symbols: hdClz64Str :: FastString
+ GHC.StgToJS.Symbols: hdClz8Str :: FastString
+ GHC.StgToJS.Symbols: hdCollectProps :: FastString
+ GHC.StgToJS.Symbols: hdCompactAdd :: FastString
+ GHC.StgToJS.Symbols: hdCompactAddWithSharing :: FastString
+ GHC.StgToJS.Symbols: hdCompactAllocateBlock :: FastString
+ GHC.StgToJS.Symbols: hdCompactContains :: FastString
+ GHC.StgToJS.Symbols: hdCompactContainsAny :: FastString
+ GHC.StgToJS.Symbols: hdCompactFixupPointers :: FastString
+ GHC.StgToJS.Symbols: hdCompactGetFirstBlock :: FastString
+ GHC.StgToJS.Symbols: hdCompactGetNextBlock :: FastString
+ GHC.StgToJS.Symbols: hdCompactNew :: FastString
+ GHC.StgToJS.Symbols: hdCompactResize :: FastString
+ GHC.StgToJS.Symbols: hdCompactSize :: FastString
+ GHC.StgToJS.Symbols: hdCompareByteArraysStr :: FastString
+ GHC.StgToJS.Symbols: hdComparePointerStr :: FastString
+ GHC.StgToJS.Symbols: hdCopyMutableArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdCopyMutableByteArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdCtBlackhole :: Ident
+ GHC.StgToJS.Symbols: hdCtCon :: Ident
+ GHC.StgToJS.Symbols: hdCtFun :: Ident
+ GHC.StgToJS.Symbols: hdCtPap :: Ident
+ GHC.StgToJS.Symbols: hdCtStackFrame :: Ident
+ GHC.StgToJS.Symbols: hdCtThunk :: Ident
+ GHC.StgToJS.Symbols: hdCtVtPtr :: Ident
+ GHC.StgToJS.Symbols: hdCtz16Str :: FastString
+ GHC.StgToJS.Symbols: hdCtz32Str :: FastString
+ GHC.StgToJS.Symbols: hdCtz64Str :: FastString
+ GHC.StgToJS.Symbols: hdCtz8Str :: FastString
+ GHC.StgToJS.Symbols: hdCurrentThread :: JStgExpr
+ GHC.StgToJS.Symbols: hdCurrentThreadStr :: Ident
+ GHC.StgToJS.Symbols: hdDStr :: FastString
+ GHC.StgToJS.Symbols: hdData1Entry :: Ident
+ GHC.StgToJS.Symbols: hdData2Entry :: Ident
+ GHC.StgToJS.Symbols: hdDataToTagEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdDeRefStablePtr :: FastString
+ GHC.StgToJS.Symbols: hdDebugAllocNotifyAlloc :: FastString
+ GHC.StgToJS.Symbols: hdDecodeDouble2IntStr :: FastString
+ GHC.StgToJS.Symbols: hdDecodeDoubleInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdDecodeFloatIntStr :: FastString
+ GHC.StgToJS.Symbols: hdDelayThread :: FastString
+ GHC.StgToJS.Symbols: hdDiStr :: FastString
+ GHC.StgToJS.Symbols: hdDone :: Ident
+ GHC.StgToJS.Symbols: hdDoneMain :: JStgExpr
+ GHC.StgToJS.Symbols: hdDoneMainEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdDoneMainEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdDumpRes :: JStgExpr
+ GHC.StgToJS.Symbols: hdDumpResStr :: Ident
+ GHC.StgToJS.Symbols: hdEncodeModifiedUtf8Str :: FastString
+ GHC.StgToJS.Symbols: hdEntry :: Ident
+ GHC.StgToJS.Symbols: hdEntryStr :: FastString
+ GHC.StgToJS.Symbols: hdExitProcess :: FastString
+ GHC.StgToJS.Symbols: hdFalseEntry :: Ident
+ GHC.StgToJS.Symbols: hdFinalizeWeak :: FastString
+ GHC.StgToJS.Symbols: hdFinishedThread :: FastString
+ GHC.StgToJS.Symbols: hdFlushStdout :: JStgExpr
+ GHC.StgToJS.Symbols: hdFlushStdoutEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdFlushStdoutEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdFlushStdoutStr :: Ident
+ GHC.StgToJS.Symbols: hdFork :: FastString
+ GHC.StgToJS.Symbols: hdGetReg :: JStgExpr
+ GHC.StgToJS.Symbols: hdGetRegStr :: FastString
+ GHC.StgToJS.Symbols: hdGetThreadLabel :: FastString
+ GHC.StgToJS.Symbols: hdGhcInternalIOHandleFDStdout :: JStgExpr
+ GHC.StgToJS.Symbols: hdGhcInternalIOHandleFlush :: JStgExpr
+ GHC.StgToJS.Symbols: hdGhcInternalJSPrimValConEntryStr :: FastString
+ GHC.StgToJS.Symbols: hdHsMinusInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsMinusWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsPlusInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsPlusWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsQuotInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsQuotWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsRemInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsRemWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsSptInsert :: JStgExpr
+ GHC.StgToJS.Symbols: hdHsTimesInt2Str :: FastString
+ GHC.StgToJS.Symbols: hdHsTimesInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsTimesWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsUncheckedShiftLLInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsUncheckedShiftLWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsUncheckedShiftRAInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsUncheckedShiftRLInt64Str :: FastString
+ GHC.StgToJS.Symbols: hdHsUncheckedShiftRWord64Str :: FastString
+ GHC.StgToJS.Symbols: hdInitClosure :: FastString
+ GHC.StgToJS.Symbols: hdInitStatic :: JStgExpr
+ GHC.StgToJS.Symbols: hdInitStaticStr :: Ident
+ GHC.StgToJS.Symbols: hdInternalExceptionControlExceptionBaseNonTermination :: JStgExpr
+ GHC.StgToJS.Symbols: hdInternalExceptionTypeDivZero :: JStgExpr
+ GHC.StgToJS.Symbols: hdInternalExceptionTypeOverflow :: JStgExpr
+ GHC.StgToJS.Symbols: hdInternalExceptionTypeUnderflow :: JStgExpr
+ GHC.StgToJS.Symbols: hdKeepAlive :: FastString
+ GHC.StgToJS.Symbols: hdKeepAliveEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdKeepAliveEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdKillThread :: FastString
+ GHC.StgToJS.Symbols: hdLazyEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdListThreads :: FastString
+ GHC.StgToJS.Symbols: hdLoads :: Array Int Ident
+ GHC.StgToJS.Symbols: hdLog :: JStgExpr
+ GHC.StgToJS.Symbols: hdLogStr :: FastString
+ GHC.StgToJS.Symbols: hdMVar :: JStgExpr
+ GHC.StgToJS.Symbols: hdMVarStr :: FastString
+ GHC.StgToJS.Symbols: hdMakeStableName :: FastString
+ GHC.StgToJS.Symbols: hdMakeStablePtrStr :: FastString
+ GHC.StgToJS.Symbols: hdMakeWeak :: FastString
+ GHC.StgToJS.Symbols: hdMakeWeakNoFinalizer :: FastString
+ GHC.StgToJS.Symbols: hdMaskAsyncStr :: FastString
+ GHC.StgToJS.Symbols: hdMaskFrame :: JStgExpr
+ GHC.StgToJS.Symbols: hdMaskFrameStr :: Ident
+ GHC.StgToJS.Symbols: hdMaskUnintAsyncStr :: FastString
+ GHC.StgToJS.Symbols: hdMaskUnintFrame :: JStgExpr
+ GHC.StgToJS.Symbols: hdMaskUnintFrameStr :: Ident
+ GHC.StgToJS.Symbols: hdMkForeignCallback :: JStgExpr
+ GHC.StgToJS.Symbols: hdMkFunctionPtr :: JStgExpr
+ GHC.StgToJS.Symbols: hdMoveRegs2 :: FastString
+ GHC.StgToJS.Symbols: hdMul2Word32Str :: FastString
+ GHC.StgToJS.Symbols: hdMulImulStr :: FastString
+ GHC.StgToJS.Symbols: hdMutVarStr :: FastString
+ GHC.StgToJS.Symbols: hdNewArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdNewByteArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdNewTVar :: FastString
+ GHC.StgToJS.Symbols: hdNoopEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdNoopEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdNoopStr :: Ident
+ GHC.StgToJS.Symbols: hdPDep16Str :: FastString
+ GHC.StgToJS.Symbols: hdPDep32Str :: FastString
+ GHC.StgToJS.Symbols: hdPDep64Str :: FastString
+ GHC.StgToJS.Symbols: hdPDep8Str :: FastString
+ GHC.StgToJS.Symbols: hdPExit16Str :: FastString
+ GHC.StgToJS.Symbols: hdPExit32Str :: FastString
+ GHC.StgToJS.Symbols: hdPExit64Str :: FastString
+ GHC.StgToJS.Symbols: hdPExit8Str :: FastString
+ GHC.StgToJS.Symbols: hdPStr :: FastString
+ GHC.StgToJS.Symbols: hdPapGen :: JStgExpr
+ GHC.StgToJS.Symbols: hdPapGenStr :: FastString
+ GHC.StgToJS.Symbols: hdPapStr_ :: FastString
+ GHC.StgToJS.Symbols: hdPaps :: JStgExpr
+ GHC.StgToJS.Symbols: hdPapsStr :: FastString
+ GHC.StgToJS.Symbols: hdPopCnt32Str :: FastString
+ GHC.StgToJS.Symbols: hdPopCnt64Str :: FastString
+ GHC.StgToJS.Symbols: hdPopCntTab :: JStgExpr
+ GHC.StgToJS.Symbols: hdPrimOpStr :: FastString
+ GHC.StgToJS.Symbols: hdPutMVarStr :: FastString
+ GHC.StgToJS.Symbols: hdQuotRem2Word32Str :: FastString
+ GHC.StgToJS.Symbols: hdQuotRemWord32Str :: FastString
+ GHC.StgToJS.Symbols: hdQuotWord32Str :: FastString
+ GHC.StgToJS.Symbols: hdRaiseAsyncEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdRaiseAsyncEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdRaiseAsyncFrame :: JStgExpr
+ GHC.StgToJS.Symbols: hdRaiseAsyncFrameStr :: Ident
+ GHC.StgToJS.Symbols: hdRaiseEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdRaiseEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdRawStr :: FastString
+ GHC.StgToJS.Symbols: hdRawStringDataStr :: FastString
+ GHC.StgToJS.Symbols: hdReadMVarStr :: FastString
+ GHC.StgToJS.Symbols: hdReadTVar :: FastString
+ GHC.StgToJS.Symbols: hdReadTVarIO :: FastString
+ GHC.StgToJS.Symbols: hdReduce :: JStgExpr
+ GHC.StgToJS.Symbols: hdReduceStr :: Ident
+ GHC.StgToJS.Symbols: hdRegs :: JStgExpr
+ GHC.StgToJS.Symbols: hdRegsStr :: Ident
+ GHC.StgToJS.Symbols: hdRemWord32Str :: FastString
+ GHC.StgToJS.Symbols: hdReportHeapOverflow :: JStgExpr
+ GHC.StgToJS.Symbols: hdReportHeapOverflowStr :: Ident
+ GHC.StgToJS.Symbols: hdReportStackOverflow :: JStgExpr
+ GHC.StgToJS.Symbols: hdReportStackOverflowStr :: Ident
+ GHC.StgToJS.Symbols: hdReschedule :: JStgExpr
+ GHC.StgToJS.Symbols: hdRescheduleStr :: Ident
+ GHC.StgToJS.Symbols: hdResetRegisters :: Ident
+ GHC.StgToJS.Symbols: hdResetResultVars :: Ident
+ GHC.StgToJS.Symbols: hdResizeMutableByteArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdRestoreCCSStr :: FastString
+ GHC.StgToJS.Symbols: hdRestoreThread :: JStgExpr
+ GHC.StgToJS.Symbols: hdRestoreThreadStr :: Ident
+ GHC.StgToJS.Symbols: hdResumeEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdRetryInterrupted :: JStgExpr
+ GHC.StgToJS.Symbols: hdRetryInterruptedStr :: Ident
+ GHC.StgToJS.Symbols: hdReturn :: JStgExpr
+ GHC.StgToJS.Symbols: hdReturnF :: JStgExpr
+ GHC.StgToJS.Symbols: hdReturnFStr :: Ident
+ GHC.StgToJS.Symbols: hdReturnStr :: Ident
+ GHC.StgToJS.Symbols: hdReverseWordStr :: FastString
+ GHC.StgToJS.Symbols: hdRtsProfiling :: Ident
+ GHC.StgToJS.Symbols: hdRtsTraceForeign :: Ident
+ GHC.StgToJS.Symbols: hdRunIOEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdRunIOEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdSelect1EntryStr :: Ident
+ GHC.StgToJS.Symbols: hdSelect1Ret :: JStgExpr
+ GHC.StgToJS.Symbols: hdSelect1RetStr :: Ident
+ GHC.StgToJS.Symbols: hdSelect2Entry :: JStgExpr
+ GHC.StgToJS.Symbols: hdSelect2EntryStr :: Ident
+ GHC.StgToJS.Symbols: hdSelect2Return :: JStgExpr
+ GHC.StgToJS.Symbols: hdSelect2ReturnStr :: Ident
+ GHC.StgToJS.Symbols: hdSetCcsEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdSetCcsEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdSetReg :: JStgExpr
+ GHC.StgToJS.Symbols: hdSetRegStr :: FastString
+ GHC.StgToJS.Symbols: hdShrinkMutableByteArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdShrinkMutableCharArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdSliceArrayStr :: FastString
+ GHC.StgToJS.Symbols: hdStableNameInt :: FastString
+ GHC.StgToJS.Symbols: hdStablePtrBuf :: JStgExpr
+ GHC.StgToJS.Symbols: hdStack :: JStgExpr
+ GHC.StgToJS.Symbols: hdStackPtr :: JStgExpr
+ GHC.StgToJS.Symbols: hdStackPtrStr :: Ident
+ GHC.StgToJS.Symbols: hdStackStr :: Ident
+ GHC.StgToJS.Symbols: hdStaticThunkStr :: FastString
+ GHC.StgToJS.Symbols: hdStaticThunksArrStr :: Ident
+ GHC.StgToJS.Symbols: hdStaticThunksStr :: Ident
+ GHC.StgToJS.Symbols: hdStcStr :: FastString
+ GHC.StgToJS.Symbols: hdStgResumeRetryEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdStgResumeRetryEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdStiStr :: FastString
+ GHC.StgToJS.Symbols: hdStlStr :: FastString
+ GHC.StgToJS.Symbols: hdStmCatchEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdStmCatchEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdStmCatchRetryEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdStmCatchRetryEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdStmCatchRetryStr :: FastString
+ GHC.StgToJS.Symbols: hdStmCommitTransactionStr :: FastString
+ GHC.StgToJS.Symbols: hdStmRemoveBlockedThreadStr :: FastString
+ GHC.StgToJS.Symbols: hdStmRetryStr :: FastString
+ GHC.StgToJS.Symbols: hdStmStartTransactionStr :: FastString
+ GHC.StgToJS.Symbols: hdStmValidateTransactionStr :: FastString
+ GHC.StgToJS.Symbols: hdStr :: FastString
+ GHC.StgToJS.Symbols: hdStrStr :: FastString
+ GHC.StgToJS.Symbols: hdTagToEnum :: FastString
+ GHC.StgToJS.Symbols: hdTakeMVar :: JStgExpr
+ GHC.StgToJS.Symbols: hdTakeMVarStr :: FastString
+ GHC.StgToJS.Symbols: hdThreadStatus :: FastString
+ GHC.StgToJS.Symbols: hdThrowJSException :: JStgExpr
+ GHC.StgToJS.Symbols: hdThrowStr :: FastString
+ GHC.StgToJS.Symbols: hdTraceAlloc :: FastString
+ GHC.StgToJS.Symbols: hdTraceEventBinaryStr :: FastString
+ GHC.StgToJS.Symbols: hdTraceEventStr :: FastString
+ GHC.StgToJS.Symbols: hdTraceForeign :: JStgExpr
+ GHC.StgToJS.Symbols: hdTraceMarkerStr :: FastString
+ GHC.StgToJS.Symbols: hdTrueEntry :: Ident
+ GHC.StgToJS.Symbols: hdTryPutMVarStr :: FastString
+ GHC.StgToJS.Symbols: hdTryTakeMVarStr :: FastString
+ GHC.StgToJS.Symbols: hdUnMaskFrameStr :: Ident
+ GHC.StgToJS.Symbols: hdUnboxEntry :: JStgExpr
+ GHC.StgToJS.Symbols: hdUnboxEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdUnboxFFIResult :: JStgExpr
+ GHC.StgToJS.Symbols: hdUnboxFFIResultStr :: Ident
+ GHC.StgToJS.Symbols: hdUnmaskAsyncStr :: FastString
+ GHC.StgToJS.Symbols: hdUpdFrame :: JStgExpr
+ GHC.StgToJS.Symbols: hdUpdFrameStr :: Ident
+ GHC.StgToJS.Symbols: hdUpdThunkEntryStr :: Ident
+ GHC.StgToJS.Symbols: hdVtAddr :: Ident
+ GHC.StgToJS.Symbols: hdVtArr :: Ident
+ GHC.StgToJS.Symbols: hdVtDouble :: Ident
+ GHC.StgToJS.Symbols: hdVtInt :: Ident
+ GHC.StgToJS.Symbols: hdVtLong :: Ident
+ GHC.StgToJS.Symbols: hdVtObj :: Ident
+ GHC.StgToJS.Symbols: hdVtVoid :: Ident
+ GHC.StgToJS.Symbols: hdWaitRead :: FastString
+ GHC.StgToJS.Symbols: hdWaitWrite :: FastString
+ GHC.StgToJS.Symbols: hdWakeupThread :: FastString
+ GHC.StgToJS.Symbols: hdWordAdd2 :: FastString
+ GHC.StgToJS.Symbols: hdWriteTVar :: FastString
+ GHC.StgToJS.Symbols: hdYield :: FastString
+ GHC.StgToJS.Symbols: hddB :: ByteString
+ GHC.StgToJS.Symbols: hdlB :: ByteString
+ GHC.StgToJS.Symbols: i3 :: FastString
+ GHC.StgToJS.Symbols: intBS :: Int -> ByteString
+ GHC.StgToJS.Symbols: label :: FastString
+ GHC.StgToJS.Symbols: len :: FastString
+ GHC.StgToJS.Symbols: lngth :: FastString
+ GHC.StgToJS.Symbols: mask :: FastString
+ GHC.StgToJS.Symbols: mkFreshJsSymbol :: Module -> Int -> FastString
+ GHC.StgToJS.Symbols: mkJsSymbol :: Bool -> Module -> FastString -> FastString
+ GHC.StgToJS.Symbols: mkJsSymbolBS :: Bool -> Module -> FastString -> ByteString
+ GHC.StgToJS.Symbols: mkRawSymbol :: Bool -> FastString -> FastString
+ GHC.StgToJS.Symbols: moduleExportsSymbol :: Module -> FastString
+ GHC.StgToJS.Symbols: moduleGlobalSymbol :: Module -> FastString
+ GHC.StgToJS.Symbols: mv :: FastString
+ GHC.StgToJS.Symbols: n :: FastString
+ GHC.StgToJS.Symbols: replace :: FastString
+ GHC.StgToJS.Symbols: resume :: FastString
+ GHC.StgToJS.Symbols: setFloat32 :: FastString
+ GHC.StgToJS.Symbols: setFloat64 :: FastString
+ GHC.StgToJS.Symbols: setInt16 :: FastString
+ GHC.StgToJS.Symbols: setInt32 :: FastString
+ GHC.StgToJS.Symbols: setUint16 :: FastString
+ GHC.StgToJS.Symbols: setUint32 :: FastString
+ GHC.StgToJS.Symbols: slice :: FastString
+ GHC.StgToJS.Symbols: substring :: FastString
+ GHC.StgToJS.Symbols: this :: JStgExpr
+ GHC.StgToJS.Symbols: throwStr :: FastString
+ GHC.StgToJS.Symbols: trace :: FastString
+ GHC.StgToJS.Symbols: typeof :: FastString
+ GHC.StgToJS.Symbols: u1 :: FastString
+ GHC.StgToJS.Symbols: u8 :: FastString
+ GHC.StgToJS.Symbols: unMask :: FastString
+ GHC.StgToJS.Symbols: unitModuleStringZ :: Module -> ByteString
+ GHC.StgToJS.Symbols: unknown :: FastString
+ GHC.StgToJS.Symbols: val :: FastString
+ GHC.StgToJS.Symbols: word64BS :: Word64 -> ByteString
+ GHC.StgToJS.Symbols: wrapperColonStr :: FastString
+ GHC.StgToJS.Types: closureB :: ByteString
+ GHC.StgToJS.Types: closureNames :: Array ClosureType Ident
+ GHC.StgToJS.Types: instance GHC.Ix.Ix GHC.StgToJS.Types.ClosureType
+ GHC.Tc.Errors.Types: ContextArrowSyntax :: TypeSyntax
+ GHC.Tc.Errors.Types: ForallTelescopeSyntax :: TypeSyntax
+ GHC.Tc.Errors.Types: FunctionArrowSyntax :: TypeSyntax
+ GHC.Tc.Errors.Types: PragmaWarningDefault :: TyCon -> ModuleName -> PragmaWarningInfo
+ GHC.Tc.Errors.Types: TypeKeywordSyntax :: TypeSyntax
+ GHC.Tc.Errors.Types: WildcardBndrInForallTelescope :: BadAnonWildcardContext
+ GHC.Tc.Errors.Types: WildcardBndrInTyFamResultVar :: BadAnonWildcardContext
+ GHC.Tc.Errors.Types: [TcRnExportHiddenDefault] :: IE GhcPs -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnIllegalDefaultClass] :: !LHsSigType GhcRn -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnIllegalNamedDefault] :: !LDefaultDecl GhcRn -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnIllegalWildcardTyVarBndr] :: !LHsTyVarBndr (HsBndrVis GhcRn) GhcRn -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnNoDerivingClauseStrategySpecified] :: Map AssumedDerivingStrategy [LHsSigType GhcRn] -> TcRnNoDerivStratSpecifiedInfo
+ GHC.Tc.Errors.Types: [TcRnNoStandaloneDerivingStrategySpecified] :: AssumedDerivingStrategy -> LHsSigWcType GhcRn -> TcRnNoDerivStratSpecifiedInfo
+ GHC.Tc.Errors.Types: [TcRnOrPatBindsVariables] :: NonEmpty (IdP GhcRn) -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnUnexpectedTypeSyntaxInTerms] :: TypeSyntax -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnWarnClashingDefaultImports] :: TyCon -> Maybe [Type] -> NonEmpty ClassDefaults -> TcRnMessage
+ GHC.Tc.Errors.Types: [pwarn_class] :: PragmaWarningInfo -> TyCon
+ GHC.Tc.Errors.Types: data TcRnNoDerivStratSpecifiedInfo
+ GHC.Tc.Errors.Types: data TypeSyntax
+ GHC.Tc.Errors.Types: instance GHC.Generics.Generic GHC.Tc.Errors.Types.TypeSyntax
+ GHC.Tc.Errors.Types: typeSyntaxExtension :: TypeSyntax -> Extension
+ GHC.Tc.Solver.InertSet: [wl_eqs_N] :: WorkList -> [Ct]
+ GHC.Tc.Solver.InertSet: [wl_eqs_X] :: WorkList -> [Ct]
+ GHC.Tc.Solver.InertSet: instance GHC.Classes.Eq GHC.Tc.Solver.InertSet.WhereToLook
+ GHC.Tc.Solver.InertSet: instance GHC.Utils.Outputable.Outputable GHC.Tc.Solver.InertSet.KickOutSpec
+ GHC.Tc.Types: ImpUserAll :: ImpUserList
+ GHC.Tc.Types: ImpUserEverythingBut :: !NameSet -> ImpUserList
+ GHC.Tc.Types: ImpUserExplicit :: !GlobalRdrEnv -> ImpUserList
+ GHC.Tc.Types: ImpUserSpec :: !ImpDeclSpec -> !ImpUserList -> ImportUserSpec
+ GHC.Tc.Types: [ius_decl] :: ImportUserSpec -> !ImpDeclSpec
+ GHC.Tc.Types: [ius_imports] :: ImportUserSpec -> !ImpUserList
+ GHC.Tc.Types: [tcg_default_exports] :: TcGblEnv -> DefaultEnv
+ GHC.Tc.Types: [tcg_import_decls] :: TcGblEnv -> ![ImportUserSpec]
+ GHC.Tc.Types: data ImpUserList
+ GHC.Tc.Types: data ImportUserSpec
+ GHC.Tc.Types: type CompleteMatch = CompleteMatchX Name
+ GHC.Tc.Types.Constraint: boundOccNamesOfWC :: WantedConstraints -> [OccName]
+ GHC.Tc.Types.Constraint: ctEvRewriteEqRel :: CtEvidence -> EqRel
+ GHC.Tc.Types.Constraint: ctEvRewriteRole :: HasDebugCallStack => CtEvidence -> Role
+ GHC.Tc.Types.Constraint: dictCtPred :: DictCt -> TcPredType
+ GHC.Tc.Types.CtLoc: CtLoc :: CtOrigin -> CtLocEnv -> Maybe TypeOrKind -> !SubGoalDepth -> CtLoc
+ GHC.Tc.Types.CtLoc: CtLocEnv :: ![ErrCtxt] -> !RealSrcSpan -> !TcBinderStack -> !TcLevel -> !Bool -> !LocalRdrEnv -> CtLocEnv
+ GHC.Tc.Types.CtLoc: [ctl_bndrs] :: CtLocEnv -> !TcBinderStack
+ GHC.Tc.Types.CtLoc: [ctl_ctxt] :: CtLocEnv -> ![ErrCtxt]
+ GHC.Tc.Types.CtLoc: [ctl_depth] :: CtLoc -> !SubGoalDepth
+ GHC.Tc.Types.CtLoc: [ctl_env] :: CtLoc -> CtLocEnv
+ GHC.Tc.Types.CtLoc: [ctl_in_gen_code] :: CtLocEnv -> !Bool
+ GHC.Tc.Types.CtLoc: [ctl_loc] :: CtLocEnv -> !RealSrcSpan
+ GHC.Tc.Types.CtLoc: [ctl_origin] :: CtLoc -> CtOrigin
+ GHC.Tc.Types.CtLoc: [ctl_rdr] :: CtLocEnv -> !LocalRdrEnv
+ GHC.Tc.Types.CtLoc: [ctl_t_or_k] :: CtLoc -> Maybe TypeOrKind
+ GHC.Tc.Types.CtLoc: [ctl_tclvl] :: CtLocEnv -> !TcLevel
+ GHC.Tc.Types.CtLoc: adjustCtLoc :: Bool -> Bool -> CtLoc -> CtLoc
+ GHC.Tc.Types.CtLoc: adjustCtLocTyConBinder :: TyConBinder -> CtLoc -> CtLoc
+ GHC.Tc.Types.CtLoc: bumpCtLocDepth :: CtLoc -> CtLoc
+ GHC.Tc.Types.CtLoc: bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth
+ GHC.Tc.Types.CtLoc: ctLocDepth :: CtLoc -> SubGoalDepth
+ GHC.Tc.Types.CtLoc: ctLocEnv :: CtLoc -> CtLocEnv
+ GHC.Tc.Types.CtLoc: ctLocEnvInGeneratedCode :: CtLocEnv -> Bool
+ GHC.Tc.Types.CtLoc: ctLocLevel :: CtLoc -> TcLevel
+ GHC.Tc.Types.CtLoc: ctLocOrigin :: CtLoc -> CtOrigin
+ GHC.Tc.Types.CtLoc: ctLocSpan :: CtLoc -> RealSrcSpan
+ GHC.Tc.Types.CtLoc: ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind
+ GHC.Tc.Types.CtLoc: data CtLoc
+ GHC.Tc.Types.CtLoc: data CtLocEnv
+ GHC.Tc.Types.CtLoc: data SubGoalDepth
+ GHC.Tc.Types.CtLoc: getCtLocEnvLoc :: CtLocEnv -> RealSrcSpan
+ GHC.Tc.Types.CtLoc: getCtLocEnvLvl :: CtLocEnv -> TcLevel
+ GHC.Tc.Types.CtLoc: initialSubGoalDepth :: SubGoalDepth
+ GHC.Tc.Types.CtLoc: instance GHC.Classes.Eq GHC.Tc.Types.CtLoc.SubGoalDepth
+ GHC.Tc.Types.CtLoc: instance GHC.Classes.Ord GHC.Tc.Types.CtLoc.SubGoalDepth
+ GHC.Tc.Types.CtLoc: instance GHC.Utils.Outputable.Outputable GHC.Tc.Types.CtLoc.SubGoalDepth
+ GHC.Tc.Types.CtLoc: isGivenLoc :: CtLoc -> Bool
+ GHC.Tc.Types.CtLoc: maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth
+ GHC.Tc.Types.CtLoc: mkGivenLoc :: TcLevel -> SkolemInfoAnon -> CtLocEnv -> CtLoc
+ GHC.Tc.Types.CtLoc: mkKindEqLoc :: TcType -> TcType -> CtLoc -> CtLoc
+ GHC.Tc.Types.CtLoc: pprCtLoc :: CtLoc -> SDoc
+ GHC.Tc.Types.CtLoc: setCtLocEnv :: CtLoc -> CtLocEnv -> CtLoc
+ GHC.Tc.Types.CtLoc: setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv
+ GHC.Tc.Types.CtLoc: setCtLocEnvLvl :: CtLocEnv -> TcLevel -> CtLocEnv
+ GHC.Tc.Types.CtLoc: setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
+ GHC.Tc.Types.CtLoc: setCtLocRealLoc :: CtLocEnv -> RealSrcSpan -> CtLocEnv
+ GHC.Tc.Types.CtLoc: setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc
+ GHC.Tc.Types.CtLoc: subGoalDepthExceeded :: IntWithInf -> SubGoalDepth -> Bool
+ GHC.Tc.Types.CtLoc: toInvisibleLoc :: CtLoc -> CtLoc
+ GHC.Tc.Types.CtLoc: updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc
+ GHC.Tc.Types.Evidence: type MultiplicityCheckCoercions = [TcCoercion]
+ GHC.Tc.Types.Origin: OmittedFieldOrigin :: Maybe FieldLabel -> CtOrigin
+ GHC.Tc.Utils.TcType: QLInstVar :: TcLevel
+ GHC.Tc.Utils.TcType: data TcLevel
+ GHC.Tc.Utils.TcType: isQLInstTyVar :: TcTyVar -> Bool
+ GHC.Tc.Utils.TcType: isRuntimeUnkTyVar :: TcTyVar -> Bool
+ GHC.Tc.Utils.TcType: type ExpKind = ExpType
+ GHC.Tc.Utils.TcType: type UnderFam = Bool
+ GHC.Tc.Zonk.Monad: getZonkTcLevel :: ZonkM TcLevel
+ GHC.Types.Avail: DefinitelyDeterministicAvails :: Avails -> DetOrdAvails
+ GHC.Types.Avail: instance Control.DeepSeq.NFData GHC.Types.Avail.DetOrdAvails
+ GHC.Types.Avail: instance GHC.Utils.Binary.Binary GHC.Types.Avail.DetOrdAvails
+ GHC.Types.Avail: instance GHC.Utils.Outputable.Outputable GHC.Types.Avail.DetOrdAvails
+ GHC.Types.Avail: newtype DetOrdAvails
+ GHC.Types.Avail: pattern DetOrdAvails :: Avails -> DetOrdAvails
+ GHC.Types.Avail: sortAvails :: Avails -> DetOrdAvails
+ GHC.Types.Basic: instance GHC.Classes.Eq GHC.Types.Basic.SwapFlag
+ GHC.Types.Basic: instance GHC.Classes.Ord GHC.Types.Basic.LeftOrRight
+ GHC.Types.Basic: instance GHC.Classes.Ord GHC.Types.Basic.TupleSort
+ GHC.Types.Basic: notSwapped :: SwapFlag -> Bool
+ GHC.Types.Basic: pickSwap :: SwapFlag -> a -> a -> a
+ GHC.Types.CompleteMatch: data CompleteMatchX con
+ GHC.Types.CompleteMatch: instance GHC.Classes.Eq (GHC.Types.CompleteMatch.CompleteMatchX con)
+ GHC.Types.CompleteMatch: instance GHC.Utils.Outputable.Outputable con => GHC.Utils.Outputable.Outputable (GHC.Types.CompleteMatch.CompleteMatchX con)
+ GHC.Types.CompleteMatch: mkCompleteMatch :: UniqDSet con -> Maybe Name -> CompleteMatchX con
+ GHC.Types.CompleteMatch: type CompleteMatch = CompleteMatchX Name
+ GHC.Types.CompleteMatch: type DsCompleteMatch = CompleteMatchX ConLike
+ GHC.Types.CompleteMatch: type DsCompleteMatches = [DsCompleteMatch]
+ GHC.Types.CostCentre: getAllCAFsCC :: Module -> (CostCentre, CostCentreStack)
+ GHC.Types.DefaultEnv: ClassDefaults :: !TyCon -> [Type] -> Maybe Module -> Maybe (WarningTxt GhcRn) -> ClassDefaults
+ GHC.Types.DefaultEnv: [cd_class] :: ClassDefaults -> !TyCon
+ GHC.Types.DefaultEnv: [cd_module] :: ClassDefaults -> Maybe Module
+ GHC.Types.DefaultEnv: [cd_types] :: ClassDefaults -> [Type]
+ GHC.Types.DefaultEnv: [cd_warn] :: ClassDefaults -> Maybe (WarningTxt GhcRn)
+ GHC.Types.DefaultEnv: data ClassDefaults
+ GHC.Types.DefaultEnv: defaultEnv :: [ClassDefaults] -> DefaultEnv
+ GHC.Types.DefaultEnv: defaultList :: DefaultEnv -> [ClassDefaults]
+ GHC.Types.DefaultEnv: emptyDefaultEnv :: DefaultEnv
+ GHC.Types.DefaultEnv: filterDefaultEnv :: (ClassDefaults -> Bool) -> DefaultEnv -> DefaultEnv
+ GHC.Types.DefaultEnv: instance Data.Data.Data GHC.Types.DefaultEnv.ClassDefaults
+ GHC.Types.DefaultEnv: instance GHC.Utils.Outputable.Outputable GHC.Types.DefaultEnv.ClassDefaults
+ GHC.Types.DefaultEnv: isEmptyDefaultEnv :: DefaultEnv -> Bool
+ GHC.Types.DefaultEnv: lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults
+ GHC.Types.DefaultEnv: plusDefaultEnv :: DefaultEnv -> DefaultEnv -> DefaultEnv
+ GHC.Types.DefaultEnv: type DefaultEnv = TyConEnv ClassDefaults
+ GHC.Types.DefaultEnv: unitDefaultEnv :: ClassDefaults -> DefaultEnv
+ GHC.Types.Demand: multDmdEnv :: Card -> DmdEnv -> DmdEnv
+ GHC.Types.Demand: strictCallArity :: SubDemand -> Arity
+ GHC.Types.Error: SuggestDefaultDeclaration :: TyCon -> [Type] -> GhcHint
+ GHC.Types.Error: SuggestExplicitDerivingClauseStrategies :: Map AssumedDerivingStrategy [LHsSigType GhcRn] -> GhcHint
+ GHC.Types.Error: SuggestExplicitStandaloneDerivingStrategy :: AssumedDerivingStrategy -> LHsSigWcType GhcRn -> GhcHint
+ GHC.Types.Error: SuggestParenthesizePatternRHS :: GhcHint
+ GHC.Types.GREInfo: ConInfo :: !ConLikeInfo -> !ConFieldInfo -> ConInfo
+ GHC.Types.GREInfo: ConIsData :: [Name] -> ConLikeInfo
+ GHC.Types.GREInfo: ConIsPatSyn :: ConLikeInfo
+ GHC.Types.GREInfo: [conFieldInfo] :: ConInfo -> !ConFieldInfo
+ GHC.Types.GREInfo: [conLikeDataCons] :: ConLikeInfo -> [Name]
+ GHC.Types.GREInfo: [conLikeInfo] :: ConInfo -> !ConLikeInfo
+ GHC.Types.GREInfo: conFieldInfoFields :: ConFieldInfo -> [FieldLabel]
+ GHC.Types.GREInfo: data ConFieldInfo
+ GHC.Types.GREInfo: data ConLikeInfo
+ GHC.Types.GREInfo: instance Control.DeepSeq.NFData GHC.Types.GREInfo.ConFieldInfo
+ GHC.Types.GREInfo: instance Control.DeepSeq.NFData GHC.Types.GREInfo.ConLikeInfo
+ GHC.Types.GREInfo: instance Data.Data.Data GHC.Types.GREInfo.ConFieldInfo
+ GHC.Types.GREInfo: instance Data.Data.Data GHC.Types.GREInfo.ConLikeInfo
+ GHC.Types.GREInfo: instance GHC.Classes.Eq GHC.Types.GREInfo.ConFieldInfo
+ GHC.Types.GREInfo: instance GHC.Classes.Eq GHC.Types.GREInfo.ConLikeInfo
+ GHC.Types.GREInfo: instance GHC.Utils.Outputable.Outputable GHC.Types.GREInfo.ConFieldInfo
+ GHC.Types.GREInfo: instance GHC.Utils.Outputable.Outputable GHC.Types.GREInfo.ConLikeInfo
+ GHC.Types.GREInfo: instance GHC.Utils.Outputable.OutputableBndr GHC.Types.GREInfo.ConLikeName
+ GHC.Types.GREInfo: mkConFieldInfo :: Arity -> [FieldLabel] -> ConFieldInfo
+ GHC.Types.Hint: AssumedAnyclassStrategy :: AssumedDerivingStrategy
+ GHC.Types.Hint: AssumedNewtypeStrategy :: AssumedDerivingStrategy
+ GHC.Types.Hint: AssumedStockStrategy :: AssumedDerivingStrategy
+ GHC.Types.Hint: SuggestDefaultDeclaration :: TyCon -> [Type] -> GhcHint
+ GHC.Types.Hint: SuggestExplicitDerivingClauseStrategies :: Map AssumedDerivingStrategy [LHsSigType GhcRn] -> GhcHint
+ GHC.Types.Hint: SuggestExplicitStandaloneDerivingStrategy :: AssumedDerivingStrategy -> LHsSigWcType GhcRn -> GhcHint
+ GHC.Types.Hint: SuggestParenthesizePatternRHS :: GhcHint
+ GHC.Types.Hint: data AssumedDerivingStrategy
+ GHC.Types.Hint: instance GHC.Classes.Eq GHC.Types.Hint.AssumedDerivingStrategy
+ GHC.Types.Hint: instance GHC.Classes.Ord GHC.Types.Hint.AssumedDerivingStrategy
+ GHC.Types.Hint: instance GHC.Utils.Outputable.Outputable GHC.Types.Hint.AssumedDerivingStrategy
+ GHC.Types.Id: isDataConId :: Id -> Bool
+ GHC.Types.Name.Occurrence: trimTidyOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
+ GHC.Types.Name.Reader: [is_isboot] :: ImpDeclSpec -> !IsBootInterface
+ GHC.Types.Name.Reader: [is_pkg_qual] :: ImpDeclSpec -> !PkgQual
+ GHC.Types.Name.Reader: globalRdrEnvLocal :: GlobalRdrEnvX info -> GlobalRdrEnvX info
+ GHC.Types.Name.Reader: instance Control.DeepSeq.NFData GHC.Types.Name.Reader.ImpDeclSpec
+ GHC.Types.SptEntry: SptEntry :: Id -> Fingerprint -> SptEntry
+ GHC.Types.SptEntry: data SptEntry
+ GHC.Types.SptEntry: instance GHC.Utils.Outputable.Outputable GHC.Types.SptEntry.SptEntry
+ GHC.Types.Unique: instance GHC.Types.Unique.Uniquable GHC.Word.Word64
+ GHC.Types.Unique.DFM: foldWithKeyUDFM :: forall {k} elt a (key :: k). (Unique -> elt -> a -> a) -> a -> UniqDFM key elt -> a
+ GHC.Types.Unique.DFM: listToUDFM_C_Directly :: forall {k} elt (key :: k). (elt -> elt -> elt) -> [(Unique, elt)] -> UniqDFM key elt
+ GHC.Types.Unique.DFM: mapMUDFM :: forall {k} m elt1 elt2 (key :: k). Monad m => (elt1 -> m elt2) -> UniqDFM key elt1 -> m (UniqDFM key elt2)
+ GHC.Types.Unique.DFM: plusUDFM_CK :: forall {k} elt (key :: k). (Unique -> elt -> elt -> elt) -> UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
+ GHC.Types.Unique.DSM: class Monad m => MonadGetUnique (m :: Type -> Type)
+ GHC.Types.Unique.DSM: class Monad m => MonadUniqDSM (m :: Type -> Type)
+ GHC.Types.Unique.DSM: data DUniqSupply
+ GHC.Types.Unique.DSM: data UniqDSM result
+ GHC.Types.Unique.DSM: data UniqDSMT (m :: Type -> Type) result
+ GHC.Types.Unique.DSM: getTagDUniqSupply :: DUniqSupply -> Char
+ GHC.Types.Unique.DSM: getUniqueDSM :: UniqDSM Unique
+ GHC.Types.Unique.DSM: getUniqueM :: MonadGetUnique m => m Unique
+ GHC.Types.Unique.DSM: hoistUDSMT :: (forall x. () => m x -> n x) -> UniqDSMT m a -> UniqDSMT n a
+ GHC.Types.Unique.DSM: initDUniqSupply :: Char -> Word64 -> DUniqSupply
+ GHC.Types.Unique.DSM: instance Control.Monad.Fix.MonadFix GHC.Types.Unique.DSM.UniqDSM
+ GHC.Types.Unique.DSM: instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (GHC.Types.Unique.DSM.UniqDSMT m)
+ GHC.Types.Unique.DSM: instance GHC.Base.Applicative GHC.Types.Unique.DSM.UniqDSM
+ GHC.Types.Unique.DSM: instance GHC.Base.Functor GHC.Types.Unique.DSM.UniqDSM
+ GHC.Types.Unique.DSM: instance GHC.Base.Functor m => GHC.Base.Functor (GHC.Types.Unique.DSM.UniqDSMT m)
+ GHC.Types.Unique.DSM: instance GHC.Base.Monad GHC.Types.Unique.DSM.UniqDSM
+ GHC.Types.Unique.DSM: instance GHC.Base.Monad m => GHC.Base.Applicative (GHC.Types.Unique.DSM.UniqDSMT m)
+ GHC.Types.Unique.DSM: instance GHC.Base.Monad m => GHC.Base.Monad (GHC.Types.Unique.DSM.UniqDSMT m)
+ GHC.Types.Unique.DSM: instance GHC.Base.Monad m => GHC.Types.Unique.DSM.MonadGetUnique (GHC.Types.Unique.DSM.UniqDSMT m)
+ GHC.Types.Unique.DSM: instance GHC.Base.Monad m => GHC.Types.Unique.DSM.MonadUniqDSM (GHC.Types.Unique.DSM.UniqDSMT m)
+ GHC.Types.Unique.DSM: instance GHC.Types.Unique.DSM.MonadGetUnique GHC.Types.Unique.DSM.UniqDSM
+ GHC.Types.Unique.DSM: instance GHC.Types.Unique.DSM.MonadGetUnique GHC.Types.Unique.Supply.UniqSM
+ GHC.Types.Unique.DSM: instance GHC.Types.Unique.DSM.MonadUniqDSM GHC.Types.Unique.DSM.UniqDSM
+ GHC.Types.Unique.DSM: liftUDSMT :: Functor m => m a -> UniqDSMT m a
+ GHC.Types.Unique.DSM: liftUniqDSM :: MonadUniqDSM m => UniqDSM a -> m a
+ GHC.Types.Unique.DSM: newTagDUniqSupply :: Char -> DUniqSupply -> DUniqSupply
+ GHC.Types.Unique.DSM: pattern DUniqResult :: a -> DUniqSupply -> (# a, DUniqSupply #)
+ GHC.Types.Unique.DSM: pattern UDSM :: (DUniqSupply -> DUniqResult a) -> UniqDSM a
+ GHC.Types.Unique.DSM: pattern UDSMT :: (DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
+ GHC.Types.Unique.DSM: runUDSMT :: DUniqSupply -> UniqDSMT m a -> m (a, DUniqSupply)
+ GHC.Types.Unique.DSM: runUniqueDSM :: DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
+ GHC.Types.Unique.DSM: setTagUDSMT :: forall (m :: Type -> Type) a. Monad m => Char -> UniqDSMT m a -> UniqDSMT m a
+ GHC.Types.Unique.DSM: takeUniqueFromDSupply :: DUniqSupply -> (Unique, DUniqSupply)
+ GHC.Types.Unique.DSM: type DUniqResult result = (# result, DUniqSupply #)
+ GHC.Types.Unique.DSM: withDUS :: (DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a
+ GHC.Types.Unique.DSet: mapMUniqDSet :: (Monad m, Uniquable b) => (a -> m b) -> UniqDSet a -> m (UniqDSet b)
+ GHC.Types.Unique.DSet: strictFoldUniqDSet :: (a -> r -> r) -> r -> UniqDSet a -> r
+ GHC.Types.Unique.FM: mapMaybeUFM_sameUnique :: forall {k1} {k2} elt1 elt2 (key1 :: k1) (key2 :: k2). (elt1 -> Maybe elt2) -> UniqFM key1 elt1 -> UniqFM key2 elt2
+ GHC.Types.Unique.Set: US :: Word64Set -> UniqueSet
+ GHC.Types.Unique.Set: [unUniqueSet] :: UniqueSet -> Word64Set
+ GHC.Types.Unique.Set: deleteUniqueSet :: Unique -> UniqueSet -> UniqueSet
+ GHC.Types.Unique.Set: differenceUniqueSet :: UniqueSet -> UniqueSet -> UniqueSet
+ GHC.Types.Unique.Set: elemsUniqueSet :: UniqueSet -> [Unique]
+ GHC.Types.Unique.Set: emptyUniqueSet :: UniqueSet
+ GHC.Types.Unique.Set: filterUniqueSet :: (Unique -> Bool) -> UniqueSet -> UniqueSet
+ GHC.Types.Unique.Set: foldlUniqueSet :: (a -> Unique -> a) -> a -> UniqueSet -> a
+ GHC.Types.Unique.Set: foldrUniqueSet :: (Unique -> b -> b) -> b -> UniqueSet -> b
+ GHC.Types.Unique.Set: fromListUniqueSet :: [Unique] -> UniqueSet
+ GHC.Types.Unique.Set: insertUniqueSet :: Unique -> UniqueSet -> UniqueSet
+ GHC.Types.Unique.Set: instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (GHC.Types.Unique.Set.UniqSet a)
+ GHC.Types.Unique.Set: instance GHC.Base.Monoid GHC.Types.Unique.Set.UniqueSet
+ GHC.Types.Unique.Set: instance GHC.Base.Semigroup GHC.Types.Unique.Set.UniqueSet
+ GHC.Types.Unique.Set: instance GHC.Classes.Eq GHC.Types.Unique.Set.UniqueSet
+ GHC.Types.Unique.Set: instance GHC.Classes.Ord GHC.Types.Unique.Set.UniqueSet
+ GHC.Types.Unique.Set: instance GHC.Show.Show GHC.Types.Unique.Set.UniqueSet
+ GHC.Types.Unique.Set: intersectionUniqueSet :: UniqueSet -> UniqueSet -> UniqueSet
+ GHC.Types.Unique.Set: isSubsetOfUniqueSet :: UniqueSet -> UniqueSet -> Bool
+ GHC.Types.Unique.Set: mapMaybeUniqSet_sameUnique :: (a -> Maybe b) -> UniqSet a -> UniqSet b
+ GHC.Types.Unique.Set: memberUniqueSet :: Unique -> UniqueSet -> Bool
+ GHC.Types.Unique.Set: newtype UniqueSet
+ GHC.Types.Unique.Set: nullUniqueSet :: UniqueSet -> Bool
+ GHC.Types.Unique.Set: singletonUniqueSet :: Unique -> UniqueSet
+ GHC.Types.Unique.Set: sizeUniqueSet :: UniqueSet -> Int
+ GHC.Types.Unique.Set: unionUniqueSet :: UniqueSet -> UniqueSet -> UniqueSet
+ GHC.Types.Unique.Set: unionsUniqueSet :: [UniqueSet] -> UniqueSet
+ GHC.Types.Var: instance (GHC.Classes.Eq var, GHC.Classes.Eq argf) => GHC.Classes.Eq (GHC.Types.Var.VarBndr var argf)
+ GHC.Types.Var: instance (GHC.Classes.Ord var, GHC.Classes.Ord argf) => GHC.Classes.Ord (GHC.Types.Var.VarBndr var argf)
+ GHC.Types.Var: instance GHC.Utils.Outputable.Outputable tv => GHC.Utils.Outputable.Outputable (GHC.Types.Var.VarBndr tv Language.Haskell.Syntax.Specificity.ForAllTyFlag)
+ GHC.Types.Var: instance GHC.Utils.Outputable.Outputable tv => GHC.Utils.Outputable.Outputable (GHC.Types.Var.VarBndr tv Language.Haskell.Syntax.Specificity.Specificity)
+ GHC.Types.Var.Set: strictFoldDVarSet :: (a -> r -> r) -> r -> UniqDSet a -> r
+ GHC.Types.Var.Set: type DCoVarSet = UniqDSet CoVar
+ GHC.Unit.External: [eps_iface_bytecode] :: ExternalPackageState -> !ModuleEnv (IO Linkable)
+ GHC.Unit.Finder.Types: [addToFinderCache] :: FinderCache -> InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()
+ GHC.Unit.Finder.Types: [flushFinderCaches] :: FinderCache -> UnitEnv -> IO ()
+ GHC.Unit.Finder.Types: [lookupFileCache] :: FinderCache -> FilePath -> IO Fingerprint
+ GHC.Unit.Finder.Types: [lookupFinderCache] :: FinderCache -> InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)
+ GHC.Unit.Finder.Types: type FileCacheState = Map FilePath Fingerprint
+ GHC.Unit.Home.ModInfo: concatHpt :: (HomeModInfo -> [a]) -> HomePackageTable -> [a]
+ GHC.Unit.Module.Env: data InstalledModuleWithIsBootEnv elt
+ GHC.Unit.Module.Env: delInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> InstalledModuleWithIsBootEnv a
+ GHC.Unit.Module.Env: emptyInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a
+ GHC.Unit.Module.Env: extendInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> a -> InstalledModuleWithIsBootEnv a
+ GHC.Unit.Module.Env: filterInstalledModuleWithIsBootEnv :: (InstalledModuleWithIsBoot -> a -> Bool) -> InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBootEnv a
+ GHC.Unit.Module.Env: installedModuleWithIsBootEnvElts :: InstalledModuleWithIsBootEnv a -> [(InstalledModuleWithIsBoot, a)]
+ GHC.Unit.Module.Env: instance GHC.Utils.Outputable.Outputable elt => GHC.Utils.Outputable.Outputable (GHC.Unit.Module.Env.InstalledModuleWithIsBootEnv elt)
+ GHC.Unit.Module.Env: lookupInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> Maybe a
+ GHC.Unit.Module.Env: mergeInstalledModuleWithIsBootEnv :: (elta -> eltb -> Maybe eltc) -> (InstalledModuleWithIsBootEnv elta -> InstalledModuleWithIsBootEnv eltc) -> (InstalledModuleWithIsBootEnv eltb -> InstalledModuleWithIsBootEnv eltc) -> InstalledModuleWithIsBootEnv elta -> InstalledModuleWithIsBootEnv eltb -> InstalledModuleWithIsBootEnv eltc
+ GHC.Unit.Module.Env: plusInstalledModuleWithIsBootEnv :: (elt -> elt -> elt) -> InstalledModuleWithIsBootEnv elt -> InstalledModuleWithIsBootEnv elt -> InstalledModuleWithIsBootEnv elt
+ GHC.Unit.Module.Location: OsPathModLocation :: Maybe OsPath -> OsPath -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation
+ GHC.Unit.Module.Location: [ml_dyn_hi_file_ospath] :: ModLocation -> OsPath
+ GHC.Unit.Module.Location: [ml_dyn_obj_file_ospath] :: ModLocation -> OsPath
+ GHC.Unit.Module.Location: [ml_hi_file_ospath] :: ModLocation -> OsPath
+ GHC.Unit.Module.Location: [ml_hie_file_ospath] :: ModLocation -> OsPath
+ GHC.Unit.Module.Location: [ml_hs_file_ospath] :: ModLocation -> Maybe OsPath
+ GHC.Unit.Module.Location: [ml_obj_file_ospath] :: ModLocation -> OsPath
+ GHC.Unit.Module.Location: mkFileSrcSpan :: ModLocation -> SrcSpan
+ GHC.Unit.Module.Location: pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
+ GHC.Unit.Module.ModDetails: [md_defaults] :: ModDetails -> !DefaultEnv
+ GHC.Unit.Module.ModGuts: [mg_defaults] :: ModGuts -> !DefaultEnv
+ GHC.Unit.Module.ModIface: IfaceImport :: ImpDeclSpec -> ImpIfaceList -> IfaceImport
+ GHC.Unit.Module.ModIface: IfaceTopEnv :: !IfGlobalRdrEnv -> ![IfaceImport] -> IfaceTopEnv
+ GHC.Unit.Module.ModIface: [FullIfaceBinHandle] :: !Maybe FullBinData -> IfaceBinHandle 'ModIfaceFinal
+ GHC.Unit.Module.ModIface: [PartialIfaceBinHandle] :: IfaceBinHandle 'ModIfaceCore
+ GHC.Unit.Module.ModIface: [ifaceImports] :: IfaceTopEnv -> ![IfaceImport]
+ GHC.Unit.Module.ModIface: [ifaceTopExports] :: IfaceTopEnv -> !IfGlobalRdrEnv
+ GHC.Unit.Module.ModIface: addSourceFingerprint :: forall (phase :: ModIfacePhase). Fingerprint -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: completePartialModIface :: PartialModIface -> [(Fingerprint, IfaceDecl)] -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIfaceBackend -> ModIface
+ GHC.Unit.Module.ModIface: data IfaceBinHandle (phase :: ModIfacePhase)
+ GHC.Unit.Module.ModIface: data IfaceImport
+ GHC.Unit.Module.ModIface: data IfaceTopEnv
+ GHC.Unit.Module.ModIface: instance Control.DeepSeq.NFData GHC.Unit.Module.ModIface.IfaceTopEnv
+ GHC.Unit.Module.ModIface: pattern ModIface :: Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] -> [IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings -> [IfaceAnnotation] -> [IfaceDeclExts phase] -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign -> [IfaceDefault] -> Maybe IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] -> AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs -> IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: restoreFromOldModIface :: forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_anns :: forall (phase :: ModIfacePhase). [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_complete_matches :: forall (phase :: ModIfacePhase). [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_decls :: forall (phase :: ModIfacePhase). [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_defaults :: forall (phase :: ModIfacePhase). [IfaceDefault] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_deps :: forall (phase :: ModIfacePhase). Dependencies -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_docs :: forall (phase :: ModIfacePhase). Maybe Docs -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_exports :: forall (phase :: ModIfacePhase). [IfaceExport] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_ext_fields :: forall (phase :: ModIfacePhase). ExtensibleFields -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_extra_decls :: forall (phase :: ModIfacePhase). Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_fam_insts :: forall (phase :: ModIfacePhase). [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_final_exts :: forall (phase :: ModIfacePhase). IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_fixities :: forall (phase :: ModIfacePhase). [(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_foreign :: forall (phase :: ModIfacePhase). IfaceForeign -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_hi_bytes :: forall (phase :: ModIfacePhase). IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_hpc :: forall (phase :: ModIfacePhase). AnyHpcUsage -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_hsc_src :: forall (phase :: ModIfacePhase). HscSource -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_insts :: forall (phase :: ModIfacePhase). [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_module :: forall (phase :: ModIfacePhase). Module -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_rules :: forall (phase :: ModIfacePhase). [IfaceRule] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_sig_of :: forall (phase :: ModIfacePhase). Maybe Module -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_src_hash :: forall (phase :: ModIfacePhase). Fingerprint -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_top_env :: forall (phase :: ModIfacePhase). Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_trust :: forall (phase :: ModIfacePhase). IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_trust_pkg :: forall (phase :: ModIfacePhase). Bool -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_usages :: forall (phase :: ModIfacePhase). [Usage] -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_used_th :: forall (phase :: ModIfacePhase). Bool -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModIface: set_mi_warns :: forall (phase :: ModIfacePhase). IfaceWarnings -> ModIface_ phase -> ModIface_ phase
+ GHC.Unit.Module.ModSummary: msDynHiFileOsPath :: ModSummary -> OsPath
+ GHC.Unit.Module.ModSummary: msDynObjFileOsPath :: ModSummary -> OsPath
+ GHC.Unit.Module.ModSummary: msHiFileOsPath :: ModSummary -> OsPath
+ GHC.Unit.Module.ModSummary: msHsFileOsPath :: ModSummary -> OsPath
+ GHC.Unit.Module.ModSummary: msObjFileOsPath :: ModSummary -> OsPath
+ GHC.Unit.Module.WholeCoreBindings: IfaceCLabel :: CStubLabel -> IfaceCLabel
+ GHC.Unit.Module.WholeCoreBindings: IfaceCStubs :: String -> String -> [IfaceCLabel] -> [IfaceCLabel] -> IfaceCStubs
+ GHC.Unit.Module.WholeCoreBindings: IfaceForeign :: Maybe IfaceCStubs -> [IfaceForeignFile] -> IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: IfaceForeignFile :: ForeignSrcLang -> String -> FilePath -> IfaceForeignFile
+ GHC.Unit.Module.WholeCoreBindings: [extension] :: IfaceForeignFile -> FilePath
+ GHC.Unit.Module.WholeCoreBindings: [files] :: IfaceForeign -> [IfaceForeignFile]
+ GHC.Unit.Module.WholeCoreBindings: [finalizers] :: IfaceCStubs -> [IfaceCLabel]
+ GHC.Unit.Module.WholeCoreBindings: [header] :: IfaceCStubs -> String
+ GHC.Unit.Module.WholeCoreBindings: [initializers] :: IfaceCStubs -> [IfaceCLabel]
+ GHC.Unit.Module.WholeCoreBindings: [lang] :: IfaceForeignFile -> ForeignSrcLang
+ GHC.Unit.Module.WholeCoreBindings: [source] :: IfaceForeignFile -> String
+ GHC.Unit.Module.WholeCoreBindings: [stubs] :: IfaceForeign -> Maybe IfaceCStubs
+ GHC.Unit.Module.WholeCoreBindings: [wcb_foreign] :: WholeCoreBindings -> IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang
+ GHC.Unit.Module.WholeCoreBindings: binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()
+ GHC.Unit.Module.WholeCoreBindings: data IfaceCStubs
+ GHC.Unit.Module.WholeCoreBindings: data IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: data IfaceForeignFile
+ GHC.Unit.Module.WholeCoreBindings: decodeIfaceForeign :: Logger -> TmpFs -> TempDir -> IfaceForeign -> IO (ForeignStubs, [(ForeignSrcLang, FilePath)])
+ GHC.Unit.Module.WholeCoreBindings: emptyIfaceForeign :: IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: encodeIfaceForeign :: Logger -> DynFlags -> ForeignStubs -> [(ForeignSrcLang, FilePath)] -> IO IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: instance Control.DeepSeq.NFData GHC.Unit.Module.WholeCoreBindings.IfaceCLabel
+ GHC.Unit.Module.WholeCoreBindings: instance Control.DeepSeq.NFData GHC.Unit.Module.WholeCoreBindings.IfaceCStubs
+ GHC.Unit.Module.WholeCoreBindings: instance Control.DeepSeq.NFData GHC.Unit.Module.WholeCoreBindings.IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: instance Control.DeepSeq.NFData GHC.Unit.Module.WholeCoreBindings.IfaceForeignFile
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Binary.Binary GHC.Unit.Module.WholeCoreBindings.IfaceCLabel
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Binary.Binary GHC.Unit.Module.WholeCoreBindings.IfaceCStubs
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Binary.Binary GHC.Unit.Module.WholeCoreBindings.IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Binary.Binary GHC.Unit.Module.WholeCoreBindings.IfaceForeignFile
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Outputable.Outputable GHC.Unit.Module.WholeCoreBindings.IfaceCLabel
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Outputable.Outputable GHC.Unit.Module.WholeCoreBindings.IfaceCStubs
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Outputable.Outputable GHC.Unit.Module.WholeCoreBindings.IfaceForeign
+ GHC.Unit.Module.WholeCoreBindings: instance GHC.Utils.Outputable.Outputable GHC.Unit.Module.WholeCoreBindings.IfaceForeignFile
+ GHC.Unit.Module.WholeCoreBindings: newtype IfaceCLabel
+ GHC.Unit.Types: instance Data.Data.Data Language.Haskell.Syntax.Module.Name.ModuleName
+ GHC.Unit.Types: notBoot :: mod -> GenWithIsBoot mod
+ GHC.Unit.Types: type InstalledModuleWithIsBoot = GenWithIsBoot InstalledModule
+ GHC.Utils.Binary: BinaryReader :: (ReadBinHandle -> IO s) -> BinaryReader s
+ GHC.Utils.Binary: BinaryWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
+ GHC.Utils.Binary: BindingName :: Name -> BindingName
+ GHC.Utils.Binary: FSTable :: !FastMutInt -> !IORef (UniqFM FastString (Int, FastString)) -> FSTable
+ GHC.Utils.Binary: FullBinData :: ReaderUserData -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !BinArray -> FullBinData
+ GHC.Utils.Binary: GenericSymbolTable :: !FastMutInt -> !IORef (m Int) -> !IORef [Key m] -> GenericSymbolTable (m :: Type -> Type)
+ GHC.Utils.Binary: ReaderTable :: (ReadBinHandle -> IO (SymbolTable a)) -> (SymbolTable a -> BinaryReader a) -> ReaderTable a
+ GHC.Utils.Binary: RelBin :: {-# UNPACK #-} !Bin a -> {-# UNPACK #-} !RelBinPtr a -> RelBin (a :: k)
+ GHC.Utils.Binary: WriterTable :: (WriteBinHandle -> IO Int) -> WriterTable
+ GHC.Utils.Binary: [fbd_buffer] :: FullBinData -> {-# UNPACK #-} !BinArray
+ GHC.Utils.Binary: [fbd_off_e] :: FullBinData -> {-# UNPACK #-} !Int
+ GHC.Utils.Binary: [fbd_off_s] :: FullBinData -> {-# UNPACK #-} !Int
+ GHC.Utils.Binary: [fbd_readerUserData] :: FullBinData -> ReaderUserData
+ GHC.Utils.Binary: [fbd_size] :: FullBinData -> {-# UNPACK #-} !Int
+ GHC.Utils.Binary: [fs_tab_map] :: FSTable -> !IORef (UniqFM FastString (Int, FastString))
+ GHC.Utils.Binary: [fs_tab_next] :: FSTable -> !FastMutInt
+ GHC.Utils.Binary: [gen_symtab_map] :: GenericSymbolTable (m :: Type -> Type) -> !IORef (m Int)
+ GHC.Utils.Binary: [gen_symtab_next] :: GenericSymbolTable (m :: Type -> Type) -> !FastMutInt
+ GHC.Utils.Binary: [gen_symtab_to_write] :: GenericSymbolTable (m :: Type -> Type) -> !IORef [Key m]
+ GHC.Utils.Binary: [getBindingName] :: BindingName -> Name
+ GHC.Utils.Binary: [getEntry] :: BinaryReader s -> ReadBinHandle -> IO s
+ GHC.Utils.Binary: [getTable] :: ReaderTable a -> ReadBinHandle -> IO (SymbolTable a)
+ GHC.Utils.Binary: [mkReaderFromTable] :: ReaderTable a -> SymbolTable a -> BinaryReader a
+ GHC.Utils.Binary: [putEntry] :: BinaryWriter s -> WriteBinHandle -> s -> IO ()
+ GHC.Utils.Binary: [putTable] :: WriterTable -> WriteBinHandle -> IO Int
+ GHC.Utils.Binary: [relBin_anchor] :: RelBin (a :: k) -> {-# UNPACK #-} !Bin a
+ GHC.Utils.Binary: [relBin_offset] :: RelBin (a :: k) -> {-# UNPACK #-} !RelBinPtr a
+ GHC.Utils.Binary: addReaderToUserData :: Typeable a => BinaryReader a -> ReadBinHandle -> ReadBinHandle
+ GHC.Utils.Binary: addWriterToUserData :: Typeable a => BinaryWriter a -> WriteBinHandle -> WriteBinHandle
+ GHC.Utils.Binary: data FullBinData
+ GHC.Utils.Binary: data GenericSymbolTable (m :: Type -> Type)
+ GHC.Utils.Binary: data ReadBinHandle
+ GHC.Utils.Binary: data ReaderTable a
+ GHC.Utils.Binary: data ReaderUserData
+ GHC.Utils.Binary: data RelBin (a :: k)
+ GHC.Utils.Binary: data SomeBinaryReader
+ GHC.Utils.Binary: data SomeBinaryWriter
+ GHC.Utils.Binary: data WriteBinHandle
+ GHC.Utils.Binary: data WriterUserData
+ GHC.Utils.Binary: findUserDataReader :: Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a
+ GHC.Utils.Binary: findUserDataWriter :: Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a
+ GHC.Utils.Binary: forwardGetRel :: ReadBinHandle -> IO a -> IO a
+ GHC.Utils.Binary: forwardPutRel :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a, b)
+ GHC.Utils.Binary: forwardPutRel_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO ()
+ GHC.Utils.Binary: freezeBinHandle :: forall {k} (a :: k). ReadBinHandle -> Bin a -> IO FullBinData
+ GHC.Utils.Binary: freezeWriteHandle :: WriteBinHandle -> IO ReadBinHandle
+ GHC.Utils.Binary: getGenericSymbolTable :: (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a)
+ GHC.Utils.Binary: getGenericSymtab :: Binary a => SymbolTable a -> ReadBinHandle -> IO a
+ GHC.Utils.Binary: getReaderUserData :: ReadBinHandle -> ReaderUserData
+ GHC.Utils.Binary: getRelBin :: forall {k} (a :: k). ReadBinHandle -> IO (RelBin a)
+ GHC.Utils.Binary: getWriterUserData :: WriteBinHandle -> WriterUserData
+ GHC.Utils.Binary: initFastStringReaderTable :: IO (ReaderTable FastString)
+ GHC.Utils.Binary: initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString)
+ GHC.Utils.Binary: initGenericSymbolTable :: forall (m :: Type -> Type). TrieMap m => IO (GenericSymbolTable m)
+ GHC.Utils.Binary: instance GHC.Base.Functor GHC.Utils.Binary.BinaryReader
+ GHC.Utils.Binary: instance GHC.Classes.Eq GHC.Utils.Binary.BindingName
+ GHC.Utils.Binary: instance GHC.Classes.Eq GHC.Utils.Binary.FullBinData
+ GHC.Utils.Binary: instance GHC.Classes.Ord GHC.Utils.Binary.FullBinData
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Classes.Eq (GHC.Utils.Binary.RelBin a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Classes.Eq (GHC.Utils.Binary.RelBinPtr a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Classes.Ord (GHC.Utils.Binary.RelBin a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Classes.Ord (GHC.Utils.Binary.RelBinPtr a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Enum.Bounded (GHC.Utils.Binary.RelBin a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Enum.Bounded (GHC.Utils.Binary.RelBinPtr a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Show.Show (GHC.Utils.Binary.RelBin a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Show.Show (GHC.Utils.Binary.RelBinPtr a)
+ GHC.Utils.Binary: instance forall k (a :: k). GHC.Utils.Binary.Binary (GHC.Utils.Binary.RelBinPtr a)
+ GHC.Utils.Binary: lazyGet' :: (ReadBinHandle -> IO a) -> ReadBinHandle -> IO a
+ GHC.Utils.Binary: lazyPut' :: (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> a -> IO ()
+ GHC.Utils.Binary: mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s
+ GHC.Utils.Binary: mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData
+ GHC.Utils.Binary: mkSomeBinaryReader :: Typeable a => BinaryReader a -> SomeBinaryReader
+ GHC.Utils.Binary: mkSomeBinaryWriter :: Typeable a => BinaryWriter a -> SomeBinaryWriter
+ GHC.Utils.Binary: mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
+ GHC.Utils.Binary: mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData
+ GHC.Utils.Binary: newtype BinaryReader s
+ GHC.Utils.Binary: newtype BinaryWriter s
+ GHC.Utils.Binary: newtype BindingName
+ GHC.Utils.Binary: newtype WriterTable
+ GHC.Utils.Binary: noReaderUserData :: ReaderUserData
+ GHC.Utils.Binary: noWriterUserData :: WriterUserData
+ GHC.Utils.Binary: putAtRel :: forall {k} (a :: k). WriteBinHandle -> Bin (RelBinPtr a) -> Bin a -> IO ()
+ GHC.Utils.Binary: putFullBinData :: WriteBinHandle -> FullBinData -> IO ()
+ GHC.Utils.Binary: putGenericSymTab :: forall (m :: Type -> Type). TrieMap m => GenericSymbolTable m -> WriteBinHandle -> Key m -> IO ()
+ GHC.Utils.Binary: putGenericSymbolTable :: forall (m :: Type -> Type). TrieMap m => GenericSymbolTable m -> (WriteBinHandle -> Key m -> IO ()) -> WriteBinHandle -> IO Int
+ GHC.Utils.Binary: seekBinReader :: forall {k} (a :: k). ReadBinHandle -> Bin a -> IO ()
+ GHC.Utils.Binary: seekBinReaderRel :: forall {k} (a :: k). ReadBinHandle -> RelBin a -> IO ()
+ GHC.Utils.Binary: seekBinWriter :: forall {k} (a :: k). WriteBinHandle -> Bin a -> IO ()
+ GHC.Utils.Binary: setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle
+ GHC.Utils.Binary: setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle
+ GHC.Utils.Binary: shrinkBinBuffer :: WriteBinHandle -> IO ReadBinHandle
+ GHC.Utils.Binary: simpleBindingNameReader :: BinaryReader Name -> BinaryReader BindingName
+ GHC.Utils.Binary: simpleBindingNameWriter :: BinaryWriter Name -> BinaryWriter BindingName
+ GHC.Utils.Binary: tellBinReader :: forall {k} (a :: k). ReadBinHandle -> IO (Bin a)
+ GHC.Utils.Binary: tellBinWriter :: forall {k} (a :: k). WriteBinHandle -> IO (Bin a)
+ GHC.Utils.Binary: thawBinHandle :: FullBinData -> IO ReadBinHandle
+ GHC.Utils.Binary: thawReadHandle :: ReadBinHandle -> IO WriteBinHandle
+ GHC.Utils.Binary: type BinArray = ForeignPtr Word8
+ GHC.Utils.FV: fvDVarSetSome :: InterestingVarFun -> FV -> DVarSet
+ GHC.Utils.Misc: any2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
+ GHC.Utils.Monad: foldMapM :: (Applicative m, Foldable t, Monoid b) => (a -> m b) -> t a -> m b
+ GHC.Utils.Monad.State.Strict: State' :: (s -> (# a, s #)) -> State s a
+ GHC.Utils.Monad.State.Strict: newtype State s a
+ GHC.Utils.Outputable: instance GHC.Utils.Outputable.Outputable Data.IntSet.Internal.IntSet
+ GHC.Utils.Outputable: instance GHC.Utils.Outputable.Outputable GHC.Internal.LanguageExtensions.Extension
+ GHC.Utils.Outputable: instance GHC.Utils.Outputable.OutputableP env ()
+ GHC.Utils.Outputable: pprWithSemis :: (a -> SDoc) -> [a] -> SDoc
+ GHC.Utils.Outputable: unquotedListWith :: SDoc -> [SDoc] -> SDoc
+ GHCi.ResolvedBCO: instance (Data.Binary.Class.Binary a, Foreign.Storable.Storable a, Data.Array.Base.IArray Data.Array.Base.UArray a) => Data.Binary.Class.Binary (GHCi.ResolvedBCO.BCOByteArray a)
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.AnnLookup
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.AnnTarget
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Bang
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.BndrVis
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Body
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Bytes
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Callconv
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Clause
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Con
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Dec
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.DecidedStrictness
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.DerivClause
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.DerivStrategy
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.DocLoc
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Exp
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.FamilyResultSig
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Fixity
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.FixityDirection
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Foreign
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.FunDep
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Guard
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Info
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.InjectivityAnn
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Inline
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Lit
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Loc
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Match
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.ModName
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Module
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.ModuleInfo
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Name
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.NameFlavour
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.NameSpace
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.NamespaceSpecifier
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.OccName
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Overlap
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Pat
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.PatSynArgs
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.PatSynDir
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Phases
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.PkgName
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Pragma
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Range
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Role
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.RuleBndr
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.RuleMatch
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Safety
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.SourceStrictness
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.SourceUnpackedness
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Specificity
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Stmt
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.TyLit
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.TySynEqn
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.Type
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary GHC.Internal.TH.Syntax.TypeFamilyHead
+ GHCi.TH.Binary: instance Data.Binary.Class.Binary flag => Data.Binary.Class.Binary (GHC.Internal.TH.Syntax.TyVarBndr flag)
+ Language.Haskell.Syntax.Basic: Fixity :: Int -> FixityDirection -> Fixity
+ Language.Haskell.Syntax.Basic: HsBang :: SrcUnpackedness -> SrcStrictness -> HsBang
+ Language.Haskell.Syntax.Basic: Infix :: LexicalFixity
+ Language.Haskell.Syntax.Basic: InfixL :: FixityDirection
+ Language.Haskell.Syntax.Basic: InfixN :: FixityDirection
+ Language.Haskell.Syntax.Basic: InfixR :: FixityDirection
+ Language.Haskell.Syntax.Basic: Prefix :: LexicalFixity
+ Language.Haskell.Syntax.Basic: data Fixity
+ Language.Haskell.Syntax.Basic: data FixityDirection
+ Language.Haskell.Syntax.Basic: data HsBang
+ Language.Haskell.Syntax.Basic: data LexicalFixity
+ Language.Haskell.Syntax.Basic: instance Data.Data.Data Language.Haskell.Syntax.Basic.Fixity
+ Language.Haskell.Syntax.Basic: instance Data.Data.Data Language.Haskell.Syntax.Basic.FixityDirection
+ Language.Haskell.Syntax.Basic: instance Data.Data.Data Language.Haskell.Syntax.Basic.HsBang
+ Language.Haskell.Syntax.Basic: instance Data.Data.Data Language.Haskell.Syntax.Basic.LexicalFixity
+ Language.Haskell.Syntax.Basic: instance GHC.Classes.Eq Language.Haskell.Syntax.Basic.Fixity
+ Language.Haskell.Syntax.Basic: instance GHC.Classes.Eq Language.Haskell.Syntax.Basic.FixityDirection
+ Language.Haskell.Syntax.Basic: instance GHC.Classes.Eq Language.Haskell.Syntax.Basic.LexicalFixity
+ Language.Haskell.Syntax.Decls: [defd_class] :: DefaultDecl pass -> Maybe (LIdP pass)
+ Language.Haskell.Syntax.Decls: [defd_defaults] :: DefaultDecl pass -> [LHsType pass]
+ Language.Haskell.Syntax.Decls: [defd_ext] :: DefaultDecl pass -> XCDefaultDecl pass
+ Language.Haskell.Syntax.Expr: HsForAll :: XForAll p -> HsForAllTelescope p -> LHsExpr p -> HsExpr p
+ Language.Haskell.Syntax.Expr: HsFunArr :: XFunArr p -> HsArrowOf (LHsExpr p) p -> LHsExpr p -> LHsExpr p -> HsExpr p
+ Language.Haskell.Syntax.Expr: HsQual :: XQual p -> XRec p [LHsExpr p] -> LHsExpr p -> HsExpr p
+ Language.Haskell.Syntax.Expr: [mc_an] :: HsMatchContext fn -> XFunRhs
+ Language.Haskell.Syntax.ImpExp: IEDefault :: XIEDefault p -> LIdP p -> IEWrappedName p
+ Language.Haskell.Syntax.ImpExp: instance Control.DeepSeq.NFData Language.Haskell.Syntax.ImpExp.ImportListInterpretation
+ Language.Haskell.Syntax.ImpExp: instance Control.DeepSeq.NFData Language.Haskell.Syntax.ImpExp.IsBootInterface
+ Language.Haskell.Syntax.Lit: HsMultilineString :: XHsMultilineString x -> FastString -> HsLit x
+ Language.Haskell.Syntax.Pat: OrPat :: XOrPat p -> NonEmpty (LPat p) -> Pat p
+ Language.Haskell.Syntax.Pat: [rec_ext] :: HsRecFields p arg -> !XHsRecFields p
+ Language.Haskell.Syntax.Specificity: InferredSpec :: Specificity
+ Language.Haskell.Syntax.Specificity: Invisible :: !Specificity -> ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: Required :: ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: SpecifiedSpec :: Specificity
+ Language.Haskell.Syntax.Specificity: coreTyLamForAllTyFlag :: ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: data ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: data Specificity
+ Language.Haskell.Syntax.Specificity: instance Data.Data.Data Language.Haskell.Syntax.Specificity.ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: instance Data.Data.Data Language.Haskell.Syntax.Specificity.Specificity
+ Language.Haskell.Syntax.Specificity: instance GHC.Classes.Eq Language.Haskell.Syntax.Specificity.ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: instance GHC.Classes.Eq Language.Haskell.Syntax.Specificity.Specificity
+ Language.Haskell.Syntax.Specificity: instance GHC.Classes.Ord Language.Haskell.Syntax.Specificity.ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: instance GHC.Classes.Ord Language.Haskell.Syntax.Specificity.Specificity
+ Language.Haskell.Syntax.Specificity: isInferredForAllTyFlag :: ForAllTyFlag -> Bool
+ Language.Haskell.Syntax.Specificity: isInvisibleForAllTyFlag :: ForAllTyFlag -> Bool
+ Language.Haskell.Syntax.Specificity: isSpecifiedForAllTyFlag :: ForAllTyFlag -> Bool
+ Language.Haskell.Syntax.Specificity: isVisibleForAllTyFlag :: ForAllTyFlag -> Bool
+ Language.Haskell.Syntax.Specificity: pattern Inferred :: ForAllTyFlag
+ Language.Haskell.Syntax.Specificity: pattern Specified :: ForAllTyFlag
+ Language.Haskell.Syntax.Type: HsBang :: SrcUnpackedness -> SrcStrictness -> HsBang
+ Language.Haskell.Syntax.Type: HsBndrKind :: !XBndrKind pass -> LHsKind pass -> HsBndrKind pass
+ Language.Haskell.Syntax.Type: HsBndrNoKind :: !XBndrNoKind pass -> HsBndrKind pass
+ Language.Haskell.Syntax.Type: HsBndrVar :: !XBndrVar pass -> !LIdP pass -> HsBndrVar pass
+ Language.Haskell.Syntax.Type: HsBndrWildCard :: !XBndrWildCard pass -> HsBndrVar pass
+ Language.Haskell.Syntax.Type: HsTvb :: XTyVarBndr pass -> flag -> HsBndrVar pass -> HsBndrKind pass -> HsTyVarBndr flag pass
+ Language.Haskell.Syntax.Type: XBndrKind :: !XXBndrKind pass -> HsBndrKind pass
+ Language.Haskell.Syntax.Type: XBndrVar :: !XXBndrVar pass -> HsBndrVar pass
+ Language.Haskell.Syntax.Type: XBndrVis :: !XXBndrVis pass -> HsBndrVis pass
+ Language.Haskell.Syntax.Type: [tvb_ext] :: HsTyVarBndr flag pass -> XTyVarBndr pass
+ Language.Haskell.Syntax.Type: [tvb_flag] :: HsTyVarBndr flag pass -> flag
+ Language.Haskell.Syntax.Type: [tvb_kind] :: HsTyVarBndr flag pass -> HsBndrKind pass
+ Language.Haskell.Syntax.Type: [tvb_var] :: HsTyVarBndr flag pass -> HsBndrVar pass
+ Language.Haskell.Syntax.Type: data HsArrowOf mult pass
+ Language.Haskell.Syntax.Type: data HsBang
+ Language.Haskell.Syntax.Type: data HsBndrKind pass
+ Language.Haskell.Syntax.Type: data HsBndrVar pass
+ Language.Haskell.Syntax.Type: instance (GHC.Classes.Eq (Language.Haskell.Syntax.Extension.LIdP pass), GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XCFieldOcc pass), GHC.Classes.Eq (Language.Haskell.Syntax.Extension.XXFieldOcc pass)) => GHC.Classes.Eq (Language.Haskell.Syntax.Type.FieldOcc pass)
+ Language.Haskell.Syntax.Type: instance GHC.Classes.Ord Language.Haskell.Syntax.Type.PromotionFlag
+ Language.Haskell.Syntax.Type: isHsBndrWildCard :: HsBndrVar pass -> Bool
+ Language.Haskell.Syntax.Type: type HsArrow pass = HsArrowOf LHsType pass pass
- GHC.Builtin.PrimOps: primOpDocs :: [(String, String)]
+ GHC.Builtin.PrimOps: primOpDocs :: [(FastString, String)]
- GHC.ByteCode.Types: CompiledByteCode :: [UnlinkedBCO] -> ItblEnv -> [FFIInfo] -> AddrEnv -> Maybe ModBreaks -> CompiledByteCode
+ GHC.ByteCode.Types: CompiledByteCode :: FlatBag UnlinkedBCO -> ItblEnv -> [FFIInfo] -> AddrEnv -> Maybe ModBreaks -> ![SptEntry] -> CompiledByteCode
- GHC.ByteCode.Types: [bc_bcos] :: CompiledByteCode -> [UnlinkedBCO]
+ GHC.ByteCode.Types: [bc_bcos] :: CompiledByteCode -> FlatBag UnlinkedBCO
- GHC.Cmm: CmmGraph :: BlockId -> Graph n C C -> GenCmmGraph (n :: Extensibility -> Extensibility -> Type)
+ GHC.Cmm: CmmGraph :: BlockId -> Graph' s Block n C C -> GenGenCmmGraph (s :: Type -> Type) (n :: Extensibility -> Extensibility -> Type)
- GHC.Cmm: CmmProc :: h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
+ GHC.Cmm: CmmProc :: h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
- GHC.Cmm: TopInfo :: LabelMap CmmInfoTable -> CmmStackInfo -> CmmTopInfo
+ GHC.Cmm: TopInfo :: f CmmInfoTable -> CmmStackInfo -> GenCmmTopInfo (f :: Type -> Type)
- GHC.Cmm: [g_entry] :: GenCmmGraph (n :: Extensibility -> Extensibility -> Type) -> BlockId
+ GHC.Cmm: [g_entry] :: GenGenCmmGraph (s :: Type -> Type) (n :: Extensibility -> Extensibility -> Type) -> BlockId
- GHC.Cmm: [g_graph] :: GenCmmGraph (n :: Extensibility -> Extensibility -> Type) -> Graph n C C
+ GHC.Cmm: [g_graph] :: GenGenCmmGraph (s :: Type -> Type) (n :: Extensibility -> Extensibility -> Type) -> Graph' s Block n C C
- GHC.Cmm: [info_tbls] :: CmmTopInfo -> LabelMap CmmInfoTable
+ GHC.Cmm: [info_tbls] :: GenCmmTopInfo (f :: Type -> Type) -> f CmmInfoTable
- GHC.Cmm: [stack_info] :: CmmTopInfo -> CmmStackInfo
+ GHC.Cmm: [stack_info] :: GenCmmTopInfo (f :: Type -> Type) -> CmmStackInfo
- GHC.Cmm: topInfoTable :: forall a (n :: Extensibility -> Extensibility -> Type). GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
+ GHC.Cmm: topInfoTable :: forall a (s :: Type -> Type) (n :: Extensibility -> Extensibility -> Type). GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
- GHC.Cmm.BlockId: newBlockId :: MonadUnique m => m BlockId
+ GHC.Cmm.BlockId: newBlockId :: MonadGetUnique m => m BlockId
- GHC.Cmm.CLabel: mkForeignLabel :: FastString -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
+ GHC.Cmm.CLabel: mkForeignLabel :: FastString -> ForeignLabelSource -> FunctionOrData -> CLabel
- GHC.Cmm.Dataflow.Graph: [GMany] :: forall (e :: Extensibility) (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (x :: Extensibility). MaybeO e (block n O C) -> Body' block n -> MaybeO x (block n C O) -> Graph' block n e x
+ GHC.Cmm.Dataflow.Graph: [GMany] :: forall (e :: Extensibility) (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (s :: Type -> Type) (x :: Extensibility). MaybeO e (block n O C) -> Body' s block n -> MaybeO x (block n C O) -> Graph' s block n e x
- GHC.Cmm.Dataflow.Graph: [GNil] :: forall (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type). Graph' block n 'Open 'Open
+ GHC.Cmm.Dataflow.Graph: [GNil] :: forall (s :: Type -> Type) (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type). Graph' s block n 'Open 'Open
- GHC.Cmm.Dataflow.Graph: [GUnit] :: forall (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type). block n O O -> Graph' block n 'Open 'Open
+ GHC.Cmm.Dataflow.Graph: [GUnit] :: forall (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (s :: Type -> Type). block n O O -> Graph' s block n 'Open 'Open
- GHC.Cmm.Dataflow.Graph: bodyList :: forall block (n :: Extensibility -> Extensibility -> Type). Body' block n -> [(Label, block n C C)]
+ GHC.Cmm.Dataflow.Graph: bodyList :: forall block (n :: Extensibility -> Extensibility -> Type). Body' LabelMap block n -> [(Label, block n C C)]
- GHC.Cmm.Dataflow.Graph: bodyToBlockList :: forall (n :: Extensibility -> Extensibility -> Type). Body n -> [Block n C C]
+ GHC.Cmm.Dataflow.Graph: bodyToBlockList :: forall (n :: Extensibility -> Extensibility -> Type). Body LabelMap n -> [Block n C C]
- GHC.Cmm.Dataflow.Graph: data Graph' (block :: Extensibility -> Extensibility -> Type -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility)
+ GHC.Cmm.Dataflow.Graph: data Graph' (s :: Type -> Type) (block :: Extensibility -> Extensibility -> Type -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility)
- GHC.Cmm.Dataflow.Graph: emptyBody :: forall block (n :: Extensibility -> Extensibility -> Type). Body' block n
+ GHC.Cmm.Dataflow.Graph: emptyBody :: forall block (n :: Extensibility -> Extensibility -> Type). Body' LabelMap block n
- GHC.Cmm.Dataflow.Graph: labelsDefined :: forall (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility). NonLocal (block n) => Graph' block n e x -> LabelSet
+ GHC.Cmm.Dataflow.Graph: labelsDefined :: forall (block :: (Extensibility -> Extensibility -> Type) -> Extensibility -> Extensibility -> Type) (n :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility). NonLocal (block n) => Graph' LabelMap block n e x -> LabelSet
- GHC.Cmm.Dataflow.Graph: mapGraphBlocks :: forall block (n :: Extensibility -> Extensibility -> Type) block' (n' :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility). (forall (e1 :: Extensibility) (x1 :: Extensibility). () => block n e1 x1 -> block' n' e1 x1) -> Graph' block n e x -> Graph' block' n' e x
+ GHC.Cmm.Dataflow.Graph: mapGraphBlocks :: forall s block (n :: Extensibility -> Extensibility -> Type) block' (n' :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility). (forall a b. () => (a -> b) -> s a -> s b) -> (forall (e1 :: Extensibility) (x1 :: Extensibility). () => block n e1 x1 -> block' n' e1 x1) -> Graph' s block n e x -> Graph' s block' n' e x
- GHC.Cmm.Dataflow.Graph: type Body (n :: Extensibility -> Extensibility -> Type) = LabelMap Block n C C
+ GHC.Cmm.Dataflow.Graph: type Body (s :: Type -> k) (n :: Extensibility -> Extensibility -> Type) = Body' s Block n
- GHC.Cmm.Dataflow.Graph: type Graph = Graph' Block
+ GHC.Cmm.Dataflow.Graph: type Graph = Graph' LabelMap Block
- GHC.Cmm.MachOp: MO_FMA :: FMASign -> Width -> MachOp
+ GHC.Cmm.MachOp: MO_FMA :: FMASign -> Length -> Width -> MachOp
- GHC.Cmm.Node: [CmmCall] :: CmmExpr -> Maybe Label -> [GlobalReg] -> ByteOff -> ByteOff -> ByteOff -> CmmNode 'Open 'Closed
+ GHC.Cmm.Node: [CmmCall] :: CmmExpr -> Maybe Label -> [GlobalRegUse] -> ByteOff -> ByteOff -> ByteOff -> CmmNode 'Open 'Closed
- GHC.Core.Coercion: buildCoercion :: Type -> Type -> CoercionN
+ GHC.Core.Coercion: buildCoercion :: HasDebugCallStack => Type -> Type -> CoercionN
- GHC.Core.Coercion: coercionKind :: Coercion -> Pair Type
+ GHC.Core.Coercion: coercionKind :: HasDebugCallStack => Coercion -> Pair Type
- GHC.Core.Coercion: coercionLKind :: Coercion -> Type
+ GHC.Core.Coercion: coercionLKind :: HasDebugCallStack => Coercion -> Type
- GHC.Core.Coercion: coercionRKind :: Coercion -> Type
+ GHC.Core.Coercion: coercionRKind :: HasDebugCallStack => Coercion -> Type
- GHC.Core.Coercion: mkAxInstCo :: forall (br :: BranchFlag). Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Coercion
+ GHC.Core.Coercion: mkAxInstCo :: Role -> CoAxiomRule -> [Type] -> [Coercion] -> Coercion
- GHC.Core.Coercion: mkCoherenceRightCo :: Role -> Type -> CoercionN -> Coercion -> Coercion
+ GHC.Core.Coercion: mkCoherenceRightCo :: HasDebugCallStack => Role -> Type -> CoercionN -> Coercion -> Coercion
- GHC.Core.Coercion: mkTransCo :: Coercion -> Coercion -> Coercion
+ GHC.Core.Coercion: mkTransCo :: HasDebugCallStack => Coercion -> Coercion -> Coercion
- GHC.Core.Coercion: mkUnivCo :: UnivCoProvenance -> Role -> Type -> Type -> Coercion
+ GHC.Core.Coercion: mkUnivCo :: UnivCoProvenance -> [Coercion] -> Role -> Type -> Type -> Coercion
- GHC.Core.Coercion: substForAllCoBndrUsingLC :: Bool -> (Coercion -> Coercion) -> LiftingContext -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)
+ GHC.Core.Coercion: substForAllCoBndrUsingLC :: SwapFlag -> (Coercion -> Coercion) -> LiftingContext -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)
- GHC.Core.Coercion.Axiom: BuiltInSynFamily :: ([Type] -> Maybe (CoAxiomRule, [Type], Type)) -> ([Type] -> Type -> [TypeEqn]) -> ([Type] -> Type -> [Type] -> Type -> [TypeEqn]) -> BuiltInSynFamily
+ GHC.Core.Coercion.Axiom: BuiltInSynFamily :: [BuiltInFamRewrite] -> [BuiltInFamInjectivity] -> BuiltInSynFamily
- GHC.Core.Coercion.Axiom: [sfMatchFam] :: BuiltInSynFamily -> [Type] -> Maybe (CoAxiomRule, [Type], Type)
+ GHC.Core.Coercion.Axiom: [sfMatchFam] :: BuiltInSynFamily -> [BuiltInFamRewrite]
- GHC.Core.DataCon: HsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
+ GHC.Core.DataCon: HsSrcBang :: SourceText -> HsBang -> HsSrcBang
- GHC.Core.InstEnv: NoUnifiers :: Canonical -> PotentialUnifiers
+ GHC.Core.InstEnv: NoUnifiers :: CanonicalEvidence -> PotentialUnifiers
- GHC.Core.Opt.Arity: pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion -> Maybe (DataCon, [Type], [CoreExpr])
+ GHC.Core.Opt.Arity: pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion -> Maybe (DataCon, [Type], [CoreExpr])
- GHC.Core.Opt.Monad: FloatOutSwitches :: Maybe Int -> Bool -> Bool -> Bool -> FloatOutSwitches
+ GHC.Core.Opt.Monad: FloatOutSwitches :: Maybe Int -> Bool -> Bool -> Bool -> Bool -> FloatOutSwitches
- GHC.Core.Opt.Simplify.Env: SimplEnv :: !SimplMode -> !(FamInstEnv, FamInstEnv) -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> !UnVarSet -> !InScopeSet -> !Int -> SimplEnv
+ GHC.Core.Opt.Simplify.Env: SimplEnv :: !SimplMode -> !(FamInstEnv, FamInstEnv) -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> !UnVarSet -> !InScopeSet -> !Int -> !Int -> SimplEnv
- GHC.Core.Opt.Simplify.Inline: callSiteInline :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> Bool -> [ArgSummary] -> CallCtxt -> Maybe CoreExpr
+ GHC.Core.Opt.Simplify.Inline: callSiteInline :: SimplEnv -> Logger -> Id -> Bool -> [ArgSummary] -> CallCtxt -> Maybe CoreExpr
- GHC.Core.Opt.Simplify.Utils: CastIt :: OutCoercion -> SimplCont -> SimplCont
+ GHC.Core.Opt.Simplify.Utils: CastIt :: OutCoercion -> Bool -> SimplCont -> SimplCont
- GHC.Core.Opt.Simplify.Utils: postInlineUnconditionally :: SimplEnv -> BindContext -> OutId -> OccInfo -> OutExpr -> Bool
+ GHC.Core.Opt.Simplify.Utils: postInlineUnconditionally :: SimplEnv -> BindContext -> InId -> OutId -> OutExpr -> Bool
- GHC.Core.Predicate: mentionsIP :: (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool
+ GHC.Core.Predicate: mentionsIP :: Type -> Class -> [Type] -> Bool
- GHC.Core.TyCo.Compare: eqType :: Type -> Type -> Bool
+ GHC.Core.TyCo.Compare: eqType :: HasCallStack => Type -> Type -> Bool
- GHC.Core.TyCo.Compare: eqTypeX :: RnEnv2 -> Type -> Type -> Bool
+ GHC.Core.TyCo.Compare: eqTypeX :: HasCallStack => RnEnv2 -> Type -> Type -> Bool
- GHC.Core.TyCo.Compare: eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
+ GHC.Core.TyCo.Compare: eqVarBndrs :: HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
- GHC.Core.TyCo.Rep: PhantomProv :: KindCoercion -> UnivCoProvenance
+ GHC.Core.TyCo.Rep: PhantomProv :: UnivCoProvenance
- GHC.Core.TyCo.Rep: ProofIrrelProv :: KindCoercion -> UnivCoProvenance
+ GHC.Core.TyCo.Rep: ProofIrrelProv :: UnivCoProvenance
- GHC.Core.TyCo.Rep: UnivCo :: UnivCoProvenance -> Role -> Type -> Type -> Coercion
+ GHC.Core.TyCo.Rep: UnivCo :: UnivCoProvenance -> Role -> Type -> Type -> [Coercion] -> Coercion
- GHC.Core.TyCo.Subst: substForAllCoBndrUsing :: Bool -> (Coercion -> Coercion) -> Subst -> TyCoVar -> KindCoercion -> (Subst, TyCoVar, KindCoercion)
+ GHC.Core.TyCo.Subst: substForAllCoBndrUsing :: SwapFlag -> (Coercion -> Coercion) -> Subst -> TyCoVar -> KindCoercion -> (Subst, TyCoVar, KindCoercion)
- GHC.Core.TyCo.Tidy: tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
+ GHC.Core.TyCo.Tidy: tidyOpenType :: TidyEnv -> Type -> Type
- GHC.Core.TyCo.Tidy: tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
+ GHC.Core.TyCo.Tidy: tidyOpenTypes :: TidyEnv -> [Type] -> [Type]
- GHC.Core.Type: tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])
+ GHC.Core.Type: tcSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
- GHC.Core.Type: tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
+ GHC.Core.Type: tidyOpenType :: TidyEnv -> Type -> Type
- GHC.Core.Type: tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
+ GHC.Core.Type: tidyOpenTypes :: TidyEnv -> [Type] -> [Type]
- GHC.Core.Type: tyConAppArgs :: HasCallStack => Type -> [Type]
+ GHC.Core.Type: tyConAppArgs :: HasDebugCallStack => Type -> [Type]
- GHC.Core.Unfold: calcUnfoldingGuidance :: UnfoldingOpts -> Bool -> CoreExpr -> UnfoldingGuidance
+ GHC.Core.Unfold: calcUnfoldingGuidance :: UnfoldingOpts -> Bool -> Bool -> CoreExpr -> UnfoldingGuidance
- GHC.Core.Unfold.Make: mkUnfolding :: UnfoldingOpts -> UnfoldingSource -> Bool -> Bool -> CoreExpr -> Maybe UnfoldingCache -> Unfolding
+ GHC.Core.Unfold.Make: mkUnfolding :: UnfoldingOpts -> UnfoldingSource -> Bool -> Bool -> Bool -> CoreExpr -> Maybe UnfoldingCache -> Unfolding
- GHC.CoreToIface: toIfaceTyVar :: TyVar -> FastString
+ GHC.CoreToIface: toIfaceTyVar :: TyVar -> IfLclName
- GHC.Data.Maybe: expectJust :: HasCallStack => String -> Maybe a -> a
+ GHC.Data.Maybe: expectJust :: HasDebugCallStack => String -> Maybe a -> a
- GHC.Data.Word64Set: unions :: Foldable f => f Word64Set -> Word64Set
+ GHC.Data.Word64Set: unions :: [Word64Set] -> Word64Set
- GHC.Data.Word64Set.Internal: unions :: Foldable f => f Word64Set -> Word64Set
+ GHC.Data.Word64Set.Internal: unions :: [Word64Set] -> Word64Set
- GHC.Driver.DynFlags: DynFlags :: GhcMode -> GhcLink -> !Backend -> {-# UNPACK #-} !GhcNameVersion -> {-# UNPACK #-} !FileSettings -> Platform -> {-# UNPACK #-} !ToolSettings -> {-# UNPACK #-} !PlatformMisc -> [(String, String)] -> TempDir -> Int -> Int -> Int -> Int -> Int -> Maybe String -> [Int] -> Maybe ParMakeCount -> Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Int -> Int -> Int -> !Int -> Maybe Int -> Maybe Int -> Int -> Maybe Word -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Int -> Int -> [FilePath] -> ModuleName -> Maybe String -> IntWithInf -> IntWithInf -> Int -> Int -> Int -> UnitId -> Maybe UnitId -> [(ModuleName, Module)] -> Maybe FilePath -> Maybe String -> Set ModuleName -> Set ModuleName -> Ways -> Maybe (String, Int) -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> String -> String -> String -> String -> String -> String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> DynLibLoader -> !Bool -> FilePath -> Maybe FilePath -> [Option] -> IncludeSpecs -> [String] -> [String] -> [String] -> Maybe String -> RtsOptsEnabled -> Bool -> String -> [ModuleName] -> [(ModuleName, String)] -> [String] -> [ExternalPluginSpec] -> FilePath -> Bool -> Bool -> [ModuleName] -> [String] -> [PackageDBFlag] -> [IgnorePackageFlag] -> [PackageFlag] -> [PackageFlag] -> [TrustFlag] -> Maybe FilePath -> EnumSet DumpFlag -> EnumSet GeneralFlag -> EnumSet WarningFlag -> EnumSet WarningFlag -> WarningCategorySet -> WarningCategorySet -> Maybe Language -> SafeHaskellMode -> Bool -> Bool -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> [OnOff Extension] -> EnumSet Extension -> !UnfoldingOpts -> Int -> Int -> Int -> FlushOut -> Maybe FilePath -> Maybe String -> [String] -> Int -> Int -> Bool -> OverridingBool -> Bool -> OverridingBool -> Bool -> Scheme -> ProfAuto -> [CallerCcFilter] -> Maybe String -> Maybe SseVersion -> Maybe BmiVersion -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Int -> Int -> Int -> Bool -> Maybe Int -> Word64 -> Int -> Weights -> DynFlags
+ GHC.Driver.DynFlags: DynFlags :: GhcMode -> GhcLink -> !Backend -> {-# UNPACK #-} !GhcNameVersion -> {-# UNPACK #-} !FileSettings -> Platform -> {-# UNPACK #-} !ToolSettings -> {-# UNPACK #-} !PlatformMisc -> [(String, String)] -> TempDir -> Int -> Int -> Int -> Int -> Int -> Maybe String -> [Int] -> Maybe ParMakeCount -> Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Int -> Int -> Int -> !Int -> Int -> Maybe Int -> Maybe Int -> Int -> Maybe Word -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Int -> Int -> [FilePath] -> ModuleName -> Maybe String -> IntWithInf -> IntWithInf -> Int -> Int -> Int -> UnitId -> Maybe UnitId -> [(ModuleName, Module)] -> Maybe FilePath -> Maybe String -> Set ModuleName -> [ReexportedModule] -> Ways -> Maybe (String, Int) -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> String -> String -> String -> String -> String -> String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> DynLibLoader -> !Bool -> FilePath -> Maybe FilePath -> [Option] -> IncludeSpecs -> [String] -> [String] -> [String] -> Maybe String -> RtsOptsEnabled -> Bool -> String -> [ModuleName] -> [(ModuleName, String)] -> [String] -> [ExternalPluginSpec] -> FilePath -> Bool -> Bool -> [ModuleName] -> [String] -> [PackageDBFlag] -> [IgnorePackageFlag] -> [PackageFlag] -> [PackageFlag] -> [TrustFlag] -> Maybe FilePath -> EnumSet DumpFlag -> EnumSet GeneralFlag -> EnumSet WarningFlag -> EnumSet WarningFlag -> WarningCategorySet -> WarningCategorySet -> Maybe Language -> SafeHaskellMode -> Bool -> Bool -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> [OnOff Extension] -> EnumSet Extension -> !UnfoldingOpts -> Int -> Int -> Int -> FlushOut -> Maybe FilePath -> Maybe String -> [String] -> Int -> Int -> Bool -> OverridingBool -> Bool -> OverridingBool -> Bool -> Scheme -> ProfAuto -> [CallerCcFilter] -> Maybe String -> Maybe SseVersion -> Maybe BmiVersion -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Int -> Int -> Int -> Bool -> Maybe Int -> Word64 -> Int -> Weights -> DynFlags
- GHC.Driver.DynFlags: [reexportedModules] :: DynFlags -> Set ModuleName
+ GHC.Driver.DynFlags: [reexportedModules] :: DynFlags -> [ReexportedModule]
- GHC.Driver.Env: hptCompleteSigs :: HscEnv -> [CompleteMatch]
+ GHC.Driver.Env: hptCompleteSigs :: HscEnv -> CompleteMatches
- GHC.Driver.Errors.Types: [DriverUnknownReexportedModules] :: UnitId -> [ModuleName] -> DriverMessage
+ GHC.Driver.Errors.Types: [DriverUnknownReexportedModules] :: UnitId -> [ReexportedModule] -> DriverMessage
- GHC.Driver.Hooks: cmmToRawCmmHook :: Hooks -> forall a. () => Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a))
+ GHC.Driver.Hooks: cmmToRawCmmHook :: Hooks -> forall a. () => Maybe (DynFlags -> Maybe Module -> CgStream CmmGroupSRTs a -> IO (CgStream RawCmmGroup a))
- GHC.Driver.Hooks: stgToCmmHook :: Hooks -> Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos)
+ GHC.Driver.Hooks: stgToCmmHook :: Hooks -> Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos)
- GHC.Driver.Plugins: StaticPlugin :: PluginWithArgs -> StaticPlugin
+ GHC.Driver.Plugins: StaticPlugin :: PluginWithArgs -> Bool -> StaticPlugin
- GHC.Driver.Session: DynFlags :: GhcMode -> GhcLink -> !Backend -> {-# UNPACK #-} !GhcNameVersion -> {-# UNPACK #-} !FileSettings -> Platform -> {-# UNPACK #-} !ToolSettings -> {-# UNPACK #-} !PlatformMisc -> [(String, String)] -> TempDir -> Int -> Int -> Int -> Int -> Int -> Maybe String -> [Int] -> Maybe ParMakeCount -> Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Int -> Int -> Int -> !Int -> Maybe Int -> Maybe Int -> Int -> Maybe Word -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Int -> Int -> [FilePath] -> ModuleName -> Maybe String -> IntWithInf -> IntWithInf -> Int -> Int -> Int -> UnitId -> Maybe UnitId -> [(ModuleName, Module)] -> Maybe FilePath -> Maybe String -> Set ModuleName -> Set ModuleName -> Ways -> Maybe (String, Int) -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> String -> String -> String -> String -> String -> String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> DynLibLoader -> !Bool -> FilePath -> Maybe FilePath -> [Option] -> IncludeSpecs -> [String] -> [String] -> [String] -> Maybe String -> RtsOptsEnabled -> Bool -> String -> [ModuleName] -> [(ModuleName, String)] -> [String] -> [ExternalPluginSpec] -> FilePath -> Bool -> Bool -> [ModuleName] -> [String] -> [PackageDBFlag] -> [IgnorePackageFlag] -> [PackageFlag] -> [PackageFlag] -> [TrustFlag] -> Maybe FilePath -> EnumSet DumpFlag -> EnumSet GeneralFlag -> EnumSet WarningFlag -> EnumSet WarningFlag -> WarningCategorySet -> WarningCategorySet -> Maybe Language -> SafeHaskellMode -> Bool -> Bool -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> [OnOff Extension] -> EnumSet Extension -> !UnfoldingOpts -> Int -> Int -> Int -> FlushOut -> Maybe FilePath -> Maybe String -> [String] -> Int -> Int -> Bool -> OverridingBool -> Bool -> OverridingBool -> Bool -> Scheme -> ProfAuto -> [CallerCcFilter] -> Maybe String -> Maybe SseVersion -> Maybe BmiVersion -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Int -> Int -> Int -> Bool -> Maybe Int -> Word64 -> Int -> Weights -> DynFlags
+ GHC.Driver.Session: DynFlags :: GhcMode -> GhcLink -> !Backend -> {-# UNPACK #-} !GhcNameVersion -> {-# UNPACK #-} !FileSettings -> Platform -> {-# UNPACK #-} !ToolSettings -> {-# UNPACK #-} !PlatformMisc -> [(String, String)] -> TempDir -> Int -> Int -> Int -> Int -> Int -> Maybe String -> [Int] -> Maybe ParMakeCount -> Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Int -> Int -> Int -> !Int -> Int -> Maybe Int -> Maybe Int -> Int -> Maybe Word -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Int -> Int -> [FilePath] -> ModuleName -> Maybe String -> IntWithInf -> IntWithInf -> Int -> Int -> Int -> UnitId -> Maybe UnitId -> [(ModuleName, Module)] -> Maybe FilePath -> Maybe String -> Set ModuleName -> [ReexportedModule] -> Ways -> Maybe (String, Int) -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> String -> String -> String -> String -> String -> String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> DynLibLoader -> !Bool -> FilePath -> Maybe FilePath -> [Option] -> IncludeSpecs -> [String] -> [String] -> [String] -> Maybe String -> RtsOptsEnabled -> Bool -> String -> [ModuleName] -> [(ModuleName, String)] -> [String] -> [ExternalPluginSpec] -> FilePath -> Bool -> Bool -> [ModuleName] -> [String] -> [PackageDBFlag] -> [IgnorePackageFlag] -> [PackageFlag] -> [PackageFlag] -> [TrustFlag] -> Maybe FilePath -> EnumSet DumpFlag -> EnumSet GeneralFlag -> EnumSet WarningFlag -> EnumSet WarningFlag -> WarningCategorySet -> WarningCategorySet -> Maybe Language -> SafeHaskellMode -> Bool -> Bool -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> [OnOff Extension] -> EnumSet Extension -> !UnfoldingOpts -> Int -> Int -> Int -> FlushOut -> Maybe FilePath -> Maybe String -> [String] -> Int -> Int -> Bool -> OverridingBool -> Bool -> OverridingBool -> Bool -> Scheme -> ProfAuto -> [CallerCcFilter] -> Maybe String -> Maybe SseVersion -> Maybe BmiVersion -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Int -> Int -> Int -> Bool -> Maybe Int -> Word64 -> Int -> Weights -> DynFlags
- GHC.Driver.Session: PlatformMisc :: String -> Bool -> Bool -> String -> PlatformMisc
+ GHC.Driver.Session: PlatformMisc :: String -> Bool -> Bool -> String -> Bool -> PlatformMisc
- GHC.Driver.Session: [reexportedModules] :: DynFlags -> Set ModuleName
+ GHC.Driver.Session: [reexportedModules] :: DynFlags -> [ReexportedModule]
- GHC.Hs: AnnsModule :: [AddEpAnn] -> [TrailingAnn] -> [LEpaComment] -> Maybe (RealSrcSpan, RealSrcSpan) -> AnnsModule
+ GHC.Hs: AnnsModule :: EpToken "signature" -> EpToken "module" -> EpToken "where" -> [TrailingAnn] -> [LEpaComment] -> Maybe (RealSrcSpan, RealSrcSpan) -> AnnsModule
- GHC.Hs.Binds: AnnSig :: AddEpAnn -> [AddEpAnn] -> AnnSig
+ GHC.Hs.Binds: AnnSig :: EpUniToken "::" "\8759" -> Maybe (EpToken "pattern") -> Maybe (EpToken "default") -> AnnSig
- GHC.Hs.Binds: [asDcolon] :: AnnSig -> AddEpAnn
+ GHC.Hs.Binds: [asDcolon] :: AnnSig -> EpUniToken "::" "\8759"
- GHC.Hs.Decls: DefaultDecl :: XCDefaultDecl pass -> [LHsType pass] -> DefaultDecl pass
+ GHC.Hs.Decls: DefaultDecl :: XCDefaultDecl pass -> Maybe (LIdP pass) -> [LHsType pass] -> DefaultDecl pass
- GHC.Hs.Decls: HsRuleAnn :: Maybe (AddEpAnn, AddEpAnn) -> Maybe (AddEpAnn, AddEpAnn) -> [AddEpAnn] -> HsRuleAnn
+ GHC.Hs.Decls: HsRuleAnn :: Maybe (TokForall, EpToken ".") -> Maybe (TokForall, EpToken ".") -> EpToken "=" -> ActivationAnn -> HsRuleAnn
- GHC.Hs.Decls: XViaStrategyPs :: [AddEpAnn] -> LHsSigType GhcPs -> XViaStrategyPs
+ GHC.Hs.Decls: XViaStrategyPs :: EpToken "via" -> LHsSigType GhcPs -> XViaStrategyPs
- GHC.Hs.Decls: [ra_rest] :: HsRuleAnn -> [AddEpAnn]
+ GHC.Hs.Decls: [ra_rest] :: HsRuleAnn -> ActivationAnn
- GHC.Hs.Decls: [ra_tmanns] :: HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
+ GHC.Hs.Decls: [ra_tmanns] :: HsRuleAnn -> Maybe (TokForall, EpToken ".")
- GHC.Hs.Decls: [ra_tyanns] :: HsRuleAnn -> Maybe (AddEpAnn, AddEpAnn)
+ GHC.Hs.Decls: [ra_tyanns] :: HsRuleAnn -> Maybe (TokForall, EpToken ".")
- GHC.Hs.Doc: DsiExports :: !Avails -> DocStructureItem
+ GHC.Hs.Doc: DsiExports :: !DetOrdAvails -> DocStructureItem
- GHC.Hs.Doc: DsiModExport :: !NonEmpty ModuleName -> !Avails -> DocStructureItem
+ GHC.Hs.Doc: DsiModExport :: !NonEmpty ModuleName -> !DetOrdAvails -> DocStructureItem
- GHC.Hs.Expr: AnnExplicitSum :: EpaLocation -> [EpaLocation] -> [EpaLocation] -> EpaLocation -> AnnExplicitSum
+ GHC.Hs.Expr: AnnExplicitSum :: EpaLocation -> [EpToken "|"] -> [EpToken "|"] -> EpaLocation -> AnnExplicitSum
- GHC.Hs.Expr: AnnFieldLabel :: Maybe EpaLocation -> AnnFieldLabel
+ GHC.Hs.Expr: AnnFieldLabel :: Maybe (EpToken ".") -> AnnFieldLabel
- GHC.Hs.Expr: AnnProjection :: EpaLocation -> EpaLocation -> AnnProjection
+ GHC.Hs.Expr: AnnProjection :: EpToken "(" -> EpToken ")" -> AnnProjection
- GHC.Hs.Expr: AnnsIf :: EpaLocation -> EpaLocation -> EpaLocation -> Maybe EpaLocation -> Maybe EpaLocation -> AnnsIf
+ GHC.Hs.Expr: AnnsIf :: EpToken "if" -> EpToken "then" -> EpToken "else" -> Maybe (EpToken ";") -> Maybe (EpToken ";") -> AnnsIf
- GHC.Hs.Expr: EpAnnHsCase :: EpaLocation -> EpaLocation -> [AddEpAnn] -> EpAnnHsCase
+ GHC.Hs.Expr: EpAnnHsCase :: EpToken "case" -> EpToken "of" -> EpAnnHsCase
- GHC.Hs.Expr: EpAnnUnboundVar :: (EpaLocation, EpaLocation) -> EpaLocation -> EpAnnUnboundVar
+ GHC.Hs.Expr: EpAnnUnboundVar :: (EpToken "`", EpToken "`") -> EpToken "_" -> EpAnnUnboundVar
- GHC.Hs.Expr: GrhsAnn :: Maybe EpaLocation -> AddEpAnn -> GrhsAnn
+ GHC.Hs.Expr: GrhsAnn :: Maybe (EpToken "|") -> Either (EpToken "=") TokRarrow -> GrhsAnn
- GHC.Hs.Expr: WrapExpr :: {-# UNPACK #-} !HsWrap HsExpr -> XXExprGhcTc
+ GHC.Hs.Expr: WrapExpr :: HsWrapper -> HsExpr GhcTc -> XXExprGhcTc
- GHC.Hs.Expr: [aesBarsAfter] :: AnnExplicitSum -> [EpaLocation]
+ GHC.Hs.Expr: [aesBarsAfter] :: AnnExplicitSum -> [EpToken "|"]
- GHC.Hs.Expr: [aesBarsBefore] :: AnnExplicitSum -> [EpaLocation]
+ GHC.Hs.Expr: [aesBarsBefore] :: AnnExplicitSum -> [EpToken "|"]
- GHC.Hs.Expr: [afDot] :: AnnFieldLabel -> Maybe EpaLocation
+ GHC.Hs.Expr: [afDot] :: AnnFieldLabel -> Maybe (EpToken ".")
- GHC.Hs.Expr: [aiElseSemi] :: AnnsIf -> Maybe EpaLocation
+ GHC.Hs.Expr: [aiElseSemi] :: AnnsIf -> Maybe (EpToken ";")
- GHC.Hs.Expr: [aiElse] :: AnnsIf -> EpaLocation
+ GHC.Hs.Expr: [aiElse] :: AnnsIf -> EpToken "else"
- GHC.Hs.Expr: [aiIf] :: AnnsIf -> EpaLocation
+ GHC.Hs.Expr: [aiIf] :: AnnsIf -> EpToken "if"
- GHC.Hs.Expr: [aiThenSemi] :: AnnsIf -> Maybe EpaLocation
+ GHC.Hs.Expr: [aiThenSemi] :: AnnsIf -> Maybe (EpToken ";")
- GHC.Hs.Expr: [aiThen] :: AnnsIf -> EpaLocation
+ GHC.Hs.Expr: [aiThen] :: AnnsIf -> EpToken "then"
- GHC.Hs.Expr: [apClose] :: AnnProjection -> EpaLocation
+ GHC.Hs.Expr: [apClose] :: AnnProjection -> EpToken ")"
- GHC.Hs.Expr: [apOpen] :: AnnProjection -> EpaLocation
+ GHC.Hs.Expr: [apOpen] :: AnnProjection -> EpToken "("
- GHC.Hs.Expr: [ga_sep] :: GrhsAnn -> AddEpAnn
+ GHC.Hs.Expr: [ga_sep] :: GrhsAnn -> Either (EpToken "=") TokRarrow
- GHC.Hs.Expr: [ga_vbar] :: GrhsAnn -> Maybe EpaLocation
+ GHC.Hs.Expr: [ga_vbar] :: GrhsAnn -> Maybe (EpToken "|")
- GHC.Hs.Expr: [hsCaseAnnCase] :: EpAnnHsCase -> EpaLocation
+ GHC.Hs.Expr: [hsCaseAnnCase] :: EpAnnHsCase -> EpToken "case"
- GHC.Hs.Expr: [hsCaseAnnOf] :: EpAnnHsCase -> EpaLocation
+ GHC.Hs.Expr: [hsCaseAnnOf] :: EpAnnHsCase -> EpToken "of"
- GHC.Hs.Expr: [hsUnboundBackquotes] :: EpAnnUnboundVar -> (EpaLocation, EpaLocation)
+ GHC.Hs.Expr: [hsUnboundBackquotes] :: EpAnnUnboundVar -> (EpToken "`", EpToken "`")
- GHC.Hs.Expr: [hsUnboundHole] :: EpAnnUnboundVar -> EpaLocation
+ GHC.Hs.Expr: [hsUnboundHole] :: EpAnnUnboundVar -> EpToken "_"
- GHC.Hs.Expr: pprStmtCat :: forall (p :: Pass) body. Stmt (GhcPass p) body -> SDoc
+ GHC.Hs.Expr: pprStmtCat :: forall (p :: Pass) body. IsPass p => Stmt (GhcPass p) body -> SDoc
- GHC.Hs.Expr: type family SyntaxExprGhc (p :: Pass) = (r :: Type) | r -> p
+ GHC.Hs.Expr: type family XXApplicativeArg x
- GHC.Hs.ImpExp: EpAnnImportDecl :: EpaLocation -> Maybe (EpaLocation, EpaLocation) -> Maybe EpaLocation -> Maybe EpaLocation -> Maybe EpaLocation -> Maybe EpaLocation -> EpAnnImportDecl
+ GHC.Hs.ImpExp: EpAnnImportDecl :: EpToken "import" -> Maybe (EpaLocation, EpToken "#-}") -> Maybe (EpToken "safe") -> Maybe (EpToken "qualified") -> Maybe EpaLocation -> Maybe (EpToken "as") -> EpAnnImportDecl
- GHC.Hs.ImpExp: [importDeclAnnAs] :: EpAnnImportDecl -> Maybe EpaLocation
+ GHC.Hs.ImpExp: [importDeclAnnAs] :: EpAnnImportDecl -> Maybe (EpToken "as")
- GHC.Hs.ImpExp: [importDeclAnnImport] :: EpAnnImportDecl -> EpaLocation
+ GHC.Hs.ImpExp: [importDeclAnnImport] :: EpAnnImportDecl -> EpToken "import"
- GHC.Hs.ImpExp: [importDeclAnnPragma] :: EpAnnImportDecl -> Maybe (EpaLocation, EpaLocation)
+ GHC.Hs.ImpExp: [importDeclAnnPragma] :: EpAnnImportDecl -> Maybe (EpaLocation, EpToken "#-}")
- GHC.Hs.ImpExp: [importDeclAnnQualified] :: EpAnnImportDecl -> Maybe EpaLocation
+ GHC.Hs.ImpExp: [importDeclAnnQualified] :: EpAnnImportDecl -> Maybe (EpToken "qualified")
- GHC.Hs.ImpExp: [importDeclAnnSafe] :: EpAnnImportDecl -> Maybe EpaLocation
+ GHC.Hs.ImpExp: [importDeclAnnSafe] :: EpAnnImportDecl -> Maybe (EpToken "safe")
- GHC.Hs.ImpExp: importDeclQualifiedStyle :: Maybe EpaLocation -> Maybe EpaLocation -> (Maybe EpaLocation, ImportDeclQualifiedStyle)
+ GHC.Hs.ImpExp: importDeclQualifiedStyle :: Maybe (EpToken "qualified") -> Maybe (EpToken "qualified") -> (Maybe (EpToken "qualified"), ImportDeclQualifiedStyle)
- GHC.Hs.Pat: EpAnnSumPat :: [AddEpAnn] -> [EpaLocation] -> [EpaLocation] -> EpAnnSumPat
+ GHC.Hs.Pat: EpAnnSumPat :: (EpaLocation, EpaLocation) -> [EpToken "|"] -> [EpToken "|"] -> EpAnnSumPat
- GHC.Hs.Pat: HsRecFields :: [LHsRecField p arg] -> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
+ GHC.Hs.Pat: HsRecFields :: !XHsRecFields p -> [LHsRecField p arg] -> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
- GHC.Hs.Pat: [sumPatParens] :: EpAnnSumPat -> [AddEpAnn]
+ GHC.Hs.Pat: [sumPatParens] :: EpAnnSumPat -> (EpaLocation, EpaLocation)
- GHC.Hs.Pat: [sumPatVbarsAfter] :: EpAnnSumPat -> [EpaLocation]
+ GHC.Hs.Pat: [sumPatVbarsAfter] :: EpAnnSumPat -> [EpToken "|"]
- GHC.Hs.Pat: [sumPatVbarsBefore] :: EpAnnSumPat -> [EpaLocation]
+ GHC.Hs.Pat: [sumPatVbarsBefore] :: EpAnnSumPat -> [EpToken "|"]
- GHC.Hs.Pat: hsRecFieldSel :: UnXRec p => HsRecField p arg -> XCFieldOcc p
+ GHC.Hs.Pat: hsRecFieldSel :: UnXRec p => HsRecField p arg -> IdP p
- GHC.Hs.Pat: hsRecFields :: UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
+ GHC.Hs.Pat: hsRecFields :: UnXRec p => HsRecFields p arg -> [IdP p]
- GHC.Hs.Pat: type HsRecUpdField p q = HsFieldBind LAmbiguousFieldOcc p LHsExpr q
+ GHC.Hs.Pat: type HsRecUpdField p q = HsFieldBind LFieldOcc p LHsExpr q
- GHC.Hs.Type: EpPct1 :: !EpToken "%1" -> !EpUniToken "->" "\8594" -> EpLinearArrow
+ GHC.Hs.Type: EpPct1 :: !EpToken "%1" -> !TokRarrow -> EpLinearArrow
- GHC.Hs.Type: FieldOcc :: XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
+ GHC.Hs.Type: FieldOcc :: XCFieldOcc pass -> LIdP pass -> FieldOcc pass
- GHC.Hs.Type: HsBangTy :: XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
+ GHC.Hs.Type: HsBangTy :: XBangTy pass -> HsBang -> LHsType pass -> HsType pass
- GHC.Hs.Type: HsExplicitMult :: !XExplicitMult pass -> !LHsType pass -> HsArrow pass
+ GHC.Hs.Type: HsExplicitMult :: !XExplicitMult mult pass -> !mult -> HsArrowOf mult pass
- GHC.Hs.Type: HsExplicitTupleTy :: XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
+ GHC.Hs.Type: HsExplicitTupleTy :: XExplicitTupleTy pass -> PromotionFlag -> [LHsType pass] -> HsType pass
- GHC.Hs.Type: HsLinearArrow :: !XLinearArrow pass -> HsArrow pass
+ GHC.Hs.Type: HsLinearArrow :: !XLinearArrow mult pass -> HsArrowOf mult pass
- GHC.Hs.Type: HsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
+ GHC.Hs.Type: HsSrcBang :: SourceText -> HsBang -> HsSrcBang
- GHC.Hs.Type: HsUnrestrictedArrow :: !XUnrestrictedArrow pass -> HsArrow pass
+ GHC.Hs.Type: HsUnrestrictedArrow :: !XUnrestrictedArrow mult pass -> HsArrowOf mult pass
- GHC.Hs.Type: XArrow :: !XXArrow pass -> HsArrow pass
+ GHC.Hs.Type: XArrow :: !XXArrow mult pass -> HsArrowOf mult pass
- GHC.Hs.Type: [foLabel] :: FieldOcc pass -> XRec pass RdrName
+ GHC.Hs.Type: [foLabel] :: FieldOcc pass -> LIdP pass
- GHC.Hs.Type: hsLTyVarLocName :: forall (p :: Pass) flag. Anno (IdGhcP p) ~ SrcSpanAnnN => LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
+ GHC.Hs.Type: hsLTyVarLocName :: forall (p :: Pass) flag. Anno (IdGhcP p) ~ SrcSpanAnnN => LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
- GHC.Hs.Type: hsLTyVarName :: forall flag (p :: Pass). LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
+ GHC.Hs.Type: hsLTyVarName :: forall flag (p :: Pass). LHsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
- GHC.Hs.Type: hsTyVarName :: forall flag (p :: Pass). HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
+ GHC.Hs.Type: hsTyVarName :: forall flag (p :: Pass). HsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
- GHC.Hs.Type: mkAnonWildCardTy :: HsType GhcPs
+ GHC.Hs.Type: mkAnonWildCardTy :: EpToken "_" -> HsType GhcPs
- GHC.Hs.Type: mkHsExplicitSigType :: EpAnnForallTy -> [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs -> HsSigType GhcPs
+ GHC.Hs.Type: mkHsExplicitSigType :: EpAnnForallInvis -> [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs -> HsSigType GhcPs
- GHC.Hs.Type: mkHsForAllInvisTele :: forall (p :: Pass). EpAnnForallTy -> [LHsTyVarBndr Specificity (GhcPass p)] -> HsForAllTelescope (GhcPass p)
+ GHC.Hs.Type: mkHsForAllInvisTele :: forall (p :: Pass). EpAnnForallInvis -> [LHsTyVarBndr Specificity (GhcPass p)] -> HsForAllTelescope (GhcPass p)
- GHC.Hs.Type: mkHsForAllVisTele :: forall (p :: Pass). EpAnnForallTy -> [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
+ GHC.Hs.Type: mkHsForAllVisTele :: forall (p :: Pass). EpAnnForallVis -> [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
- GHC.Hs.Type: mkHsOuterExplicit :: EpAnnForallTy -> [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
+ GHC.Hs.Type: mkHsOuterExplicit :: EpAnnForallInvis -> [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
- GHC.Hs.Type: pprHsArrow :: forall (pass :: Pass). OutputableBndrId pass => HsArrow (GhcPass pass) -> SDoc
+ GHC.Hs.Type: pprHsArrow :: forall mult (pass :: Pass). (Outputable mult, OutputableBndrId pass) => HsArrowOf mult (GhcPass pass) -> SDoc
- GHC.Hs.Type: splitHsFunType :: forall (p :: Pass). LHsType (GhcPass p) -> ([AddEpAnn], EpAnnComments, [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
+ GHC.Hs.Type: splitHsFunType :: forall (p :: Pass). LHsType (GhcPass p) -> (([EpToken "("], [EpToken ")"]), EpAnnComments, [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
- GHC.Hs.Utils: collectLStmtBinders :: forall (idL :: Pass) (idR :: Pass) body. CollectPass (GhcPass idL) => CollectFlag (GhcPass idL) -> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
+ GHC.Hs.Utils: collectLStmtBinders :: forall (idL :: Pass) (idR :: Pass) body. (IsPass idL, IsPass idR, CollectPass (GhcPass idL)) => CollectFlag (GhcPass idL) -> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
- GHC.Hs.Utils: collectLStmtsBinders :: forall (idL :: Pass) (idR :: Pass) body. CollectPass (GhcPass idL) => CollectFlag (GhcPass idL) -> [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
+ GHC.Hs.Utils: collectLStmtsBinders :: forall (idL :: Pass) (idR :: Pass) body. (IsPass idL, IsPass idR, CollectPass (GhcPass idL)) => CollectFlag (GhcPass idL) -> [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
- GHC.Hs.Utils: collectStmtBinders :: forall (idL :: Pass) (idR :: Pass) body. CollectPass (GhcPass idL) => CollectFlag (GhcPass idL) -> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
+ GHC.Hs.Utils: collectStmtBinders :: forall (idL :: Pass) (idR :: Pass) body. (IsPass idL, IsPass idR, CollectPass (GhcPass idL)) => CollectFlag (GhcPass idL) -> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
- GHC.Hs.Utils: collectStmtsBinders :: forall (idL :: Pass) (idR :: Pass) body. CollectPass (GhcPass idL) => CollectFlag (GhcPass idL) -> [StmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
+ GHC.Hs.Utils: collectStmtsBinders :: forall (idL :: Pass) (idR :: Pass) body. (IsPass idL, IsPass idR, CollectPass (GhcPass idL)) => CollectFlag (GhcPass idL) -> [StmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
- GHC.Hs.Utils: emptyRecStmt :: forall (idL :: Pass) bodyR. Anno [GenLocated (Anno (StmtLR (GhcPass idL) GhcPs bodyR)) (StmtLR (GhcPass idL) GhcPs bodyR)] ~ SrcSpanAnnL => StmtLR (GhcPass idL) GhcPs bodyR
+ GHC.Hs.Utils: emptyRecStmt :: forall (idL :: Pass) bodyR. Anno [GenLocated (Anno (StmtLR (GhcPass idL) GhcPs bodyR)) (StmtLR (GhcPass idL) GhcPs bodyR)] ~ SrcSpanAnnLW => StmtLR (GhcPass idL) GhcPs bodyR
- GHC.Hs.Utils: emptyRecStmtName :: Anno [GenLocated (Anno (StmtLR GhcRn GhcRn bodyR)) (StmtLR GhcRn GhcRn bodyR)] ~ SrcSpanAnnL => StmtLR GhcRn GhcRn bodyR
+ GHC.Hs.Utils: emptyRecStmtName :: Anno [GenLocated (Anno (StmtLR GhcRn GhcRn bodyR)) (StmtLR GhcRn GhcRn bodyR)] ~ SrcSpanAnnLW => StmtLR GhcRn GhcRn bodyR
- GHC.Hs.Utils: emptyTransStmt :: [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+ GHC.Hs.Utils: emptyTransStmt :: AnnTransStmt -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
- GHC.Hs.Utils: lStmtsImplicits :: forall (idR :: Pass) (body :: Type -> Type). [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))] -> [(SrcSpan, [ImplicitFieldBinders])]
+ GHC.Hs.Utils: lStmtsImplicits :: forall (idR :: Pass) (body :: Type -> Type). IsPass idR => [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))] -> [(SrcSpan, [ImplicitFieldBinders])]
- GHC.Hs.Utils: mkGroupByUsingStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+ GHC.Hs.Utils: mkGroupByUsingStmt :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
- GHC.Hs.Utils: mkGroupUsingStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+ GHC.Hs.Utils: mkGroupUsingStmt :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
- GHC.Hs.Utils: mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> AnnList -> HsExpr GhcPs
+ GHC.Hs.Utils: mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> AnnList EpaLocation -> HsExpr GhcPs
- GHC.Hs.Utils: mkHsDo :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs
+ GHC.Hs.Utils: mkHsDo :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> HsExpr GhcPs
- GHC.Hs.Utils: mkHsDoAnns :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> AnnList -> HsExpr GhcPs
+ GHC.Hs.Utils: mkHsDoAnns :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> AnnList EpaLocation -> HsExpr GhcPs
- GHC.Hs.Utils: mkHsLam :: forall (p :: Pass). (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) => [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
+ GHC.Hs.Utils: mkHsLam :: forall (p :: Pass). (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) => LocatedE [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
- GHC.Hs.Utils: mkLamCaseMatchGroup :: forall (p :: Pass) body. AnnoBody p body => Origin -> HsLamVariant -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
+ GHC.Hs.Utils: mkLamCaseMatchGroup :: forall (p :: Pass) body. AnnoBody p body => Origin -> HsLamVariant -> LocatedLW [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
- GHC.Hs.Utils: mkLetStmt :: [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
+ GHC.Hs.Utils: mkLetStmt :: EpToken "let" -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
- GHC.Hs.Utils: mkMatch :: forall (p :: Pass). IsPass p => HsMatchContext (LIdP (NoGhcTc (GhcPass p))) -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> HsLocalBinds (GhcPass p) -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
+ GHC.Hs.Utils: mkMatch :: forall (p :: Pass). IsPass p => HsMatchContext (LIdP (NoGhcTc (GhcPass p))) -> LocatedE [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> HsLocalBinds (GhcPass p) -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
- GHC.Hs.Utils: mkMatchGroup :: forall (p :: Pass) body. AnnoBody p body => Origin -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
+ GHC.Hs.Utils: mkMatchGroup :: forall (p :: Pass) body. AnnoBody p body => Origin -> LocatedLW [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
- GHC.Hs.Utils: mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> [AddEpAnn] -> Pat GhcPs
+ GHC.Hs.Utils: mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-" -> Pat GhcPs
- GHC.Hs.Utils: mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpaLocation -> Pat GhcPs
+ GHC.Hs.Utils: mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpToken "+" -> Pat GhcPs
- GHC.Hs.Utils: mkPatSynBind :: LocatedN RdrName -> HsPatSynDetails GhcPs -> LPat GhcPs -> HsPatSynDir GhcPs -> [AddEpAnn] -> HsBind GhcPs
+ GHC.Hs.Utils: mkPatSynBind :: LocatedN RdrName -> HsPatSynDetails GhcPs -> LPat GhcPs -> HsPatSynDir GhcPs -> AnnPSB -> HsBind GhcPs
- GHC.Hs.Utils: mkPrefixFunRhs :: fn -> HsMatchContext fn
+ GHC.Hs.Utils: mkPrefixFunRhs :: fn -> AnnFunRhs -> HsMatchContext fn
- GHC.Hs.Utils: mkPsBindStmt :: [AddEpAnn] -> LPat GhcPs -> LocatedA (bodyR GhcPs) -> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
+ GHC.Hs.Utils: mkPsBindStmt :: EpUniToken "<-" "\8592" -> LPat GhcPs -> LocatedA (bodyR GhcPs) -> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
- GHC.Hs.Utils: mkRecStmt :: forall (idL :: Pass) bodyR. Anno [GenLocated (Anno (StmtLR (GhcPass idL) GhcPs bodyR)) (StmtLR (GhcPass idL) GhcPs bodyR)] ~ SrcSpanAnnL => AnnList -> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR] -> StmtLR (GhcPass idL) GhcPs bodyR
+ GHC.Hs.Utils: mkRecStmt :: forall (idL :: Pass) bodyR. Anno [GenLocated (Anno (StmtLR (GhcPass idL) GhcPs bodyR)) (StmtLR (GhcPass idL) GhcPs bodyR)] ~ SrcSpanAnnLW => AnnList (EpToken "rec") -> LocatedLW [LStmtLR (GhcPass idL) GhcPs bodyR] -> StmtLR (GhcPass idL) GhcPs bodyR
- GHC.Hs.Utils: mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs
+ GHC.Hs.Utils: mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> LocatedE [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs
- GHC.Hs.Utils: mkSimpleMatch :: forall (p :: Pass) body. (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpanAnnA, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns) => HsMatchContext (LIdP (NoGhcTc (GhcPass p))) -> [LPat (GhcPass p)] -> LocatedA (body (GhcPass p)) -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
+ GHC.Hs.Utils: mkSimpleMatch :: forall (p :: Pass) body. (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpanAnnA, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns) => HsMatchContext (LIdP (NoGhcTc (GhcPass p))) -> LocatedE [LPat (GhcPass p)] -> LocatedA (body (GhcPass p)) -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
- GHC.Hs.Utils: mkTransformByStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+ GHC.Hs.Utils: mkTransformByStmt :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
- GHC.Hs.Utils: mkTransformStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+ GHC.Hs.Utils: mkTransformStmt :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
- GHC.HsToCore.Pmc.Solver.Types: RCM :: !Maybe CompleteMatch -> !Maybe [CompleteMatch] -> ResidualCompleteMatches
+ GHC.HsToCore.Pmc.Solver.Types: RCM :: !Maybe DsCompleteMatch -> !Maybe DsCompleteMatches -> ResidualCompleteMatches
- GHC.HsToCore.Pmc.Solver.Types: [rcm_pragmas] :: ResidualCompleteMatches -> !Maybe [CompleteMatch]
+ GHC.HsToCore.Pmc.Solver.Types: [rcm_pragmas] :: ResidualCompleteMatches -> !Maybe DsCompleteMatches
- GHC.HsToCore.Pmc.Solver.Types: [rcm_vanilla] :: ResidualCompleteMatches -> !Maybe CompleteMatch
+ GHC.HsToCore.Pmc.Solver.Types: [rcm_vanilla] :: ResidualCompleteMatches -> !Maybe DsCompleteMatch
- GHC.HsToCore.Pmc.Solver.Types: getRcm :: ResidualCompleteMatches -> [CompleteMatch]
+ GHC.HsToCore.Pmc.Solver.Types: getRcm :: ResidualCompleteMatches -> DsCompleteMatches
- GHC.HsToCore.Pmc.Types: type Pre = GrdVec
+ GHC.HsToCore.Pmc.Types: type Pre = GrdDag
- GHC.Iface.Ext.Fields: readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
+ GHC.Iface.Ext.Fields: readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
- GHC.Iface.Ext.Fields: writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
+ GHC.Iface.Ext.Fields: writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
- GHC.Iface.Recomp.Binary: computeFingerprint :: Binary a => (BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
+ GHC.Iface.Recomp.Binary: computeFingerprint :: Binary a => (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint
- GHC.Iface.Recomp.Binary: fingerprintBinMem :: BinHandle -> IO Fingerprint
+ GHC.Iface.Recomp.Binary: fingerprintBinMem :: WriteBinHandle -> IO Fingerprint
- GHC.Iface.Recomp.Binary: putNameLiterally :: BinHandle -> Name -> IO ()
+ GHC.Iface.Recomp.Binary: putNameLiterally :: WriteBinHandle -> Name -> IO ()
- GHC.Iface.Syntax: IfaceCompleteMatch :: [IfExtName] -> Maybe IfaceTyCon -> IfaceCompleteMatch
+ GHC.Iface.Syntax: IfaceCompleteMatch :: [IfExtName] -> Maybe IfExtName -> IfaceCompleteMatch
- GHC.Iface.Syntax: IfaceDefault :: IfaceConAlt
+ GHC.Iface.Syntax: IfaceDefault :: IfaceTyCon -> [IfaceType] -> Maybe IfaceWarningTxt -> IfaceDefault
- GHC.Iface.Syntax: getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
+ GHC.Iface.Syntax: getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr
- GHC.Iface.Syntax: putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
+ GHC.Iface.Syntax: putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO ()
- GHC.Iface.Type: IfaceStrTyLit :: FastString -> IfaceTyLit
+ GHC.Iface.Type: IfaceStrTyLit :: LexicalFastString -> IfaceTyLit
- GHC.Iface.Type: IfaceTyCon :: IfExtName -> IfaceTyConInfo -> IfaceTyCon
+ GHC.Iface.Type: IfaceTyCon :: IfExtName -> !IfaceTyConInfo -> IfaceTyCon
- GHC.Iface.Type: IfaceUnivCo :: IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
+ GHC.Iface.Type: IfaceUnivCo :: UnivCoProvenance -> Role -> IfaceType -> IfaceType -> [IfaceCoercion] -> IfaceCoercion
- GHC.Iface.Type: [ifaceTyConInfo] :: IfaceTyCon -> IfaceTyConInfo
+ GHC.Iface.Type: [ifaceTyConInfo] :: IfaceTyCon -> !IfaceTyConInfo
- GHC.Linker.Types: BCOs :: CompiledByteCode -> [SptEntry] -> Unlinked
+ GHC.Linker.Types: BCOs :: CompiledByteCode -> LinkablePart
- GHC.Linker.Types: CoreBindings :: WholeCoreBindings -> Unlinked
+ GHC.Linker.Types: CoreBindings :: WholeCoreBindings -> LinkablePart
- GHC.Linker.Types: DotA :: FilePath -> Unlinked
+ GHC.Linker.Types: DotA :: FilePath -> LinkablePart
- GHC.Linker.Types: DotDLL :: FilePath -> Unlinked
+ GHC.Linker.Types: DotDLL :: FilePath -> LinkablePart
- GHC.Linker.Types: DotO :: ObjFile -> Unlinked
+ GHC.Linker.Types: DotO :: ObjFile -> LinkableObjectSort -> LinkablePart
- GHC.Parser.Annotation: AddCommaAnn :: EpaLocation -> TrailingAnn
+ GHC.Parser.Annotation: AddCommaAnn :: EpToken "," -> TrailingAnn
- GHC.Parser.Annotation: AddDarrowAnn :: EpaLocation -> TrailingAnn
+ GHC.Parser.Annotation: AddDarrowAnn :: TokDarrow -> TrailingAnn
- GHC.Parser.Annotation: AddSemiAnn :: EpaLocation -> TrailingAnn
+ GHC.Parser.Annotation: AddSemiAnn :: EpToken ";" -> TrailingAnn
- GHC.Parser.Annotation: AddVbarAnn :: EpaLocation -> TrailingAnn
+ GHC.Parser.Annotation: AddVbarAnn :: EpToken "|" -> TrailingAnn
- GHC.Parser.Annotation: AnnContext :: Maybe (IsUnicodeSyntax, EpaLocation) -> [EpaLocation] -> [EpaLocation] -> AnnContext
+ GHC.Parser.Annotation: AnnContext :: Maybe TokDarrow -> [EpToken "("] -> [EpToken ")"] -> AnnContext
- GHC.Parser.Annotation: AnnList :: Maybe Anchor -> Maybe AddEpAnn -> Maybe AddEpAnn -> [AddEpAnn] -> [TrailingAnn] -> AnnList
+ GHC.Parser.Annotation: AnnList :: !Maybe EpaLocation -> !AnnListBrackets -> [EpToken ";"] -> !a -> ![TrailingAnn] -> AnnList a
- GHC.Parser.Annotation: AnnParens :: ParenType
+ GHC.Parser.Annotation: AnnParens :: EpToken "(" -> EpToken ")" -> AnnParen
- GHC.Parser.Annotation: AnnParensHash :: ParenType
+ GHC.Parser.Annotation: AnnParensHash :: EpToken "(#" -> EpToken "#)" -> AnnParen
- GHC.Parser.Annotation: AnnParensSquare :: ParenType
+ GHC.Parser.Annotation: AnnParensSquare :: EpToken "[" -> EpToken "]" -> AnnParen
- GHC.Parser.Annotation: AnnPragma :: AddEpAnn -> AddEpAnn -> [AddEpAnn] -> AnnPragma
+ GHC.Parser.Annotation: AnnPragma :: EpaLocation -> EpToken "#-}" -> (EpToken "[", EpToken "]") -> EpaLocation -> EpaLocation -> EpToken "type" -> EpToken "module" -> AnnPragma
- GHC.Parser.Annotation: EpAnn :: !Anchor -> !ann -> !EpAnnComments -> EpAnn ann
+ GHC.Parser.Annotation: EpAnn :: !EpaLocation -> !ann -> !EpAnnComments -> EpAnn ann
- GHC.Parser.Annotation: EpaDelta :: !DeltaPos -> !a -> EpaLocation' a
+ GHC.Parser.Annotation: EpaDelta :: !SrcSpan -> !DeltaPos -> !a -> EpaLocation' a
- GHC.Parser.Annotation: NameAnn :: NameAdornment -> EpaLocation -> EpaLocation -> EpaLocation -> [TrailingAnn] -> NameAnn
+ GHC.Parser.Annotation: NameAnn :: NameAdornment -> EpaLocation -> [TrailingAnn] -> NameAnn
- GHC.Parser.Annotation: NameAnnBars :: NameAdornment -> EpaLocation -> [EpaLocation] -> EpaLocation -> [TrailingAnn] -> NameAnn
+ GHC.Parser.Annotation: NameAnnBars :: (EpToken "(#", EpToken "#)") -> [EpToken "|"] -> [TrailingAnn] -> NameAnn
- GHC.Parser.Annotation: NameAnnCommas :: NameAdornment -> EpaLocation -> [EpaLocation] -> EpaLocation -> [TrailingAnn] -> NameAnn
+ GHC.Parser.Annotation: NameAnnCommas :: NameAdornment -> [EpToken ","] -> [TrailingAnn] -> NameAnn
- GHC.Parser.Annotation: NameAnnOnly :: NameAdornment -> EpaLocation -> EpaLocation -> [TrailingAnn] -> NameAnn
+ GHC.Parser.Annotation: NameAnnOnly :: NameAdornment -> [TrailingAnn] -> NameAnn
- GHC.Parser.Annotation: NameAnnQuote :: EpaLocation -> SrcSpanAnnN -> [TrailingAnn] -> NameAnn
+ GHC.Parser.Annotation: NameAnnQuote :: EpToken "'" -> SrcSpanAnnN -> [TrailingAnn] -> NameAnn
- GHC.Parser.Annotation: NameAnnRArrow :: Bool -> Maybe EpaLocation -> EpaLocation -> Maybe EpaLocation -> [TrailingAnn] -> NameAnn
+ GHC.Parser.Annotation: NameAnnRArrow :: Maybe (EpToken "(") -> TokRarrow -> Maybe (EpToken ")") -> [TrailingAnn] -> NameAnn
- GHC.Parser.Annotation: NameBackquotes :: NameAdornment
+ GHC.Parser.Annotation: NameBackquotes :: EpToken "`" -> EpToken "`" -> NameAdornment
- GHC.Parser.Annotation: NameParens :: NameAdornment
+ GHC.Parser.Annotation: NameParens :: EpToken "(" -> EpToken ")" -> NameAdornment
- GHC.Parser.Annotation: NameParensHash :: NameAdornment
+ GHC.Parser.Annotation: NameParensHash :: EpToken "(#" -> EpToken "#)" -> NameAdornment
- GHC.Parser.Annotation: NameSquare :: NameAdornment
+ GHC.Parser.Annotation: NameSquare :: EpToken "[" -> EpToken "]" -> NameAdornment
- GHC.Parser.Annotation: [ac_close] :: AnnContext -> [EpaLocation]
+ GHC.Parser.Annotation: [ac_close] :: AnnContext -> [EpToken ")"]
- GHC.Parser.Annotation: [ac_darrow] :: AnnContext -> Maybe (IsUnicodeSyntax, EpaLocation)
+ GHC.Parser.Annotation: [ac_darrow] :: AnnContext -> Maybe TokDarrow
- GHC.Parser.Annotation: [ac_open] :: AnnContext -> [EpaLocation]
+ GHC.Parser.Annotation: [ac_open] :: AnnContext -> [EpToken "("]
- GHC.Parser.Annotation: [al_anchor] :: AnnList -> Maybe Anchor
+ GHC.Parser.Annotation: [al_anchor] :: AnnList a -> !Maybe EpaLocation
- GHC.Parser.Annotation: [al_rest] :: AnnList -> [AddEpAnn]
+ GHC.Parser.Annotation: [al_rest] :: AnnList a -> !a
- GHC.Parser.Annotation: [al_trailing] :: AnnList -> [TrailingAnn]
+ GHC.Parser.Annotation: [al_trailing] :: AnnList a -> ![TrailingAnn]
- GHC.Parser.Annotation: [apr_close] :: AnnPragma -> AddEpAnn
+ GHC.Parser.Annotation: [apr_close] :: AnnPragma -> EpToken "#-}"
- GHC.Parser.Annotation: [apr_open] :: AnnPragma -> AddEpAnn
+ GHC.Parser.Annotation: [apr_open] :: AnnPragma -> EpaLocation
- GHC.Parser.Annotation: [entry] :: EpAnn ann -> !Anchor
+ GHC.Parser.Annotation: [entry] :: EpAnn ann -> !EpaLocation
- GHC.Parser.Annotation: [nann_bars] :: NameAnn -> [EpaLocation]
+ GHC.Parser.Annotation: [nann_bars] :: NameAnn -> [EpToken "|"]
- GHC.Parser.Annotation: [nann_commas] :: NameAnn -> [EpaLocation]
+ GHC.Parser.Annotation: [nann_commas] :: NameAnn -> [EpToken ","]
- GHC.Parser.Annotation: [nann_mclose] :: NameAnn -> Maybe EpaLocation
+ GHC.Parser.Annotation: [nann_mclose] :: NameAnn -> Maybe (EpToken ")")
- GHC.Parser.Annotation: [nann_mopen] :: NameAnn -> Maybe EpaLocation
+ GHC.Parser.Annotation: [nann_mopen] :: NameAnn -> Maybe (EpToken "(")
- GHC.Parser.Annotation: [nann_quote] :: NameAnn -> EpaLocation
+ GHC.Parser.Annotation: [nann_quote] :: NameAnn -> EpToken "'"
- GHC.Parser.Annotation: addTrailingAnnToL :: TrailingAnn -> EpAnnComments -> EpAnn AnnList -> EpAnn AnnList
+ GHC.Parser.Annotation: addTrailingAnnToL :: TrailingAnn -> EpAnnComments -> EpAnn (AnnList a) -> EpAnn (AnnList a)
- GHC.Parser.Annotation: data AnnList
+ GHC.Parser.Annotation: data AnnList a
- GHC.Parser.Annotation: epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
+ GHC.Parser.Annotation: epaLocationRealSrcSpan :: EpaLocation' a -> RealSrcSpan
- GHC.Parser.Annotation: type SrcSpanAnnL = EpAnn AnnList
+ GHC.Parser.Annotation: type SrcSpanAnnL = EpAnn AnnList ()
- GHC.Parser.Annotation: widenAnchorS :: Anchor -> SrcSpan -> Anchor
+ GHC.Parser.Annotation: widenAnchorS :: EpaLocation -> SrcSpan -> EpaLocation
- GHC.Parser.Lexer: addPsMessage :: SrcSpan -> PsMessage -> P ()
+ GHC.Parser.Lexer: addPsMessage :: MonadP m => SrcSpan -> PsMessage -> m ()
- GHC.Parser.PostProcess: ImpExpAll :: ImpExpSubSpec
+ GHC.Parser.PostProcess: ImpExpAll :: EpToken ".." -> ImpExpSubSpec
- GHC.Parser.PostProcess: ImpExpQcType :: EpaLocation -> LocatedN RdrName -> ImpExpQcSpec
+ GHC.Parser.PostProcess: ImpExpQcType :: EpToken "type" -> LocatedN RdrName -> ImpExpQcSpec
- GHC.Parser.PostProcess: ImpExpQcWildcard :: ImpExpQcSpec
+ GHC.Parser.PostProcess: ImpExpQcWildcard :: EpToken ".." -> EpToken "," -> ImpExpQcSpec
- GHC.Parser.PostProcess: RuleTyTmVar :: [AddEpAnn] -> LocatedN RdrName -> Maybe (LHsType GhcPs) -> RuleTyTmVar
+ GHC.Parser.PostProcess: RuleTyTmVar :: AnnTyVarBndr -> LocatedN RdrName -> Maybe (LHsType GhcPs) -> RuleTyTmVar
- GHC.Parser.PostProcess: Sum :: ConTag -> Arity -> LocatedA b -> [EpaLocation] -> [EpaLocation] -> SumOrTuple b
+ GHC.Parser.PostProcess: Sum :: ConTag -> Arity -> LocatedA b -> [EpToken "|"] -> [EpToken "|"] -> SumOrTuple b
- GHC.Parser.PostProcess: UnpackednessPragma :: [AddEpAnn] -> SourceText -> SrcUnpackedness -> UnpackednessPragma
+ GHC.Parser.PostProcess: UnpackednessPragma :: (EpaLocation, EpToken "#-}") -> SourceText -> SrcUnpackedness -> UnpackednessPragma
- GHC.Parser.PostProcess: annBinds :: AddEpAnn -> EpAnnComments -> HsLocalBinds GhcPs -> (HsLocalBinds GhcPs, Maybe EpAnnComments)
+ GHC.Parser.PostProcess: annBinds :: EpToken "where" -> EpAnnComments -> HsLocalBinds GhcPs -> (HsLocalBinds GhcPs, Maybe EpAnnComments)
- GHC.Parser.PostProcess: checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs]) -> P (Located ([AddEpAnn], [LConDecl GhcPs]))
+ GHC.Parser.PostProcess: checkEmptyGADTs :: Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs]) -> P (Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs]))
- GHC.Parser.PostProcess: checkImportDecl :: Maybe EpaLocation -> Maybe EpaLocation -> P ()
+ GHC.Parser.PostProcess: checkImportDecl :: Maybe (EpToken "qualified") -> Maybe (EpToken "qualified") -> P ()
- GHC.Parser.PostProcess: checkImportSpec :: LocatedL [LIE GhcPs] -> P (LocatedL [LIE GhcPs])
+ GHC.Parser.PostProcess: checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs])
- GHC.Parser.PostProcess: checkValDef :: SrcSpan -> LocatedA (PatBuilder GhcPs) -> (HsMultAnn GhcPs, Maybe (AddEpAnn, LHsType GhcPs)) -> Located (GRHSs GhcPs (LHsExpr GhcPs)) -> P (HsBind GhcPs)
+ GHC.Parser.PostProcess: checkValDef :: SrcSpan -> LocatedA (PatBuilder GhcPs) -> (HsMultAnn GhcPs, Maybe (TokDcolon, LHsType GhcPs)) -> Located (GRHSs GhcPs (LHsExpr GhcPs)) -> P (HsBind GhcPs)
- GHC.Parser.PostProcess: mkBangTy :: [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
+ GHC.Parser.PostProcess: mkBangTy :: EpaLocation -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs
- GHC.Parser.PostProcess: mkClassDecl :: SrcSpan -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Located (a, [LHsFunDep GhcPs]) -> OrdList (LHsDecl GhcPs) -> EpLayout -> [AddEpAnn] -> P (LTyClDecl GhcPs)
+ GHC.Parser.PostProcess: mkClassDecl :: SrcSpan -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Located (a, [LHsFunDep GhcPs]) -> OrdList (LHsDecl GhcPs) -> EpLayout -> AnnClassDecl -> P (LTyClDecl GhcPs)
- GHC.Parser.PostProcess: mkConDeclH98 :: [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs] -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs -> ConDecl GhcPs
+ GHC.Parser.PostProcess: mkConDeclH98 :: (TokDarrow, (TokForall, EpToken ".")) -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs] -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs -> ConDecl GhcPs
- GHC.Parser.PostProcess: mkDataFamInst :: SrcSpan -> NewOrData -> Maybe (LocatedP CType) -> (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> Located (HsDeriving GhcPs) -> [AddEpAnn] -> P (LInstDecl GhcPs)
+ GHC.Parser.PostProcess: mkDataFamInst :: SrcSpan -> NewOrData -> Maybe (LocatedP CType) -> (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> Located (HsDeriving GhcPs) -> AnnDataDefn -> P (LInstDecl GhcPs)
- GHC.Parser.PostProcess: mkExport :: Located CCallConv -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
+ GHC.Parser.PostProcess: mkExport :: Located CCallConv -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs) -> (EpToken "export", TokDcolon) -> P (EpToken "foreign" -> HsDecl GhcPs)
- GHC.Parser.PostProcess: mkFamDecl :: SrcSpan -> FamilyInfo GhcPs -> TopLevelFlag -> LHsType GhcPs -> LFamilyResultSig GhcPs -> Maybe (LInjectivityAnn GhcPs) -> [AddEpAnn] -> P (LTyClDecl GhcPs)
+ GHC.Parser.PostProcess: mkFamDecl :: SrcSpan -> FamilyInfo GhcPs -> TopLevelFlag -> LHsType GhcPs -> LFamilyResultSig GhcPs -> Maybe (LInjectivityAnn GhcPs) -> AnnFamilyDecl -> P (LTyClDecl GhcPs)
- GHC.Parser.PostProcess: mkGadtDecl :: SrcSpan -> NonEmpty (LocatedN RdrName) -> EpUniToken "::" "\8759" -> LHsSigType GhcPs -> P (LConDecl GhcPs)
+ GHC.Parser.PostProcess: mkGadtDecl :: SrcSpan -> NonEmpty (LocatedN RdrName) -> TokDcolon -> LHsSigType GhcPs -> P (LConDecl GhcPs)
- GHC.Parser.PostProcess: mkHsBangPatPV :: DisambECP b => SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsBangPatPV :: DisambECP b => SrcSpan -> LocatedA b -> EpToken "!" -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsCasePV :: DisambECP b => SrcSpan -> LHsExpr GhcPs -> LocatedL [LMatch GhcPs (LocatedA b)] -> EpAnnHsCase -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsCasePV :: DisambECP b => SrcSpan -> LHsExpr GhcPs -> LocatedLW [LMatch GhcPs (LocatedA b)] -> EpAnnHsCase -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsDo :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs
+ GHC.Parser.PostProcess: mkHsDo :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> HsExpr GhcPs
- GHC.Parser.PostProcess: mkHsDoPV :: DisambECP b => SrcSpan -> Maybe ModuleName -> LocatedL [LStmt GhcPs (LocatedA b)] -> AnnList -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsDoPV :: DisambECP b => SrcSpan -> Maybe ModuleName -> LocatedLW [LStmt GhcPs (LocatedA b)] -> EpaLocation -> EpaLocation -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsExplicitListPV :: DisambECP b => SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsExplicitListPV :: DisambECP b => SrcSpan -> [LocatedA b] -> AnnList () -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsLamPV :: DisambECP b => SrcSpan -> HsLamVariant -> LocatedL [LMatch GhcPs (LocatedA b)] -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsLamPV :: DisambECP b => SrcSpan -> HsLamVariant -> LocatedLW [LMatch GhcPs (LocatedA b)] -> EpAnnLam -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsLazyPatPV :: DisambECP b => SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsLazyPatPV :: DisambECP b => SrcSpan -> LocatedA b -> EpToken "~" -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsNegAppPV :: DisambECP b => SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsNegAppPV :: DisambECP b => SrcSpan -> LocatedA b -> EpToken "-" -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsProjUpdatePV :: DisambECP b => SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] -> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))
+ GHC.Parser.PostProcess: mkHsProjUpdatePV :: DisambECP b => SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] -> LocatedA b -> Bool -> Maybe (EpToken "=") -> PV (LHsRecProj GhcPs (LocatedA b))
- GHC.Parser.PostProcess: mkHsRecordPV :: DisambECP b => Bool -> SrcSpan -> SrcSpan -> LocatedA b -> ([Fbind b], Maybe SrcSpan) -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsRecordPV :: DisambECP b => Bool -> SrcSpan -> SrcSpan -> LocatedA b -> ([Fbind b], Maybe SrcSpan) -> (Maybe (EpToken "{"), Maybe (EpToken "}")) -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkHsTySigPV :: DisambECP b => SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkHsTySigPV :: DisambECP b => SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> TokDcolon -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)
+ GHC.Parser.PostProcess: mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ImpExpSubSpec
- GHC.Parser.PostProcess: mkImport :: Located CCallConv -> Located Safety -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs) -> P ([AddEpAnn] -> HsDecl GhcPs)
+ GHC.Parser.PostProcess: mkImport :: Located CCallConv -> Located Safety -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs) -> (EpToken "import", TokDcolon) -> P (EpToken "foreign" -> HsDecl GhcPs)
- GHC.Parser.PostProcess: mkListSyntaxTy0 :: EpaLocation -> EpaLocation -> SrcSpan -> P (HsType GhcPs)
+ GHC.Parser.PostProcess: mkListSyntaxTy0 :: EpToken "[" -> EpToken "]" -> SrcSpan -> P (HsType GhcPs)
- GHC.Parser.PostProcess: mkListSyntaxTy1 :: EpaLocation -> LocatedA (HsType GhcPs) -> EpaLocation -> P (HsType GhcPs)
+ GHC.Parser.PostProcess: mkListSyntaxTy1 :: EpToken "[" -> LocatedA (HsType GhcPs) -> EpToken "]" -> P (HsType GhcPs)
- GHC.Parser.PostProcess: mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
+ GHC.Parser.PostProcess: mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
- GHC.Parser.PostProcess: mkMultTy :: EpToken "%" -> LHsType GhcPs -> EpUniToken "->" "\8594" -> HsArrow GhcPs
+ GHC.Parser.PostProcess: mkMultTy :: EpToken "%" -> LHsType GhcPs -> TokRarrow -> HsArrow GhcPs
- GHC.Parser.PostProcess: mkPatSynMatchGroup :: LocatedN RdrName -> LocatedL (OrdList (LHsDecl GhcPs)) -> P (MatchGroup GhcPs (LHsExpr GhcPs))
+ GHC.Parser.PostProcess: mkPatSynMatchGroup :: LocatedN RdrName -> LocatedLW (OrdList (LHsDecl GhcPs)) -> P (MatchGroup GhcPs (LHsExpr GhcPs))
- GHC.Parser.PostProcess: mkRdrRecordCon :: LocatedN RdrName -> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs
+ GHC.Parser.PostProcess: mkRdrRecordCon :: LocatedN RdrName -> HsRecordBinds GhcPs -> (Maybe (EpToken "{"), Maybe (EpToken "}")) -> HsExpr GhcPs
- GHC.Parser.PostProcess: mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> [AddEpAnn] -> PV (HsExpr GhcPs)
+ GHC.Parser.PostProcess: mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> (Maybe (EpToken "{"), Maybe (EpToken "}")) -> PV (HsExpr GhcPs)
- GHC.Parser.PostProcess: mkRecConstrOrUpdate :: Bool -> LHsExpr GhcPs -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> [AddEpAnn] -> PV (HsExpr GhcPs)
+ GHC.Parser.PostProcess: mkRecConstrOrUpdate :: Bool -> LHsExpr GhcPs -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> (Maybe (EpToken "{"), Maybe (EpToken "}")) -> PV (HsExpr GhcPs)
- GHC.Parser.PostProcess: mkRoleAnnotDecl :: SrcSpan -> LocatedN RdrName -> [Located (Maybe FastString)] -> [AddEpAnn] -> P (LRoleAnnotDecl GhcPs)
+ GHC.Parser.PostProcess: mkRoleAnnotDecl :: SrcSpan -> LocatedN RdrName -> [Located (Maybe FastString)] -> (EpToken "type", EpToken "role") -> P (LRoleAnnotDecl GhcPs)
- GHC.Parser.PostProcess: mkStandaloneKindSig :: SrcSpan -> Located [LocatedN RdrName] -> LHsSigType GhcPs -> [AddEpAnn] -> P (LStandaloneKindSig GhcPs)
+ GHC.Parser.PostProcess: mkStandaloneKindSig :: SrcSpan -> Located [LocatedN RdrName] -> LHsSigType GhcPs -> (EpToken "type", TokDcolon) -> P (LStandaloneKindSig GhcPs)
- GHC.Parser.PostProcess: mkSumOrTuplePV :: DisambECP b => SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b)
+ GHC.Parser.PostProcess: mkSumOrTuplePV :: DisambECP b => SrcSpanAnnA -> Boxity -> SumOrTuple b -> (EpaLocation, EpaLocation) -> PV (LocatedA b)
- GHC.Parser.PostProcess: mkTupleSyntaxTy :: EpaLocation -> [LocatedA (HsType GhcPs)] -> EpaLocation -> P (HsType GhcPs)
+ GHC.Parser.PostProcess: mkTupleSyntaxTy :: EpToken "(" -> [LocatedA (HsType GhcPs)] -> EpToken ")" -> P (HsType GhcPs)
- GHC.Parser.PostProcess: mkTyData :: SrcSpan -> Bool -> NewOrData -> Maybe (LocatedP CType) -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> Located (HsDeriving GhcPs) -> [AddEpAnn] -> P (LTyClDecl GhcPs)
+ GHC.Parser.PostProcess: mkTyData :: SrcSpan -> Bool -> NewOrData -> Maybe (LocatedP CType) -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> Located (HsDeriving GhcPs) -> AnnDataDefn -> P (LTyClDecl GhcPs)
- GHC.Parser.PostProcess: mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs -> [AddEpAnn] -> P (LInstDecl GhcPs)
+ GHC.Parser.PostProcess: mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs -> EpToken "type" -> EpToken "instance" -> P (LInstDecl GhcPs)
- GHC.Parser.PostProcess: mkTyFamInstEqn :: SrcSpan -> HsOuterFamEqnTyVarBndrs GhcPs -> LHsType GhcPs -> LHsType GhcPs -> [AddEpAnn] -> P (LTyFamInstEqn GhcPs)
+ GHC.Parser.PostProcess: mkTyFamInstEqn :: SrcSpan -> HsOuterFamEqnTyVarBndrs GhcPs -> LHsType GhcPs -> LHsType GhcPs -> EpToken "=" -> P (LTyFamInstEqn GhcPs)
- GHC.Parser.PostProcess: mkTySynonym :: SrcSpan -> LHsType GhcPs -> LHsType GhcPs -> [AddEpAnn] -> P (LTyClDecl GhcPs)
+ GHC.Parser.PostProcess: mkTySynonym :: SrcSpan -> LHsType GhcPs -> LHsType GhcPs -> EpToken "type" -> EpToken "=" -> P (LTyClDecl GhcPs)
- GHC.Parser.PostProcess: stmtsAnchor :: Located (OrdList AddEpAnn, a) -> Maybe Anchor
+ GHC.Parser.PostProcess: stmtsAnchor :: forall (tok :: Symbol) a. Located (OrdList (EpToken tok), a) -> Maybe EpaLocation
- GHC.Parser.PostProcess: stmtsLoc :: Located (OrdList AddEpAnn, a) -> SrcSpan
+ GHC.Parser.PostProcess: stmtsLoc :: forall (tok :: Symbol) a. Located (OrdList (EpToken tok), a) -> SrcSpan
- GHC.Parser.Types: PatBuilderOpApp :: LocatedA (PatBuilder p) -> LocatedN RdrName -> LocatedA (PatBuilder p) -> [AddEpAnn] -> PatBuilder p
+ GHC.Parser.Types: PatBuilderOpApp :: LocatedA (PatBuilder p) -> LocatedN RdrName -> LocatedA (PatBuilder p) -> ([EpToken "("], [EpToken ")"]) -> PatBuilder p
- GHC.Parser.Types: Sum :: ConTag -> Arity -> LocatedA b -> [EpaLocation] -> [EpaLocation] -> SumOrTuple b
+ GHC.Parser.Types: Sum :: ConTag -> Arity -> LocatedA b -> [EpToken "|"] -> [EpToken "|"] -> SumOrTuple b
- GHC.Platform: PlatformMisc :: String -> Bool -> Bool -> String -> PlatformMisc
+ GHC.Platform: PlatformMisc :: String -> Bool -> Bool -> String -> Bool -> PlatformMisc
- GHC.Platform.Reg: classOfVirtualReg :: VirtualReg -> RegClass
+ GHC.Platform.Reg: classOfVirtualReg :: Arch -> VirtualReg -> RegClass
- GHC.Prelude.Basic: bit :: Bits a => Int -> a
+ GHC.Prelude.Basic: bit :: (Num a, Bits a) => Int -> a
- GHC.Prelude.Basic: clearBit :: Bits a => a -> Int -> a
+ GHC.Prelude.Basic: clearBit :: (Num a, Bits a) => a -> Int -> a
- GHC.Prelude.Basic: setBit :: Bits a => a -> Int -> a
+ GHC.Prelude.Basic: setBit :: (Num a, Bits a) => a -> Int -> a
- GHC.Runtime.Context: InteractiveContext :: DynFlags -> Int -> [InteractiveImport] -> [TyThing] -> IcGlobalRdrEnv -> (InstEnv, [FamInst]) -> FixityEnv -> Maybe [Type] -> [Resume] -> Name -> Name -> Maybe FilePath -> !Plugins -> InteractiveContext
+ GHC.Runtime.Context: InteractiveContext :: DynFlags -> Int -> [InteractiveImport] -> [TyThing] -> IcGlobalRdrEnv -> (InstEnv, [FamInst]) -> FixityEnv -> DefaultEnv -> [Resume] -> Name -> Name -> Maybe FilePath -> !Plugins -> InteractiveContext
- GHC.Runtime.Context: [ic_default] :: InteractiveContext -> Maybe [Type]
+ GHC.Runtime.Context: [ic_default] :: InteractiveContext -> DefaultEnv
- GHC.Runtime.Context: extendInteractiveContext :: InteractiveContext -> [TyThing] -> InstEnv -> [FamInst] -> Maybe [Type] -> FixityEnv -> InteractiveContext
+ GHC.Runtime.Context: extendInteractiveContext :: InteractiveContext -> [TyThing] -> InstEnv -> [FamInst] -> DefaultEnv -> FixityEnv -> InteractiveContext
- GHC.Runtime.Interpreter.Types: InterpProcess :: !Pipe -> !ProcessHandle -> InterpProcess
+ GHC.Runtime.Interpreter.Types: InterpProcess :: !Pipe -> !ProcessHandle -> !MVar () -> InterpProcess
- GHC.Settings: PlatformMisc :: String -> Bool -> Bool -> String -> PlatformMisc
+ GHC.Settings: PlatformMisc :: String -> Bool -> Bool -> String -> Bool -> PlatformMisc
- GHC.StgToJS.Object: Object :: !ModuleName -> !BinHandle -> !Bin ObjBlock -> !BlockInfo -> !Index -> Object
+ GHC.StgToJS.Object: Object :: !ModuleName -> !ReadBinHandle -> !Bin ObjBlock -> !BlockInfo -> !Index -> Object
- GHC.StgToJS.Object: [objHandle] :: Object -> !BinHandle
+ GHC.StgToJS.Object: [objHandle] :: Object -> !ReadBinHandle
- GHC.StgToJS.Object: getObject :: BinHandle -> IO (Maybe Object)
+ GHC.StgToJS.Object: getObject :: ReadBinHandle -> IO (Maybe Object)
- GHC.StgToJS.Object: getObjectBody :: BinHandle -> ModuleName -> IO Object
+ GHC.StgToJS.Object: getObjectBody :: ReadBinHandle -> ModuleName -> IO Object
- GHC.StgToJS.Object: getObjectHeader :: BinHandle -> IO (Either String ModuleName)
+ GHC.StgToJS.Object: getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName)
- GHC.StgToJS.Object: parseJSObject :: BinHandle -> IO (JSOptions, ByteString)
+ GHC.StgToJS.Object: parseJSObject :: ReadBinHandle -> IO (JSOptions, ByteString)
- GHC.StgToJS.Object: putObject :: BinHandle -> ModuleName -> BlockInfo -> [ObjBlock] -> IO ()
+ GHC.StgToJS.Object: putObject :: WriteBinHandle -> ModuleName -> BlockInfo -> [ObjBlock] -> IO ()
- GHC.Tc.Errors.Types: [TcRnBadDefaultType] :: Type -> [Class] -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnBadDefaultType] :: Type -> [TyCon] -> TcRnMessage
- GHC.Tc.Errors.Types: [TcRnEmptyCase] :: !HsMatchContextRn -> !BadEmptyCaseReason -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnEmptyCase] :: HsMatchContextRn -> TcRnMessage
- GHC.Tc.Errors.Types: [TcRnIllegalTypeExpr] :: TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnIllegalTypeExpr] :: TypeSyntax -> TcRnMessage
- GHC.Tc.Errors.Types: [TcRnMultipleDefaultDeclarations] :: [LDefaultDecl GhcRn] -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnMultipleDefaultDeclarations] :: TyCon -> [LDefaultDecl GhcRn] -> TcRnMessage
- GHC.Tc.Errors.Types: [TcRnNoDerivStratSpecified] :: Bool -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnNoDerivStratSpecified] :: Bool -> TcRnNoDerivStratSpecifiedInfo -> TcRnMessage
- GHC.Tc.Errors.Types: [TcRnNonUnaryTypeclassConstraint] :: !LHsSigType GhcRn -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnNonUnaryTypeclassConstraint] :: !UserTypeCtxt -> !LHsSigType GhcRn -> TcRnMessage
- GHC.Tc.Errors.Types: [TcRnUnexpectedAnnotation] :: !HsType GhcRn -> !HsSrcBang -> TcRnMessage
+ GHC.Tc.Errors.Types: [TcRnUnexpectedAnnotation] :: !HsType GhcRn -> !HsBang -> TcRnMessage
- GHC.Tc.Solver.InertSet: WL :: [Ct] -> [Ct] -> [Ct] -> Bag Implication -> WorkList
+ GHC.Tc.Solver.InertSet: WL :: [Ct] -> [Ct] -> [Ct] -> [Ct] -> Bag Implication -> WorkList
- GHC.Tc.Types: TcGblEnv :: Module -> Module -> HscSource -> GlobalRdrEnv -> Maybe [Type] -> FixityEnv -> TypeEnv -> KnotVars (IORef TypeEnv) -> !InstEnv -> !FamInstEnv -> AnnEnv -> [AvailInfo] -> ImportAvails -> DefUses -> TcRef [GlobalRdrElt] -> TcRef NameSet -> TcRef Bool -> TcRef Bool -> TcRef ([Linkable], PkgsLoaded) -> TcRef OccSet -> TcRef Integer -> [(Module, Fingerprint)] -> Maybe [(LIE GhcRn, Avails)] -> [LImportDecl GhcRn] -> Maybe (HsGroup GhcRn) -> TcRef [FilePath] -> TcRef [LHsDecl GhcPs] -> TcRef [(ForeignSrcLang, FilePath)] -> TcRef NameSet -> TcRef [(TcLclEnv, ThModFinalizers)] -> TcRef [String] -> TcRef (Map TypeRep Dynamic) -> TcRef (Maybe (ForeignRef (IORef QState))) -> TcRef THDocs -> Bag EvBind -> Maybe Id -> LHsBinds GhcTc -> NameSet -> [LTcSpecPrag] -> Warnings GhcRn -> [Annotation] -> [TyCon] -> NameSet -> [ClsInst] -> [FamInst] -> [LRuleDecl GhcTc] -> [LForeignDecl GhcTc] -> [PatSyn] -> (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)) -> !AnyHpcUsage -> SelfBootInfo -> Maybe Name -> TcRef Bool -> TcRef (Messages TcRnMessage) -> [TcPluginSolver] -> UniqFM TyCon [TcPluginRewriter] -> [FillDefaulting] -> [HoleFitPlugin] -> RealSrcSpan -> TcRef WantedConstraints -> !CompleteMatches -> TcRef CostCentreState -> TcRef (ModuleEnv Int) -> TcGblEnv
+ GHC.Tc.Types: TcGblEnv :: Module -> Module -> HscSource -> GlobalRdrEnv -> DefaultEnv -> DefaultEnv -> FixityEnv -> TypeEnv -> KnotVars (IORef TypeEnv) -> !InstEnv -> !FamInstEnv -> AnnEnv -> [AvailInfo] -> ImportAvails -> ![ImportUserSpec] -> DefUses -> TcRef [GlobalRdrElt] -> TcRef NameSet -> TcRef Bool -> TcRef Bool -> TcRef ([Linkable], PkgsLoaded) -> TcRef OccSet -> TcRef Integer -> [(Module, Fingerprint)] -> Maybe [(LIE GhcRn, Avails)] -> [LImportDecl GhcRn] -> Maybe (HsGroup GhcRn) -> TcRef [FilePath] -> TcRef [LHsDecl GhcPs] -> TcRef [(ForeignSrcLang, FilePath)] -> TcRef NameSet -> TcRef [(TcLclEnv, ThModFinalizers)] -> TcRef [String] -> TcRef (Map TypeRep Dynamic) -> TcRef (Maybe (ForeignRef (IORef QState))) -> TcRef THDocs -> Bag EvBind -> Maybe Id -> LHsBinds GhcTc -> NameSet -> [LTcSpecPrag] -> Warnings GhcRn -> [Annotation] -> [TyCon] -> NameSet -> [ClsInst] -> [FamInst] -> [LRuleDecl GhcTc] -> [LForeignDecl GhcTc] -> [PatSyn] -> (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)) -> !AnyHpcUsage -> SelfBootInfo -> Maybe Name -> TcRef Bool -> TcRef (Messages TcRnMessage) -> [TcPluginSolver] -> UniqFM TyCon [TcPluginRewriter] -> [FillDefaulting] -> [HoleFitPlugin] -> RealSrcSpan -> TcRef WantedConstraints -> !CompleteMatches -> TcRef CostCentreState -> TcRef (ModuleEnv Int) -> TcGblEnv
- GHC.Tc.Types: [tcg_default] :: TcGblEnv -> Maybe [Type]
+ GHC.Tc.Types: [tcg_default] :: TcGblEnv -> DefaultEnv
- GHC.Tc.Types.Constraint: ctEvEqRel :: CtEvidence -> EqRel
+ GHC.Tc.Types.Constraint: ctEvEqRel :: HasDebugCallStack => CtEvidence -> EqRel
- GHC.Tc.Types.Constraint: ctEvFlavourRole :: CtEvidence -> CtFlavourRole
+ GHC.Tc.Types.Constraint: ctEvFlavourRole :: HasDebugCallStack => CtEvidence -> CtFlavourRole
- GHC.Tc.Types.Constraint: ctFlavourRole :: Ct -> CtFlavourRole
+ GHC.Tc.Types.Constraint: ctFlavourRole :: HasDebugCallStack => Ct -> CtFlavourRole
- GHC.Tc.Types.Evidence: EvBindWanted :: Canonical -> EvBindInfo
+ GHC.Tc.Types.Evidence: EvBindWanted :: CanonicalEvidence -> EvBindInfo
- GHC.Tc.Types.Evidence: [ebi_canonical] :: EvBindInfo -> Canonical
+ GHC.Tc.Types.Evidence: [ebi_canonical] :: EvBindInfo -> CanonicalEvidence
- GHC.Tc.Types.Evidence: mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind
+ GHC.Tc.Types.Evidence: mkWantedEvBind :: EvVar -> CanonicalEvidence -> EvTerm -> EvBind
- GHC.Tc.Types.Origin: unkSkol :: HasCallStack => SkolemInfo
+ GHC.Tc.Types.Origin: unkSkol :: HasDebugCallStack => SkolemInfo
- GHC.Tc.Types.Origin: unkSkolAnon :: HasCallStack => SkolemInfoAnon
+ GHC.Tc.Types.Origin: unkSkolAnon :: HasDebugCallStack => SkolemInfoAnon
- GHC.Tc.Utils.TcType: TcLevel :: Int -> TcLevel
+ GHC.Tc.Utils.TcType: TcLevel :: {-# UNPACK #-} !Int -> TcLevel
- GHC.Tc.Utils.TcType: anyRewritableTyFamApp :: EqRel -> (EqRel -> TyCon -> [TcType] -> Bool) -> TcType -> Bool
+ GHC.Tc.Utils.TcType: anyRewritableTyFamApp :: EqRel -> (UnderFam -> EqRel -> TyCon -> [TcType] -> Bool) -> TcType -> Bool
- GHC.Tc.Utils.TcType: anyRewritableTyVar :: EqRel -> (EqRel -> TcTyVar -> Bool) -> TcType -> Bool
+ GHC.Tc.Utils.TcType: anyRewritableTyVar :: EqRel -> (UnderFam -> EqRel -> TcTyVar -> Bool) -> TcType -> Bool
- GHC.Tc.Utils.TcType: eqType :: Type -> Type -> Bool
+ GHC.Tc.Utils.TcType: eqType :: HasCallStack => Type -> Type -> Bool
- GHC.Tc.Utils.TcType: eqTypeX :: RnEnv2 -> Type -> Type -> Bool
+ GHC.Tc.Utils.TcType: eqTypeX :: HasCallStack => RnEnv2 -> Type -> Type -> Bool
- GHC.Tc.Utils.TcType: eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
+ GHC.Tc.Utils.TcType: eqVarBndrs :: HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
- GHC.Tc.Utils.TcType: tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])
+ GHC.Tc.Utils.TcType: tcSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
- GHC.Tc.Utils.TcType: vanillaSkolemTvUnk :: HasCallStack => TcTyVarDetails
+ GHC.Tc.Utils.TcType: vanillaSkolemTvUnk :: HasDebugCallStack => TcTyVarDetails
- GHC.Types.CompleteMatch: CompleteMatch :: UniqDSet ConLike -> Maybe TyCon -> CompleteMatch
+ GHC.Types.CompleteMatch: CompleteMatch :: UniqDSet con -> Maybe Name -> CompleteMatchX con
- GHC.Types.CompleteMatch: [cmConLikes] :: CompleteMatch -> UniqDSet ConLike
+ GHC.Types.CompleteMatch: [cmConLikes] :: CompleteMatchX con -> UniqDSet con
- GHC.Types.CompleteMatch: [cmResultTyCon] :: CompleteMatch -> Maybe TyCon
+ GHC.Types.CompleteMatch: [cmResultTyCon] :: CompleteMatchX con -> Maybe Name
- GHC.Types.CompleteMatch: completeMatchAppliesAtType :: Type -> CompleteMatch -> Bool
+ GHC.Types.CompleteMatch: completeMatchAppliesAtType :: Type -> CompleteMatchX con -> Bool
- GHC.Types.CompleteMatch: vanillaCompleteMatch :: UniqDSet ConLike -> CompleteMatch
+ GHC.Types.CompleteMatch: vanillaCompleteMatch :: UniqDSet con -> CompleteMatchX con
- GHC.Types.Fixity: Fixity :: SourceText -> Int -> FixityDirection -> Fixity
+ GHC.Types.Fixity: Fixity :: Int -> FixityDirection -> Fixity
- GHC.Types.GREInfo: ConHasPositionalArgs :: ConInfo
+ GHC.Types.GREInfo: ConHasPositionalArgs :: ConFieldInfo
- GHC.Types.GREInfo: ConHasRecordFields :: NonEmpty FieldLabel -> ConInfo
+ GHC.Types.GREInfo: ConHasRecordFields :: NonEmpty FieldLabel -> ConFieldInfo
- GHC.Types.GREInfo: ConIsNullary :: ConInfo
+ GHC.Types.GREInfo: ConIsNullary :: ConFieldInfo
- GHC.Types.GREInfo: mkConInfo :: Arity -> [FieldLabel] -> ConInfo
+ GHC.Types.GREInfo: mkConInfo :: ConLikeInfo -> Arity -> [FieldLabel] -> ConInfo
- GHC.Types.IPE: type ClosureMap = UniqMap Name (Type, Maybe IpeSourceLocation)
+ GHC.Types.IPE: type ClosureMap = UniqDFM Name (Name, (Type, Maybe IpeSourceLocation))
- GHC.Types.IPE: type DCMap = UniqMap DataCon NonEmpty (Int, Maybe IpeSourceLocation)
+ GHC.Types.IPE: type DCMap = UniqDFM DataCon (DataCon, NonEmpty (Int, Maybe IpeSourceLocation))
- GHC.Types.Literal: LitLabel :: FastString -> Maybe Int -> FunctionOrData -> Literal
+ GHC.Types.Literal: LitLabel :: FastString -> FunctionOrData -> Literal
- GHC.Types.Name.Occurrence: delTidyOccEnvList :: TidyOccEnv -> [FastString] -> TidyOccEnv
+ GHC.Types.Name.Occurrence: delTidyOccEnvList :: TidyOccEnv -> [OccName] -> TidyOccEnv
- GHC.Types.Name.Reader: ImpDeclSpec :: !Module -> !ModuleName -> !Bool -> !SrcSpan -> ImpDeclSpec
+ GHC.Types.Name.Reader: ImpDeclSpec :: !Module -> !ModuleName -> !PkgQual -> !Bool -> !SrcSpan -> !IsBootInterface -> ImpDeclSpec
- GHC.Types.PkgQual: OtherPkg :: UnitId -> PkgQual
+ GHC.Types.PkgQual: OtherPkg :: !UnitId -> PkgQual
- GHC.Types.PkgQual: ThisPkg :: UnitId -> PkgQual
+ GHC.Types.PkgQual: ThisPkg :: !UnitId -> PkgQual
- GHC.Types.SrcLoc: EpaDelta :: !DeltaPos -> !a -> EpaLocation' a
+ GHC.Types.SrcLoc: EpaDelta :: !SrcSpan -> !DeltaPos -> !a -> EpaLocation' a
- GHC.Unit.External: EPS :: !InstalledModuleEnv ModuleNameWithIsBoot -> !PackageIfaceTable -> InstalledModuleEnv (UniqDSet ModuleName) -> !PackageTypeEnv -> !PackageInstEnv -> !PackageFamInstEnv -> !PackageRuleBase -> !PackageAnnEnv -> !PackageCompleteMatches -> !ModuleEnv FamInstEnv -> !EpsStats -> ExternalPackageState
+ GHC.Unit.External: EPS :: !InstalledModuleEnv ModuleNameWithIsBoot -> !PackageIfaceTable -> InstalledModuleEnv (UniqDSet ModuleName) -> !PackageTypeEnv -> !ModuleEnv (IO Linkable) -> !PackageInstEnv -> !PackageFamInstEnv -> !PackageRuleBase -> !PackageAnnEnv -> !PackageCompleteMatches -> !ModuleEnv FamInstEnv -> !EpsStats -> ExternalPackageState
- GHC.Unit.Finder.Types: FinderCache :: IORef FinderCacheState -> IORef FileCacheState -> FinderCache
+ GHC.Unit.Finder.Types: FinderCache :: (UnitEnv -> IO ()) -> (InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()) -> (InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)) -> (FilePath -> IO Fingerprint) -> FinderCache
- GHC.Unit.Finder.Types: FinderOpts :: [FilePath] -> Bool -> Bool -> Ways -> Bool -> Maybe FilePath -> Maybe FastString -> Set ModuleName -> Set ModuleName -> Maybe FilePath -> String -> Maybe FilePath -> String -> String -> Maybe FilePath -> String -> String -> Maybe FilePath -> FinderOpts
+ GHC.Unit.Finder.Types: FinderOpts :: [OsPath] -> Bool -> Bool -> Ways -> Bool -> Maybe OsPath -> Maybe FastString -> Set ModuleName -> Map ModuleName ModuleName -> Maybe OsPath -> OsString -> Maybe OsPath -> OsString -> OsString -> Maybe OsPath -> OsString -> OsString -> Maybe OsPath -> FinderOpts
- GHC.Unit.Finder.Types: InstalledNotFound :: [FilePath] -> Maybe UnitId -> InstalledFindResult
+ GHC.Unit.Finder.Types: InstalledNotFound :: [OsPath] -> Maybe UnitId -> InstalledFindResult
- GHC.Unit.Finder.Types: [finder_dynHiSuf] :: FinderOpts -> String
+ GHC.Unit.Finder.Types: [finder_dynHiSuf] :: FinderOpts -> OsString
- GHC.Unit.Finder.Types: [finder_dynObjectSuf] :: FinderOpts -> String
+ GHC.Unit.Finder.Types: [finder_dynObjectSuf] :: FinderOpts -> OsString
- GHC.Unit.Finder.Types: [finder_hiDir] :: FinderOpts -> Maybe FilePath
+ GHC.Unit.Finder.Types: [finder_hiDir] :: FinderOpts -> Maybe OsPath
- GHC.Unit.Finder.Types: [finder_hiSuf] :: FinderOpts -> String
+ GHC.Unit.Finder.Types: [finder_hiSuf] :: FinderOpts -> OsString
- GHC.Unit.Finder.Types: [finder_hieDir] :: FinderOpts -> Maybe FilePath
+ GHC.Unit.Finder.Types: [finder_hieDir] :: FinderOpts -> Maybe OsPath
- GHC.Unit.Finder.Types: [finder_hieSuf] :: FinderOpts -> String
+ GHC.Unit.Finder.Types: [finder_hieSuf] :: FinderOpts -> OsString
- GHC.Unit.Finder.Types: [finder_importPaths] :: FinderOpts -> [FilePath]
+ GHC.Unit.Finder.Types: [finder_importPaths] :: FinderOpts -> [OsPath]
- GHC.Unit.Finder.Types: [finder_objectDir] :: FinderOpts -> Maybe FilePath
+ GHC.Unit.Finder.Types: [finder_objectDir] :: FinderOpts -> Maybe OsPath
- GHC.Unit.Finder.Types: [finder_objectSuf] :: FinderOpts -> String
+ GHC.Unit.Finder.Types: [finder_objectSuf] :: FinderOpts -> OsString
- GHC.Unit.Finder.Types: [finder_reexportedModules] :: FinderOpts -> Set ModuleName
+ GHC.Unit.Finder.Types: [finder_reexportedModules] :: FinderOpts -> Map ModuleName ModuleName
- GHC.Unit.Finder.Types: [finder_stubDir] :: FinderOpts -> Maybe FilePath
+ GHC.Unit.Finder.Types: [finder_stubDir] :: FinderOpts -> Maybe OsPath
- GHC.Unit.Finder.Types: [finder_workingDirectory] :: FinderOpts -> Maybe FilePath
+ GHC.Unit.Finder.Types: [finder_workingDirectory] :: FinderOpts -> Maybe OsPath
- GHC.Unit.Module.Imported: type ImportedMods = ModuleEnv [ImportedBy]
+ GHC.Unit.Module.Imported: type ImportedMods = Map Module [ImportedBy]
- GHC.Unit.Module.Location: addBootSuffix :: FilePath -> FilePath
+ GHC.Unit.Module.Location: addBootSuffix :: OsPath -> OsPath
- GHC.Unit.Module.Location: addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath
+ GHC.Unit.Module.Location: addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath
- GHC.Unit.Module.Location: removeBootSuffix :: FilePath -> FilePath
+ GHC.Unit.Module.Location: removeBootSuffix :: OsPath -> OsPath
- GHC.Unit.Module.ModDetails: ModDetails :: [AvailInfo] -> !TypeEnv -> InstEnv -> ![FamInst] -> ![CoreRule] -> ![Annotation] -> [CompleteMatch] -> ModDetails
+ GHC.Unit.Module.ModDetails: ModDetails :: [AvailInfo] -> !TypeEnv -> !DefaultEnv -> InstEnv -> ![FamInst] -> ![CoreRule] -> ![Annotation] -> CompleteMatches -> ModDetails
- GHC.Unit.Module.ModDetails: [md_complete_matches] :: ModDetails -> [CompleteMatch]
+ GHC.Unit.Module.ModDetails: [md_complete_matches] :: ModDetails -> CompleteMatches
- GHC.Unit.Module.ModGuts: CgGuts :: !Module -> [TyCon] -> CoreProgram -> [CostCentre] -> !ForeignStubs -> ![(ForeignSrcLang, FilePath)] -> !Set UnitId -> !HpcInfo -> !Maybe ModBreaks -> [SptEntry] -> CgGuts
+ GHC.Unit.Module.ModGuts: CgGuts :: !Module -> [TyCon] -> CoreProgram -> [CostCentre] -> !ForeignStubs -> ![(ForeignSrcLang, FilePath)] -> !Set UnitId -> !Maybe ModBreaks -> [SptEntry] -> CgGuts
- GHC.Unit.Module.ModGuts: ModGuts :: !Module -> HscSource -> SrcSpan -> ![AvailInfo] -> !Dependencies -> ![Usage] -> !Bool -> !GlobalRdrEnv -> !FixityEnv -> ![TyCon] -> ![ClsInst] -> ![FamInst] -> ![PatSyn] -> ![CoreRule] -> !CoreProgram -> !ForeignStubs -> ![(ForeignSrcLang, FilePath)] -> !Warnings GhcRn -> [Annotation] -> [CompleteMatch] -> !HpcInfo -> !Maybe ModBreaks -> InstEnv -> FamInstEnv -> !NameSet -> SafeHaskellMode -> Bool -> !Maybe Docs -> ModGuts
+ GHC.Unit.Module.ModGuts: ModGuts :: !Module -> HscSource -> SrcSpan -> ![AvailInfo] -> !Dependencies -> ![Usage] -> !Bool -> !GlobalRdrEnv -> !FixityEnv -> ![TyCon] -> !DefaultEnv -> ![ClsInst] -> ![FamInst] -> ![PatSyn] -> ![CoreRule] -> !CoreProgram -> !ForeignStubs -> ![(ForeignSrcLang, FilePath)] -> !Warnings GhcRn -> [Annotation] -> CompleteMatches -> !HpcInfo -> !Maybe ModBreaks -> InstEnv -> FamInstEnv -> !NameSet -> SafeHaskellMode -> Bool -> !Maybe Docs -> ModGuts
- GHC.Unit.Module.ModGuts: [mg_complete_matches] :: ModGuts -> [CompleteMatch]
+ GHC.Unit.Module.ModGuts: [mg_complete_matches] :: ModGuts -> CompleteMatches
- GHC.Unit.Module.WholeCoreBindings: WholeCoreBindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> Module -> ModLocation -> WholeCoreBindings
+ GHC.Unit.Module.WholeCoreBindings: WholeCoreBindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> Module -> ModLocation -> IfaceForeign -> WholeCoreBindings
- GHC.Utils.Binary: dataHandle :: BinData -> IO BinHandle
+ GHC.Utils.Binary: dataHandle :: BinData -> IO ReadBinHandle
- GHC.Utils.Binary: foldGet :: Binary a => Word -> BinHandle -> b -> (Word -> a -> b -> IO b) -> IO b
+ GHC.Utils.Binary: foldGet :: Binary a => Word -> ReadBinHandle -> b -> (Word -> a -> b -> IO b) -> IO b
- GHC.Utils.Binary: foldGet' :: Binary a => Word -> BinHandle -> b -> (Word -> a -> b -> IO b) -> IO b
+ GHC.Utils.Binary: foldGet' :: Binary a => Word -> ReadBinHandle -> b -> (Word -> a -> b -> IO b) -> IO b
- GHC.Utils.Binary: forwardGet :: BinHandle -> IO a -> IO a
+ GHC.Utils.Binary: forwardGet :: ReadBinHandle -> IO a -> IO a
- GHC.Utils.Binary: forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a, b)
+ GHC.Utils.Binary: forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a, b)
- GHC.Utils.Binary: forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO ()
+ GHC.Utils.Binary: forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO ()
- GHC.Utils.Binary: get :: Binary a => BinHandle -> IO a
+ GHC.Utils.Binary: get :: Binary a => ReadBinHandle -> IO a
- GHC.Utils.Binary: getAt :: Binary a => BinHandle -> Bin a -> IO a
+ GHC.Utils.Binary: getAt :: Binary a => ReadBinHandle -> Bin a -> IO a
- GHC.Utils.Binary: getByte :: BinHandle -> IO Word8
+ GHC.Utils.Binary: getByte :: ReadBinHandle -> IO Word8
- GHC.Utils.Binary: getByteString :: BinHandle -> Int -> IO ByteString
+ GHC.Utils.Binary: getByteString :: ReadBinHandle -> Int -> IO ByteString
- GHC.Utils.Binary: getDictFastString :: Dictionary -> BinHandle -> IO FastString
+ GHC.Utils.Binary: getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString
- GHC.Utils.Binary: getDictionary :: BinHandle -> IO Dictionary
+ GHC.Utils.Binary: getDictionary :: ReadBinHandle -> IO Dictionary
- GHC.Utils.Binary: getSLEB128 :: (Show a, Integral a, FiniteBits a) => BinHandle -> IO a
+ GHC.Utils.Binary: getSLEB128 :: (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a
- GHC.Utils.Binary: getULEB128 :: (Integral a, FiniteBits a) => BinHandle -> IO a
+ GHC.Utils.Binary: getULEB128 :: (Integral a, FiniteBits a) => ReadBinHandle -> IO a
- GHC.Utils.Binary: handleData :: BinHandle -> IO BinData
+ GHC.Utils.Binary: handleData :: WriteBinHandle -> IO BinData
- GHC.Utils.Binary: lazyGet :: Binary a => BinHandle -> IO a
+ GHC.Utils.Binary: lazyGet :: Binary a => ReadBinHandle -> IO a
- GHC.Utils.Binary: lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a)
+ GHC.Utils.Binary: lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a)
- GHC.Utils.Binary: lazyPut :: Binary a => BinHandle -> a -> IO ()
+ GHC.Utils.Binary: lazyPut :: Binary a => WriteBinHandle -> a -> IO ()
- GHC.Utils.Binary: lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO ()
+ GHC.Utils.Binary: lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO ()
- GHC.Utils.Binary: newReadState :: (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
+ GHC.Utils.Binary: newReadState :: (ReadBinHandle -> IO Name) -> (ReadBinHandle -> IO FastString) -> ReaderUserData
- GHC.Utils.Binary: newWriteState :: (BinHandle -> Name -> IO ()) -> (BinHandle -> Name -> IO ()) -> (BinHandle -> FastString -> IO ()) -> UserData
+ GHC.Utils.Binary: newWriteState :: (WriteBinHandle -> Name -> IO ()) -> (WriteBinHandle -> Name -> IO ()) -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData
- GHC.Utils.Binary: openBinMem :: Int -> IO BinHandle
+ GHC.Utils.Binary: openBinMem :: Int -> IO WriteBinHandle
- GHC.Utils.Binary: put :: Binary a => BinHandle -> a -> IO (Bin a)
+ GHC.Utils.Binary: put :: Binary a => WriteBinHandle -> a -> IO (Bin a)
- GHC.Utils.Binary: putAt :: Binary a => BinHandle -> Bin a -> a -> IO ()
+ GHC.Utils.Binary: putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO ()
- GHC.Utils.Binary: putByte :: BinHandle -> Word8 -> IO ()
+ GHC.Utils.Binary: putByte :: WriteBinHandle -> Word8 -> IO ()
- GHC.Utils.Binary: putByteString :: BinHandle -> ByteString -> IO ()
+ GHC.Utils.Binary: putByteString :: WriteBinHandle -> ByteString -> IO ()
- GHC.Utils.Binary: putDictFastString :: FSTable -> BinHandle -> FastString -> IO ()
+ GHC.Utils.Binary: putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO ()
- GHC.Utils.Binary: putDictionary :: BinHandle -> Int -> UniqFM FastString (Int, FastString) -> IO ()
+ GHC.Utils.Binary: putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int, FastString) -> IO ()
- GHC.Utils.Binary: putFS :: BinHandle -> FastString -> IO ()
+ GHC.Utils.Binary: putFS :: WriteBinHandle -> FastString -> IO ()
- GHC.Utils.Binary: putSLEB128 :: (Integral a, Bits a) => BinHandle -> a -> IO ()
+ GHC.Utils.Binary: putSLEB128 :: (Integral a, Bits a) => WriteBinHandle -> a -> IO ()
- GHC.Utils.Binary: putULEB128 :: (Integral a, FiniteBits a) => BinHandle -> a -> IO ()
+ GHC.Utils.Binary: putULEB128 :: (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO ()
- GHC.Utils.Binary: put_ :: Binary a => BinHandle -> a -> IO ()
+ GHC.Utils.Binary: put_ :: Binary a => WriteBinHandle -> a -> IO ()
- GHC.Utils.Binary: readBinMem :: FilePath -> IO BinHandle
+ GHC.Utils.Binary: readBinMem :: FilePath -> IO ReadBinHandle
- GHC.Utils.Binary: readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle)
+ GHC.Utils.Binary: readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle)
- GHC.Utils.Binary: type Dictionary = Array Int FastString
+ GHC.Utils.Binary: type Dictionary = SymbolTable FastString
- GHC.Utils.Binary: type SymbolTable = Array Int Name
+ GHC.Utils.Binary: type SymbolTable a = Array Int a
- GHC.Utils.Binary: unsafeUnpackBinBuffer :: ByteString -> IO BinHandle
+ GHC.Utils.Binary: unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle
- GHC.Utils.Binary: withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a
+ GHC.Utils.Binary: withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a
- GHC.Utils.Binary: writeBinMem :: BinHandle -> FilePath -> IO ()
+ GHC.Utils.Binary: writeBinMem :: WriteBinHandle -> FilePath -> IO ()
- GHC.Utils.Binary.Typeable: getSomeTypeRep :: BinHandle -> IO SomeTypeRep
+ GHC.Utils.Binary.Typeable: getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep
- GHC.Utils.Misc: expectNonEmpty :: HasCallStack => String -> [a] -> NonEmpty a
+ GHC.Utils.Misc: expectNonEmpty :: HasDebugCallStack => String -> [a] -> NonEmpty a
- GHC.Utils.Misc: expectOnly :: HasCallStack => String -> [a] -> a
+ GHC.Utils.Misc: expectOnly :: HasDebugCallStack => String -> [a] -> a
- GHC.Utils.Word64: intToWord64 :: HasCallStack => Int -> Word64
+ GHC.Utils.Word64: intToWord64 :: HasDebugCallStack => Int -> Word64
- GHC.Utils.Word64: word64ToInt :: HasCallStack => Word64 -> Int
+ GHC.Utils.Word64: word64ToInt :: HasDebugCallStack => Word64 -> Int
- GHCi.FFI: prepForeignCall :: FFIConv -> [FFIType] -> FFIType -> IO (Ptr C_ffi_cif)
+ GHCi.FFI: prepForeignCall :: [FFIType] -> FFIType -> IO (Ptr C_ffi_cif)
- GHCi.Message: [PrepFFI] :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)
+ GHCi.Message: [PrepFFI] :: [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)
- Language.Haskell.Syntax.Binds: type LHsBindsLR idL idR = Bag LHsBindLR idL idR
+ Language.Haskell.Syntax.Binds: type LHsBindsLR idL idR = [LHsBindLR idL idR]
- Language.Haskell.Syntax.Decls: DefaultDecl :: XCDefaultDecl pass -> [LHsType pass] -> DefaultDecl pass
+ Language.Haskell.Syntax.Decls: DefaultDecl :: XCDefaultDecl pass -> Maybe (LIdP pass) -> [LHsType pass] -> DefaultDecl pass
- Language.Haskell.Syntax.Expr: FunRhs :: fn -> LexicalFixity -> SrcStrictness -> HsMatchContext fn
+ Language.Haskell.Syntax.Expr: FunRhs :: fn -> LexicalFixity -> SrcStrictness -> XFunRhs -> HsMatchContext fn
- Language.Haskell.Syntax.Expr: HsCmdArrForm :: XCmdArrForm id -> LHsExpr id -> LexicalFixity -> Maybe Fixity -> [LHsCmdTop id] -> HsCmd id
+ Language.Haskell.Syntax.Expr: HsCmdArrForm :: XCmdArrForm id -> LHsExpr id -> LexicalFixity -> [LHsCmdTop id] -> HsCmd id
- Language.Haskell.Syntax.Expr: HsOverLabel :: XOverLabel p -> SourceText -> FastString -> HsExpr p
+ Language.Haskell.Syntax.Expr: HsOverLabel :: XOverLabel p -> FastString -> HsExpr p
- Language.Haskell.Syntax.Expr: HsProjection :: XProjection p -> NonEmpty (XRec p (DotFieldOcc p)) -> HsExpr p
+ Language.Haskell.Syntax.Expr: HsProjection :: XProjection p -> NonEmpty (DotFieldOcc p) -> HsExpr p
- Language.Haskell.Syntax.Expr: Match :: XCMatch p body -> HsMatchContext (LIdP (NoGhcTc p)) -> [LPat p] -> GRHSs p body -> Match p body
+ Language.Haskell.Syntax.Expr: Match :: XCMatch p body -> HsMatchContext (LIdP (NoGhcTc p)) -> XRec p [LPat p] -> GRHSs p body -> Match p body
- Language.Haskell.Syntax.Expr: [m_pats] :: Match p body -> [LPat p]
+ Language.Haskell.Syntax.Expr: [m_pats] :: Match p body -> XRec p [LPat p]
- Language.Haskell.Syntax.Expr: [proj_flds] :: HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
+ Language.Haskell.Syntax.Expr: [proj_flds] :: HsExpr p -> NonEmpty (DotFieldOcc p)
- Language.Haskell.Syntax.Pat: HsRecFields :: [LHsRecField p arg] -> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
+ Language.Haskell.Syntax.Pat: HsRecFields :: !XHsRecFields p -> [LHsRecField p arg] -> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
- Language.Haskell.Syntax.Pat: hsRecFieldSel :: UnXRec p => HsRecField p arg -> XCFieldOcc p
+ Language.Haskell.Syntax.Pat: hsRecFieldSel :: UnXRec p => HsRecField p arg -> IdP p
- Language.Haskell.Syntax.Pat: hsRecFields :: UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
+ Language.Haskell.Syntax.Pat: hsRecFields :: UnXRec p => HsRecFields p arg -> [IdP p]
- Language.Haskell.Syntax.Pat: type HsRecUpdField p q = HsFieldBind LAmbiguousFieldOcc p LHsExpr q
+ Language.Haskell.Syntax.Pat: type HsRecUpdField p q = HsFieldBind LFieldOcc p LHsExpr q
- Language.Haskell.Syntax.Pat: type family XConPatTyArg p
+ Language.Haskell.Syntax.Pat: type family XHsRecFields p
- Language.Haskell.Syntax.Type: FieldOcc :: XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
+ Language.Haskell.Syntax.Type: FieldOcc :: XCFieldOcc pass -> LIdP pass -> FieldOcc pass
- Language.Haskell.Syntax.Type: HsBangTy :: XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
+ Language.Haskell.Syntax.Type: HsBangTy :: XBangTy pass -> HsBang -> LHsType pass -> HsType pass
- Language.Haskell.Syntax.Type: HsExplicitMult :: !XExplicitMult pass -> !LHsType pass -> HsArrow pass
+ Language.Haskell.Syntax.Type: HsExplicitMult :: !XExplicitMult mult pass -> !mult -> HsArrowOf mult pass
- Language.Haskell.Syntax.Type: HsExplicitTupleTy :: XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
+ Language.Haskell.Syntax.Type: HsExplicitTupleTy :: XExplicitTupleTy pass -> PromotionFlag -> [LHsType pass] -> HsType pass
- Language.Haskell.Syntax.Type: HsLinearArrow :: !XLinearArrow pass -> HsArrow pass
+ Language.Haskell.Syntax.Type: HsLinearArrow :: !XLinearArrow mult pass -> HsArrowOf mult pass
- Language.Haskell.Syntax.Type: HsUnrestrictedArrow :: !XUnrestrictedArrow pass -> HsArrow pass
+ Language.Haskell.Syntax.Type: HsUnrestrictedArrow :: !XUnrestrictedArrow mult pass -> HsArrowOf mult pass
- Language.Haskell.Syntax.Type: XArrow :: !XXArrow pass -> HsArrow pass
+ Language.Haskell.Syntax.Type: XArrow :: !XXArrow mult pass -> HsArrowOf mult pass
- Language.Haskell.Syntax.Type: [foLabel] :: FieldOcc pass -> XRec pass RdrName
+ Language.Haskell.Syntax.Type: [foLabel] :: FieldOcc pass -> LIdP pass

Files

compiler/CodeGen.Platform.h view
@@ -1,7 +1,8 @@  import GHC.Cmm.Expr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \-    || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64))+    || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64) \+    || defined(MACHREGS_riscv64)) import GHC.Utils.Panic.Plain #endif import GHC.Platform.Reg@@ -1038,6 +1039,105 @@ -- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md freeReg 18 = False #endif++# if defined(REG_Base)+freeReg REG_Base  = False+# endif+# if defined(REG_Sp)+freeReg REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeReg REG_SpLim = False+# endif+# if defined(REG_Hp)+freeReg REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeReg REG_HpLim = False+# endif++# if defined(REG_R1)+freeReg REG_R1    = False+# endif+# if defined(REG_R2)+freeReg REG_R2    = False+# endif+# if defined(REG_R3)+freeReg REG_R3    = False+# endif+# if defined(REG_R4)+freeReg REG_R4    = False+# endif+# if defined(REG_R5)+freeReg REG_R5    = False+# endif+# if defined(REG_R6)+freeReg REG_R6    = False+# endif+# if defined(REG_R7)+freeReg REG_R7    = False+# endif+# if defined(REG_R8)+freeReg REG_R8    = False+# endif++# if defined(REG_F1)+freeReg REG_F1    = False+# endif+# if defined(REG_F2)+freeReg REG_F2    = False+# endif+# if defined(REG_F3)+freeReg REG_F3    = False+# endif+# if defined(REG_F4)+freeReg REG_F4    = False+# endif+# if defined(REG_F5)+freeReg REG_F5    = False+# endif+# if defined(REG_F6)+freeReg REG_F6    = False+# endif++# if defined(REG_D1)+freeReg REG_D1    = False+# endif+# if defined(REG_D2)+freeReg REG_D2    = False+# endif+# if defined(REG_D3)+freeReg REG_D3    = False+# endif+# if defined(REG_D4)+freeReg REG_D4    = False+# endif+# if defined(REG_D5)+freeReg REG_D5    = False+# endif+# if defined(REG_D6)+freeReg REG_D6    = False+# endif++freeReg _ = True++#elif defined(MACHREGS_riscv64)++-- zero reg+freeReg 0 = False+-- link register+freeReg 1 = False+-- stack pointer+freeReg 2 = False+-- global pointer+freeReg 3 = False+-- thread pointer+freeReg 4 = False+-- frame pointer+freeReg 8 = False+-- made-up inter-procedural (ip) register+-- See Note [The made-up RISCV64 TMP (IP) register]+freeReg 31 = False  # if defined(REG_Base) freeReg REG_Base  = False
compiler/GHC/Builtin/Names.hs view
@@ -256,7 +256,7 @@         typeRepIdName,         mkTrTypeName,         mkTrConName,-        mkTrAppCheckedName,+        mkTrAppName,         mkTrFunName,         typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,         trGhcPrimModuleName,@@ -273,6 +273,9 @@         -- DataToTag         dataToTagClassName, +        -- seq#+        seqHashName,+         -- Dynamic         toDynName, @@ -565,10 +568,8 @@  gHC_INTERNAL_TUPLE                  = mkPrimModule (fsLit "GHC.Tuple") -pRELUDE, dATA_LIST, cONTROL_MONAD_ZIP :: Module-pRELUDE            = mkBaseModule_ pRELUDE_NAME-dATA_LIST          = mkBaseModule (fsLit "Data.List")-cONTROL_MONAD_ZIP  = mkBaseModule (fsLit "Control.Monad.Zip")+gHC_INTERNAL_CONTROL_MONAD_ZIP :: Module+gHC_INTERNAL_CONTROL_MONAD_ZIP  = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Zip")  gHC_INTERNAL_NUM_INTEGER, gHC_INTERNAL_NUM_NATURAL, gHC_INTERNAL_NUM_BIGNAT :: Module gHC_INTERNAL_NUM_INTEGER            = mkBignumModule (fsLit "GHC.Num.Integer")@@ -666,10 +667,6 @@ 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 @@ -693,12 +690,6 @@ mkGhcInternalModule_ :: ModuleName -> Module mkGhcInternalModule_ m = mkModule ghcInternalUnit m -mkBaseModule :: FastString -> Module-mkBaseModule m = mkBaseModule_ (mkModuleNameFS m)--mkBaseModule_ :: ModuleName -> Module-mkBaseModule_ m = mkModule baseUnit m- mkThisGhcModule :: FastString -> Module mkThisGhcModule m = mkThisGhcModule_ (mkModuleNameFS m) @@ -711,9 +702,6 @@ mkMainModule_ :: ModuleName -> Module mkMainModule_ m = mkModule mainUnit m -mkExperimentalModule :: FastString -> Module-mkExperimentalModule m = mkModule experimentalUnit (mkModuleNameFS m)- {- ************************************************************************ *                                                                      *@@ -755,9 +743,13 @@ left_RDR                = nameRdrName leftDataConName right_RDR               = nameRdrName rightDataConName -fromEnum_RDR, toEnum_RDR :: RdrName+fromEnum_RDR, toEnum_RDR, toEnumError_RDR, succError_RDR, predError_RDR, enumIntToWord_RDR :: RdrName fromEnum_RDR            = varQual_RDR gHC_INTERNAL_ENUM (fsLit "fromEnum") toEnum_RDR              = varQual_RDR gHC_INTERNAL_ENUM (fsLit "toEnum")+toEnumError_RDR         = varQual_RDR gHC_INTERNAL_ENUM (fsLit "toEnumError")+succError_RDR           = varQual_RDR gHC_INTERNAL_ENUM (fsLit "succError")+predError_RDR           = varQual_RDR gHC_INTERNAL_ENUM (fsLit "predError")+enumIntToWord_RDR       = varQual_RDR gHC_INTERNAL_ENUM (fsLit "enumIntToWord")  enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName enumFrom_RDR            = nameRdrName enumFromName@@ -1304,6 +1296,7 @@ realToFracName      = varQual  gHC_INTERNAL_REAL (fsLit "realToFrac")  realToFracIdKey mkRationalBase2Name  = varQual  gHC_INTERNAL_REAL  (fsLit "mkRationalBase2")  mkRationalBase2IdKey mkRationalBase10Name = varQual  gHC_INTERNAL_REAL  (fsLit "mkRationalBase10") mkRationalBase10IdKey+ -- GHC.Internal.Float classes floatingClassName, realFloatClassName :: Name floatingClassName  = clsQual gHC_INTERNAL_FLOAT (fsLit "Floating")  floatingClassKey@@ -1376,7 +1369,7 @@   , someTypeRepDataConName   , mkTrTypeName   , mkTrConName-  , mkTrAppCheckedName+  , mkTrAppName   , mkTrFunName   , typeRepIdName   , typeNatTypeRepName@@ -1391,7 +1384,7 @@ typeRepIdName         = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey mkTrTypeName          = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType")       mkTrTypeKey mkTrConName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon")        mkTrConKey-mkTrAppCheckedName    = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey+mkTrAppName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrApp")        mkTrAppKey mkTrFunName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun")        mkTrFunKey typeNatTypeRepName    = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey typeSymbolTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey@@ -1419,6 +1412,10 @@ dataToTagClassName :: Name dataToTagClassName    = clsQual gHC_MAGIC      (fsLit "DataToTag") dataToTagClassKey +-- seq#+seqHashName :: Name+seqHashName = varQual gHC_INTERNAL_IO (fsLit "seq#") seqHashKey+ -- Custom type errors errorMessageTypeErrorFamName   , typeErrorTextDataConName@@ -1583,7 +1580,7 @@ guardMName, liftMName, mzipName :: Name guardMName         = varQual gHC_INTERNAL_MONAD (fsLit "guard")    guardMIdKey liftMName          = varQual gHC_INTERNAL_MONAD (fsLit "liftM")    liftMIdKey-mzipName           = varQual cONTROL_MONAD_ZIP (fsLit "mzip") mzipIdKey+mzipName           = varQual gHC_INTERNAL_CONTROL_MONAD_ZIP (fsLit "mzip") mzipIdKey   -- Annotation type checking@@ -2376,7 +2373,7 @@ rootMainKey                   = mkPreludeMiscIdUnique 101 runMainKey                    = mkPreludeMiscIdUnique 102 -thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique+thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey, seqHashKey :: Unique thenIOIdKey                   = mkPreludeMiscIdUnique 103 lazyIdKey                     = mkPreludeMiscIdUnique 104 assertErrorIdKey              = mkPreludeMiscIdUnique 105@@ -2411,6 +2408,8 @@ rationalToFloatIdKey   = mkPreludeMiscIdUnique 132 rationalToDoubleIdKey  = mkPreludeMiscIdUnique 133 +seqHashKey             = mkPreludeMiscIdUnique 134+ coerceKey :: Unique coerceKey                     = mkPreludeMiscIdUnique 157 @@ -2508,7 +2507,7 @@ mkTyConKey   , mkTrTypeKey   , mkTrConKey-  , mkTrAppCheckedKey+  , mkTrAppKey   , mkTrFunKey   , typeNatTypeRepKey   , typeSymbolTypeRepKey@@ -2518,7 +2517,7 @@ mkTyConKey            = mkPreludeMiscIdUnique 503 mkTrTypeKey           = mkPreludeMiscIdUnique 504 mkTrConKey            = mkPreludeMiscIdUnique 505-mkTrAppCheckedKey     = mkPreludeMiscIdUnique 506+mkTrAppKey            = mkPreludeMiscIdUnique 506 typeNatTypeRepKey     = mkPreludeMiscIdUnique 507 typeSymbolTypeRepKey  = mkPreludeMiscIdUnique 508 typeCharTypeRepKey    = mkPreludeMiscIdUnique 509
compiler/GHC/Builtin/PrimOps.hs view
@@ -18,7 +18,7 @@          primOpOutOfLine, primOpCodeSize,         primOpOkForSpeculation, primOpOkToDiscard,-        primOpIsWorkFree, primOpIsCheap, primOpFixity, primOpDocs,+        primOpIsWorkFree, primOpIsCheap, primOpFixity, primOpDocs, primOpDeprecations,         primOpIsDiv, primOpIsReallyInline,          PrimOpEffect(..), primOpEffect,@@ -49,7 +49,6 @@ 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 )@@ -163,12 +162,15 @@ *                                                                      * ************************************************************************ -See Note [GHC.Prim Docs]+See Note [GHC.Prim Docs] in GHC.Builtin.Utils -} -primOpDocs :: [(String, String)]+primOpDocs :: [(FastString, String)] #include "primop-docs.hs-incl" +primOpDeprecations :: [(OccName, FastString)]+#include "primop-deprecations.hs-incl"+ {- ************************************************************************ *                                                                      *@@ -920,11 +922,10 @@         = text "__primcall" <+> ppr pkgId <+> ppr lbl  -- | Indicate if a primop is really inline: that is, it isn't out-of-line and it--- isn't SeqOp/DataToTagOp which are two primops that evaluate their argument+-- isn't DataToTagOp which are two primops that evaluate their argument -- hence induce thread/stack/heap changes. primOpIsReallyInline :: PrimOp -> Bool primOpIsReallyInline = \case-  SeqOp       -> False   DataToTagSmallOp -> False   DataToTagLargeOp -> False-  p           -> not (primOpOutOfLine p)+  p                -> not (primOpOutOfLine p)
compiler/GHC/Builtin/Types.hs view
@@ -64,7 +64,7 @@         nilDataCon, nilDataConName, nilDataConKey,         consDataCon_RDR, consDataCon, consDataConName,         promotedNilDataCon, promotedConsDataCon,-        mkListTy, mkPromotedListTy,+        mkListTy, mkPromotedListTy, extractPromotedList,          -- * Maybe         maybeTyCon, maybeTyConName,@@ -78,7 +78,6 @@         promotedTupleDataCon,         unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,         soloTyCon,-        soloDataConName,         pairTyCon, mkPromotedPairTy, isPromotedPairType,         unboxedUnitTy,         unboxedUnitTyCon, unboxedUnitDataCon,@@ -510,7 +509,6 @@    * You can safely coerce any /lifted/ type to `Any` and back with `unsafeCoerce`. -  * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.   * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`.    * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when@@ -724,7 +722,7 @@                 (mkDataConWorkId wrk_name data_con)                 NoDataConRep    -- Wired-in types are too simple to need wrappers -    no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict+    no_bang = mkHsSrcBang NoSourceText NoSrcUnpack NoSrcStrict      wrk_name = mkDataConWorkerName data_con wrk_key @@ -897,6 +895,7 @@       ":"    -> Just consDataConName        -- function tycon+      "FUN"  -> Just fUNTyConName       "->"  -> Just unrestrictedFunTyConName        -- tuple data/tycon@@ -1055,37 +1054,41 @@     isCTupleOcc_maybe  mod occ <|>     isSumTyOcc_maybe   mod occ -mkTupleOcc :: NameSpace -> Boxity -> Arity -> (OccName, BuiltInSyntax)-mkTupleOcc ns b ar = (mkOccName ns str, built_in)-  where (str, built_in) = mkTupleStr' ns b ar+mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName+-- No need to cache these, the caching is done in mk_tuple+mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr ns ar)+mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ns ar)  mkCTupleOcc :: NameSpace -> Arity -> OccName mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)  mkTupleStr :: Boxity -> NameSpace -> Arity -> String-mkTupleStr b ns ar = str-  where (str, _) = mkTupleStr' ns b ar+mkTupleStr Boxed   = mkBoxedTupleStr+mkTupleStr Unboxed = mkUnboxedTupleStr -mkTupleStr' :: NameSpace -> Boxity -> Arity -> (String, BuiltInSyntax)-mkTupleStr' ns Boxed 0-  | isDataConNameSpace ns = ("()", BuiltInSyntax)-  | otherwise             = ("Unit", UserSyntax)-mkTupleStr' ns Boxed 1-  | isDataConNameSpace ns = ("MkSolo", UserSyntax)  -- See Note [One-tuples]-  | otherwise             = ("Solo",   UserSyntax)-mkTupleStr' ns Boxed ar-  | isDataConNameSpace ns = ('(' : commas ar ++ ")", BuiltInSyntax)-  | otherwise             = ("Tuple" ++ showInt ar "", UserSyntax)-mkTupleStr' ns Unboxed 0-  | isDataConNameSpace ns = ("(##)",  BuiltInSyntax)-  | otherwise             = ("Unit#", UserSyntax)-mkTupleStr' ns Unboxed 1-  | isDataConNameSpace ns = ("(# #)", BuiltInSyntax) -- See Note [One-tuples]-  | otherwise             = ("Solo#", UserSyntax)-mkTupleStr' ns Unboxed ar-  | isDataConNameSpace ns = ("(#" ++ commas ar ++ "#)", BuiltInSyntax)-  | otherwise             = ("Tuple" ++ show ar ++ "#", UserSyntax)+mkBoxedTupleStr :: NameSpace -> Arity -> String+mkBoxedTupleStr ns 0+  | isDataConNameSpace ns = "()"+  | otherwise             = "Unit"+mkBoxedTupleStr ns 1+  | isDataConNameSpace ns = "MkSolo"  -- See Note [One-tuples]+  | otherwise             = "Solo"+mkBoxedTupleStr ns ar+  | isDataConNameSpace ns = '(' : commas ar ++ ")"+  | otherwise             = "Tuple" ++ showInt ar "" ++mkUnboxedTupleStr :: NameSpace -> Arity -> String+mkUnboxedTupleStr ns 0+  | isDataConNameSpace ns = "(##)"+  | otherwise             = "Unit#"+mkUnboxedTupleStr ns 1+  | isDataConNameSpace ns = "MkSolo#"  -- See Note [One-tuples]+  | otherwise             = "Solo#"+mkUnboxedTupleStr ns ar+  | isDataConNameSpace ns = "(#" ++ commas ar ++ "#)"+  | otherwise             = "Tuple" ++ show ar ++ "#"+ mkConstraintTupleStr :: Arity -> String mkConstraintTupleStr 0 = "CUnit" mkConstraintTupleStr 1 = "CSolo"@@ -1105,13 +1108,13 @@ cTupleTyConNames :: [Name] cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConKeys :: UniqSet Unique-cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames+cTupleTyConKeys :: UniqueSet+cTupleTyConKeys = fromListUniqueSet $ map getUnique cTupleTyConNames  isCTupleTyConName :: Name -> Bool isCTupleTyConName n  = assertPpr (isExternalName n) (ppr n) $-   getUnique n `elementOfUniqSet` cTupleTyConKeys+   getUnique n `memberUniqueSet` cTupleTyConKeys  -- | If the given name is that of a constraint tuple, return its arity. cTupleTyConNameArity_maybe :: Name -> Maybe Arity@@ -1240,10 +1243,10 @@      boxity  = Boxed     modu    = gHC_INTERNAL_TUPLE-    tc_name = mkWiredInName modu occ tc_uniq (ATyCon tycon) built_in-      where (occ, built_in) = mkTupleOcc tcName boxity arity-    dc_name = mkWiredInName modu occ dc_uniq (AConLike (RealDataCon tuple_con)) built_in-      where (occ, built_in) = mkTupleOcc dataName boxity arity+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq+                         (ATyCon tycon) UserSyntax+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax     tc_uniq = mkTupleTyConUnique   boxity arity     dc_uniq = mkTupleDataConUnique boxity arity @@ -1274,10 +1277,10 @@      boxity  = Unboxed     modu    = gHC_TYPES-    tc_name = mkWiredInName modu occ tc_uniq (ATyCon tycon) built_in-      where (occ, built_in) = mkTupleOcc tcName boxity arity-    dc_name = mkWiredInName modu occ dc_uniq (AConLike (RealDataCon tuple_con)) built_in-      where (occ, built_in) = mkTupleOcc dataName boxity arity+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq+                         (ATyCon tycon) UserSyntax+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax     tc_uniq = mkTupleTyConUnique   boxity arity     dc_uniq = mkTupleDataConUnique boxity arity @@ -1340,9 +1343,6 @@  soloTyConName :: Name soloTyConName = tyConName soloTyCon--soloDataConName :: Name-soloDataConName = tupleDataConName Boxed 1  pairTyCon :: TyCon pairTyCon = tupleTyCon Boxed 2
+ compiler/GHC/Builtin/Types/Literals.hs view
@@ -0,0 +1,1176 @@+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}   -- See calls to mkTemplateTyVars++module GHC.Builtin.Types.Literals+  ( tryInteractInertFam, tryInteractTopFam, tryMatchFam++  , typeNatTyCons+  , typeNatCoAxiomRules+  , BuiltInSynFamily(..)++    -- If you define a new built-in type family, make sure to export its TyCon+    -- from here as well.+    -- See Note [Adding built-in type families]+  , typeNatAddTyCon+  , typeNatMulTyCon+  , typeNatExpTyCon+  , typeNatSubTyCon+  , typeNatDivTyCon+  , typeNatModTyCon+  , typeNatLogTyCon+  , typeNatCmpTyCon+  , typeSymbolCmpTyCon+  , typeSymbolAppendTyCon+  , typeCharCmpTyCon+  , typeConsSymbolTyCon+  , typeUnconsSymbolTyCon+  , typeCharToNatTyCon+  , typeNatToCharTyCon+  ) where++import GHC.Prelude++import GHC.Core.Type+import GHC.Core.Unify      ( tcMatchTys )+import GHC.Data.Pair+import GHC.Core.TyCon    ( TyCon, FamTyConFlav(..), mkFamilyTyCon, tyConArity+                         , Injectivity(..), isBuiltInSynFamTyCon_maybe )+import GHC.Core.Coercion.Axiom+import GHC.Core.TyCo.Compare   ( tcEqType )+import GHC.Types.Name          ( Name, BuiltInSyntax(..) )+import GHC.Types.Unique.FM+import GHC.Builtin.Types+import GHC.Builtin.Types.Prim  ( mkTemplateAnonTyConBinders, mkTemplateTyVars )+import GHC.Builtin.Names+                  ( gHC_INTERNAL_TYPELITS+                  , gHC_INTERNAL_TYPELITS_INTERNAL+                  , gHC_INTERNAL_TYPENATS+                  , gHC_INTERNAL_TYPENATS_INTERNAL+                  , typeNatAddTyFamNameKey+                  , typeNatMulTyFamNameKey+                  , typeNatExpTyFamNameKey+                  , typeNatSubTyFamNameKey+                  , typeNatDivTyFamNameKey+                  , typeNatModTyFamNameKey+                  , typeNatLogTyFamNameKey+                  , typeNatCmpTyFamNameKey+                  , typeSymbolCmpTyFamNameKey+                  , typeSymbolAppendFamNameKey+                  , typeCharCmpTyFamNameKey+                  , typeConsSymbolTyFamNameKey+                  , typeUnconsSymbolTyFamNameKey+                  , typeCharToNatTyFamNameKey+                  , typeNatToCharTyFamNameKey+                  )+import GHC.Data.FastString+import GHC.Utils.Panic+import GHC.Utils.Outputable++import Control.Monad ( guard )+import Data.List  ( isPrefixOf, isSuffixOf )+import Data.Maybe ( listToMaybe )+import qualified Data.Char as Char++{-+Note [Type-level literals]+~~~~~~~~~~~~~~~~~~~~~~~~~~+There are currently three forms of type-level literals: natural numbers, symbols, and+characters.++Type-level literals are supported by CoAxiomRules (conditional axioms), which+power the built-in type families (see Note [Adding built-in type families]).+Currently, all built-in type families are for the express purpose of supporting+type-level literals.++See also the Wiki page:++    https://gitlab.haskell.org/ghc/ghc/wikis/type-nats++Note [Adding built-in type families]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There are a few steps to adding a built-in type family:++* Adding a unique for the type family TyCon++  These go in GHC.Builtin.Names. It will likely be of the form+  @myTyFamNameKey = mkPreludeTyConUnique xyz@, where @xyz@ is a number that+  has not been chosen before in GHC.Builtin.Names. There are several examples already+  in GHC.Builtin.Names—see, for instance, typeNatAddTyFamNameKey.++* Adding the type family TyCon itself++  This goes in GHC.Builtin.Types.Literals. There are plenty of examples of how to define+  these -- see, for instance, typeNatAddTyCon.++  Once your TyCon has been defined, be sure to:++  - Export it from GHC.Builtin.Types.Literals. (Not doing so caused #14632.)+  - Include it in the typeNatTyCons list, defined in GHC.Builtin.Types.Literals.++* Define the type family somewhere++  Finally, you will need to define the type family somewhere, likely in @base@.+  Currently, all of the built-in type families are defined in GHC.TypeLits or+  GHC.TypeNats, so those are likely candidates.++  Since the behavior of your built-in type family is specified in GHC.Builtin.Types.Literals,+  you should give an open type family definition with no instances, like so:++    type family MyTypeFam (m :: Nat) (n :: Nat) :: Nat++  Changing the argument and result kinds as appropriate.++* Update the relevant test cases++  The GHC test suite will likely need to be updated after you add your built-in+  type family. For instance:++  - The T9181 test prints the :browse contents of GHC.TypeLits, so if you added+    a test there, the expected output of T9181 will need to change.+  - The TcTypeNatSimple and TcTypeSymbolSimple tests have compile-time unit+    tests, as well as TcTypeNatSimpleRun and TcTypeSymbolSimpleRun, which have+    runtime unit tests. Consider adding further unit tests to those if your+    built-in type family deals with Nats or Symbols, respectively.++Note [Inlining axiom constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We have a number of constructor functions with types like+   mkUnaryConstFoldAxiom :: TyCon -> String+                         -> (Type -> Maybe a)+                         -> (a -> Maybe Type)+                         -> BuiltInFamRewrite++For very type-family-heavy code, these higher order argument are inefficient;+e.g. the fourth argument might always return (Just ty) in the above. Inlining+them is a bit brutal, but not bad, makes a few-percent difference in, say+perf test T13386.++These functions aren't exported, so the effect is very local.++-}++-------------------------------------------------------------------------------+--     Key utility functions+-------------------------------------------------------------------------------++tryInteractTopFam :: BuiltInSynFamily -> TyCon -> [Type] -> Type+                  -> [(CoAxiomRule, TypeEqn)]+-- The returned CoAxiomRule is always unary+tryInteractTopFam fam fam_tc tys r+  = [(bifinj_axr bif, eqn_out) | bif  <- sfInteract fam+                               , Just eqn_out <- [bifinj_proves bif eqn_in] ]+  where+    eqn_in :: TypeEqn+    eqn_in = Pair (mkTyConApp fam_tc tys) r++tryInteractInertFam :: BuiltInSynFamily -> TyCon+                    -> [Type] -> [Type] -- F tys1 ~ F tys2+                    -> [(CoAxiomRule, TypeEqn)]+tryInteractInertFam builtin_fam fam_tc tys1 tys2+  = [(bifinj_axr bif, eqn_out) | bif <- sfInteract builtin_fam+                               , Just eqn_out <- [bifinj_proves bif eqn_in] ]+  where+    eqn_in = Pair (mkTyConApp fam_tc tys1) (mkTyConApp fam_tc tys2)++tryMatchFam :: BuiltInSynFamily -> [Type]+            -> Maybe (CoAxiomRule, [Type], Type)+-- Does this reduce on the given arguments?+-- If it does, returns (CoAxiomRule, types to instantiate the rule at, rhs type)+-- That is: mkAxiomCo (BuiltInFamRew ax) (map mkNomReflCo ts)+--              :: F tys ~r rhs,+tryMatchFam builtin_fam arg_tys+  = listToMaybe $   -- Pick first rule to match+    [ (bifrw_axr rw_ax, inst_tys, res_ty)+    | rw_ax <- sfMatchFam builtin_fam+    , Just (inst_tys,res_ty) <- [bifrw_match rw_ax arg_tys] ]++-------------------------------------------------------------------------------+--          Constructing BuiltInFamInjectivity, BuiltInFamRewrite+-------------------------------------------------------------------------------++mkUnaryConstFoldAxiom :: TyCon -> String+                      -> (Type -> Maybe a)+                      -> (a -> Maybe Type)+                      -> BuiltInFamRewrite+-- For the definitional axioms, like  (3+4 --> 7)+{-# INLINE mkUnaryConstFoldAxiom #-}  -- See Note [Inlining axiom constructors]+mkUnaryConstFoldAxiom fam_tc str isReqTy f+  = bif+  where+    bif = BIF_Rewrite+      { bifrw_name   = fsLit str+      , bifrw_axr    = BuiltInFamRew bif+      , bifrw_fam_tc = fam_tc+      , bifrw_arity  = 1+      , bifrw_match  = \ts -> do { [t1] <- return ts+                                 ; t1' <- isReqTy t1+                                 ; res <- f t1'+                                 ; return ([t1], res) }+      , bifrw_proves = \cs -> do { [Pair s1 s2] <- return cs+                                 ; s2' <- isReqTy s2+                                 ; z   <- f s2'+                                 ; return (mkTyConApp fam_tc [s1] === z) }+      }++mkBinConstFoldAxiom :: TyCon -> String+                    -> (Type -> Maybe a)+                    -> (Type -> Maybe b)+                    -> (a -> b -> Maybe Type)+                    -> BuiltInFamRewrite+-- For the definitional axioms, like  (3+4 --> 7)+{-# INLINE mkBinConstFoldAxiom #-}  -- See Note [Inlining axiom constructors]+mkBinConstFoldAxiom fam_tc str isReqTy1 isReqTy2 f+  = bif+  where+    bif = BIF_Rewrite+      { bifrw_name   = fsLit str+      , bifrw_axr    = BuiltInFamRew bif+      , bifrw_fam_tc = fam_tc+      , bifrw_arity  = 2+      , bifrw_match  = \ts -> do { [t1,t2] <- return ts+                                 ; t1' <- isReqTy1 t1+                                 ; t2' <- isReqTy2 t2+                                 ; res <- f t1' t2'+                                 ; return ([t1,t2], res) }+      , bifrw_proves = \cs -> do { [Pair s1 s2, Pair t1 t2] <- return cs+                                 ; s2' <- isReqTy1 s2+                                 ; t2' <- isReqTy2 t2+                                 ; z   <- f s2' t2'+                                 ; return (mkTyConApp fam_tc [s1,t1] === z) }+      }++mkRewriteAxiom :: TyCon -> String+               -> [TyVar] -> [Type]  -- LHS of axiom+               -> Type               -- RHS of axiom+               -> BuiltInFamRewrite+-- Not higher order, no benefit in inlining+-- See Note [Inlining axiom constructors]+mkRewriteAxiom fam_tc str tpl_tvs lhs_tys rhs_ty+  = assertPpr (tyConArity fam_tc == length lhs_tys) (text str <+> ppr lhs_tys) $+    bif+  where+    bif = BIF_Rewrite+      { bifrw_name   = fsLit str+      , bifrw_axr    = BuiltInFamRew bif+      , bifrw_fam_tc = fam_tc+      , bifrw_arity  = bif_arity+      , bifrw_match  = match_fn+      , bifrw_proves = inst_fn }++    bif_arity = length tpl_tvs++    match_fn :: [Type] -> Maybe ([Type],Type)+    match_fn arg_tys+      = assertPpr (tyConArity fam_tc == length arg_tys) (text str <+> ppr arg_tys) $+        case tcMatchTys lhs_tys arg_tys of+          Nothing    -> Nothing+          Just subst -> Just (substTyVars subst tpl_tvs, substTy subst rhs_ty)++    inst_fn :: [TypeEqn] -> Maybe TypeEqn+    inst_fn inst_eqns+      = assertPpr (length inst_eqns == bif_arity) (text str $$ ppr inst_eqns) $+        Just (mkTyConApp fam_tc (substTys (zipTCvSubst tpl_tvs tys1) lhs_tys)+              ===+              substTy (zipTCvSubst tpl_tvs tys2) rhs_ty)+      where+        (tys1, tys2) = unzipPairs inst_eqns++mkTopUnaryFamDeduction :: String -> TyCon+                     -> (Type -> Type -> Maybe TypeEqn)+                     -> BuiltInFamInjectivity+-- Deduction from (F s ~ r) where `F` is a unary type function+{-# INLINE mkTopUnaryFamDeduction #-}  -- See Note [Inlining axiom constructors]+mkTopUnaryFamDeduction str fam_tc f+  = bif+  where+    bif = BIF_Interact+      { bifinj_name   = fsLit str+      , bifinj_axr    = BuiltInFamInj bif+      , bifinj_proves = \(Pair lhs rhs)+                        -> do { (tc, [a]) <- splitTyConApp_maybe lhs+                              ; massertPpr (tc == fam_tc) (ppr tc $$ ppr fam_tc)+                              ; f a rhs } }++mkTopBinFamDeduction :: String -> TyCon+                     -> (Type -> Type -> Type -> Maybe TypeEqn)+                     -> BuiltInFamInjectivity+-- Deduction from (F s t  ~ r) where `F` is a binary type function+{-# INLINE mkTopBinFamDeduction #-}  -- See Note [Inlining axiom constructors]+mkTopBinFamDeduction str fam_tc f+  = bif+  where+    bif = BIF_Interact+      { bifinj_name   = fsLit str+      , bifinj_axr    = BuiltInFamInj bif+      , bifinj_proves = \(Pair lhs rhs) ->+                        do { (tc, [a,b]) <- splitTyConApp_maybe lhs+                           ; massertPpr (tc == fam_tc) (ppr tc $$ ppr fam_tc)+                           ; f a b rhs } }++mkUnaryBIF :: String -> TyCon -> BuiltInFamInjectivity+-- Not higher order, no benefit in inlining+-- See Note [Inlining axiom constructors]+mkUnaryBIF str fam_tc+  = bif+  where+    bif = BIF_Interact { bifinj_name   = fsLit str+                       , bifinj_axr    = BuiltInFamInj bif+                       , bifinj_proves = proves }+    proves (Pair lhs rhs)+      = do { (tc2, [x2]) <- splitTyConApp_maybe rhs+           ; guard (tc2 == fam_tc)+           ; (tc1, [x1]) <- splitTyConApp_maybe lhs+           ; massertPpr (tc1 == fam_tc) (ppr tc1 $$ ppr fam_tc)+           ; return (Pair x1 x2) }++mkBinBIF :: String -> TyCon+         -> WhichArg -> WhichArg+         -> (Type -> Bool)         -- The guard on the equal args, if any+         -> BuiltInFamInjectivity+{-# INLINE mkBinBIF #-}  -- See Note [Inlining axiom constructors]+mkBinBIF str fam_tc eq1 eq2 check_me+  = bif+  where+    bif = BIF_Interact { bifinj_name   = fsLit str+                       , bifinj_axr    = BuiltInFamInj bif+                       , bifinj_proves = proves }+    proves (Pair lhs rhs)+      = do { (tc2, [x2,y2]) <- splitTyConApp_maybe rhs+           ; guard (tc2 == fam_tc)+           ; (tc1, [x1,y1]) <- splitTyConApp_maybe lhs+           ; massertPpr (tc1 == fam_tc) (ppr tc1 $$ ppr fam_tc)+           ; case (eq1, eq2) of+               (ArgX,ArgX) -> do_it x1 x2 y1 y2+               (ArgX,ArgY) -> do_it x1 y2 x2 y1+               (ArgY,ArgX) -> do_it y1 x2 y2 x1+               (ArgY,ArgY) -> do_it y1 y2 x1 x2 }++    do_it a1 a2 b1 b2 = do { same a1 a2; guard (check_me a1); return (Pair b1 b2) }++noGuard :: Type -> Bool+noGuard _ = True++numGuard :: (Integer -> Bool) -> Type -> Bool+numGuard pred ty = case isNumLitTy ty of+                      Just n  -> pred n+                      Nothing -> False++data WhichArg = ArgX | ArgY+++-------------------------------------------------------------------------------+--     Built-in type constructors for functions on type-level nats+-------------------------------------------------------------------------------++-- The list of built-in type family TyCons that GHC uses.+-- If you define a built-in type family, make sure to add it to this list.+-- See Note [Adding built-in type families]+typeNatTyCons :: [TyCon]+typeNatTyCons =+  [ typeNatAddTyCon+  , typeNatMulTyCon+  , typeNatExpTyCon+  , typeNatSubTyCon+  , typeNatDivTyCon+  , typeNatModTyCon+  , typeNatLogTyCon+  , typeNatCmpTyCon+  , typeSymbolCmpTyCon+  , typeSymbolAppendTyCon+  , typeCharCmpTyCon+  , typeConsSymbolTyCon+  , typeUnconsSymbolTyCon+  , typeCharToNatTyCon+  , typeNatToCharTyCon+  ]+++-- The list of built-in type family axioms that GHC uses.+-- If you define new axioms, make sure to include them in this list.+-- See Note [Adding built-in type families]+typeNatCoAxiomRules :: UniqFM FastString CoAxiomRule+typeNatCoAxiomRules+  = listToUFM $+    [ pr | tc <- typeNatTyCons+         , Just ops <- [isBuiltInSynFamTyCon_maybe tc]+         , pr <- [ (bifinj_name bif, bifinj_axr bif) | bif <- sfInteract ops ]+              ++ [ (bifrw_name bif,  bifrw_axr bif)  | bif <- sfMatchFam ops ] ]++-------------------------------------------------------------------------------+--                   Addition (+)+-------------------------------------------------------------------------------++typeNatAddTyCon :: TyCon+typeNatAddTyCon = mkTypeNatFunTyCon2 name+  BuiltInSynFamily+    { sfMatchFam  = axAddRewrites+    , sfInteract  = axAddInjectivity+    }+  where+    name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "+")+              typeNatAddTyFamNameKey typeNatAddTyCon+++sn,tn :: TyVar  -- Of kind Natural+(sn: tn: _) = mkTemplateTyVars (repeat typeSymbolKind)++axAddRewrites :: [BuiltInFamRewrite]+axAddRewrites+  = [ mkRewriteAxiom   tc "Add0L" [tn] [num 0, var tn] (var tn)   -- 0 + t --> t+    , mkRewriteAxiom   tc "Add0R" [sn] [var sn, num 0] (var sn)   -- s + 0 --> s+    , mkBinConstFoldAxiom tc "AddDef" isNumLitTy isNumLitTy $     -- 3 + 4 --> 7+      \x y -> Just $ num (x + y) ]+  where+    tc = typeNatAddTyCon++axAddInjectivity :: [BuiltInFamInjectivity]+axAddInjectivity+  = [ -- (s + t ~ 0) => (s ~ 0)+      mkTopBinFamDeduction "AddT-0L" tc $ \ a _b r ->+      do { _ <- known r (== 0); return (Pair a (num 0)) }++    , -- (s + t ~ 0) => (t ~ 0)+      mkTopBinFamDeduction "AddT-0R" tc $ \ _a b r ->+      do { _ <- known r (== 0); return (Pair b (num 0)) }++    , -- (5 + t ~ 8) => (t ~ 3)+      mkTopBinFamDeduction "AddT-KKL" tc $ \ a b r ->+      do { na <- isNumLitTy a; nr <- known r (>= na); return (Pair b (num (nr-na))) }++    , -- (s + 5 ~ 8) => (s ~ 3)+      mkTopBinFamDeduction "AddT-KKR" tc $ \ a b r ->+      do { nb <- isNumLitTy b; nr <- known r (>= nb); return (Pair a (num (nr-nb))) }++    , mkBinBIF "AddI-xx" tc ArgX ArgX noGuard  -- x1+y1~x2+y2 {x1=x2}=> (y1 ~ y2)+    , mkBinBIF "AddI-xy" tc ArgX ArgY noGuard  -- x1+y1~x2+y2 {x1=y2}=> (x2 ~ y1)+    , mkBinBIF "AddI-yx" tc ArgY ArgX noGuard  -- x1+y1~x2+y2 {y1=x2}=> (x1 ~ y2)+    , mkBinBIF "AddI-yy" tc ArgY ArgY noGuard  -- x1+y1~x2+y2 {y1=y2}=> (x1 ~ x2)+    ]+  where+    tc = typeNatAddTyCon++-------------------------------------------------------------------------------+--                   Subtraction (-)+-------------------------------------------------------------------------------++typeNatSubTyCon :: TyCon+typeNatSubTyCon = mkTypeNatFunTyCon2 name+  BuiltInSynFamily+    { sfMatchFam = axSubRewrites+    , sfInteract = axSubInjectivity+    }+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "-")+            typeNatSubTyFamNameKey typeNatSubTyCon++axSubRewrites :: [BuiltInFamRewrite]+axSubRewrites+  = [ mkRewriteAxiom   tc "Sub0R" [sn] [var sn, num 0] (var sn)   -- s - 0 --> s+    , mkBinConstFoldAxiom tc "SubDef" isNumLitTy isNumLitTy $     -- 4 - 3 --> 1  if x>=y+      \x y -> fmap num (minus x y) ]+  where+    tc = typeNatSubTyCon++axSubInjectivity :: [BuiltInFamInjectivity]+axSubInjectivity+  = [ -- (a - b ~ 5) => (5 + b ~ a)+      mkTopBinFamDeduction "SubT" tc $ \ a b r ->+      do { _ <- isNumLitTy r; return (Pair (r .+. b) a) }++    , mkBinBIF "SubI-xx" tc ArgX ArgX noGuard -- (x-y1 ~ x-y2) => (y1 ~ y2)+    , mkBinBIF "SubI-yy" tc ArgY ArgY noGuard -- (x1-y ~ x2-y) => (x1 ~ x2)+    ]+  where+    tc = typeNatSubTyCon++{-+Note [Weakened interaction rule for subtraction]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A simpler interaction here might be:++  `s - t ~ r` --> `t + r ~ s`++This would enable us to reuse all the code for addition.+Unfortunately, this works a little too well at the moment.+Consider the following example:++    0 - 5 ~ r --> 5 + r ~ 0 --> (5 = 0, r = 0)++This (correctly) spots that the constraint cannot be solved.++However, this may be a problem if the constraint did not+need to be solved in the first place!  Consider the following example:++f :: Proxy (If (5 <=? 0) (0 - 5) (5 - 0)) -> Proxy 5+f = id++Currently, GHC is strict while evaluating functions, so this does not+work, because even though the `If` should evaluate to `5 - 0`, we+also evaluate the "then" branch which generates the constraint `0 - 5 ~ r`,+which fails.++So, for the time being, we only add an improvement when the RHS is a constant,+which happens to work OK for the moment, although clearly we need to do+something more general.+-}+++-------------------------------------------------------------------------------+--                   Multiplication (*)+-------------------------------------------------------------------------------++typeNatMulTyCon :: TyCon+typeNatMulTyCon = mkTypeNatFunTyCon2 name+  BuiltInSynFamily { sfMatchFam = axMulRewrites+                   , sfInteract = axMulInjectivity  }+  where+    name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "*")+              typeNatMulTyFamNameKey typeNatMulTyCon++axMulRewrites :: [BuiltInFamRewrite]+axMulRewrites+  = [ mkRewriteAxiom   tc "Mul0L" [tn] [num 0, var tn] (num 0)   -- 0 * t --> 0+    , mkRewriteAxiom   tc "Mul0R" [sn] [var sn, num 0] (num 0)   -- s * 0 --> 0+    , mkRewriteAxiom   tc "Mul1L" [tn] [num 1, var tn] (var tn)  -- 1 * t --> t+    , mkRewriteAxiom   tc "Mul1R" [sn] [var sn, num 1] (var sn)  -- s * 1 --> s+    , mkBinConstFoldAxiom tc "MulDef" isNumLitTy isNumLitTy $    -- 3 + 4 --> 12+      \x y -> Just $ num (x * y) ]+  where+    tc = typeNatMulTyCon++axMulInjectivity :: [BuiltInFamInjectivity]+axMulInjectivity+  = [ -- (s * t ~ 1)  => (s ~ 1)+      mkTopBinFamDeduction "MulT1" tc $ \ s _t r ->+      do { _ <- known r (== 1); return (Pair s r) }++    , -- (s * t ~ 1)  => (t ~ 1)+      mkTopBinFamDeduction "MulT2" tc $ \ _s t r ->+      do { _ <- known r (== 1); return (Pair t r) }++    , -- (3 * t ~ 15) => (t ~ 5)+      mkTopBinFamDeduction "MulT3" tc $ \ s t r ->+      do { ns <- isNumLitTy s; nr <- isNumLitTy r; y <- divide nr ns; return (Pair t (num y)) }++    , -- (s * 3 ~ 15) => (s ~ 5)+      mkTopBinFamDeduction "MulT4" tc $ \ s t r ->+      do { nt <- isNumLitTy t; nr <- isNumLitTy r; y <- divide nr nt; return (Pair s (num y)) }++    , mkBinBIF "MulI-xx" tc ArgX ArgX (numGuard (/= 0))    -- (x*y1 ~ x*y2) {x/=0}=> (y1 ~ y2)+    , mkBinBIF "MulI-yy" tc ArgY ArgY (numGuard (/= 0))    -- (x1*y ~ x2*y) {y/=0}=> (x1 ~ x2)+    ]+  where+    tc = typeNatMulTyCon+++-------------------------------------------------------------------------------+--                   Division: Div and Mod+-------------------------------------------------------------------------------++typeNatDivTyCon :: TyCon+typeNatDivTyCon = mkTypeNatFunTyCon2 name+  BuiltInSynFamily { sfMatchFam = axDivRewrites+                   , sfInteract = [] }+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Div")+            typeNatDivTyFamNameKey typeNatDivTyCon++typeNatModTyCon :: TyCon+typeNatModTyCon = mkTypeNatFunTyCon2 name+  BuiltInSynFamily { sfMatchFam = axModRewrites+                   , sfInteract = [] }+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Mod")+            typeNatModTyFamNameKey typeNatModTyCon++axDivRewrites :: [BuiltInFamRewrite]+axDivRewrites+  = [ mkRewriteAxiom   tc "Div1" [sn] [var sn, num 1] (var sn)   -- s `div` 1 --> s+    , mkBinConstFoldAxiom tc "DivDef" isNumLitTy isNumLitTy $    -- 8 `div` 4 --> 2+      \x y -> do { guard (y /= 0); return (num (div x y)) } ]+  where+    tc = typeNatDivTyCon++axModRewrites :: [BuiltInFamRewrite]+axModRewrites+  = [ mkRewriteAxiom   tc "Mod1" [sn] [var sn, num 1] (num 0)   -- s `mod` 1 --> 0+    , mkBinConstFoldAxiom tc "ModDef" isNumLitTy isNumLitTy $   -- 8 `mod` 3 --> 2+      \x y -> do { guard (y /= 0); return (num (mod x y)) } ]+  where+    tc = typeNatModTyCon++-------------------------------------------------------------------------------+--                   Exponentiation: Exp+-------------------------------------------------------------------------------++typeNatExpTyCon :: TyCon  -- Exponentiation+typeNatExpTyCon = mkTypeNatFunTyCon2 name+  BuiltInSynFamily { sfMatchFam = axExpRewrites+                   , sfInteract = axExpInjectivity }+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "^")+                typeNatExpTyFamNameKey typeNatExpTyCon++axExpRewrites :: [BuiltInFamRewrite]+axExpRewrites+  = [ mkRewriteAxiom   tc "Exp0R" [sn] [var sn, num 0] (num 1)   -- s ^ 0 --> 1+    , mkRewriteAxiom   tc "Exp1L" [tn] [num 1, var tn] (num 1)   -- 1 ^ t --> 1+    , mkRewriteAxiom   tc "Exp1R" [sn] [var sn, num 1] (var sn)  -- s ^ 1 --> s+    , mkBinConstFoldAxiom tc "ExpDef" isNumLitTy isNumLitTy $    -- 2 ^ 3 --> 8+      \x y -> Just (num (x ^ y)) ]+  where+    tc = typeNatExpTyCon++axExpInjectivity :: [BuiltInFamInjectivity]+axExpInjectivity+  = [ -- (s ^ t ~ 0) => (s ~ 0)+      mkTopBinFamDeduction "ExpT1" tc $ \ s _t r ->+      do { 0 <- isNumLitTy r; return (Pair s r) }++    , -- (2 ^ t ~ 8) => (t ~ 3)+      mkTopBinFamDeduction "ExpT2" tc $ \ s t r ->+      do { ns <- isNumLitTy s; nr <- isNumLitTy r; y <- logExact nr ns; return (Pair t (num y)) }++    , -- (s ^ 2 ~ 9) => (s ~ 3)+      mkTopBinFamDeduction "ExpT3" tc $ \ s t r ->+      do { nt <- isNumLitTy t; nr <- isNumLitTy r; y <- rootExact nr nt; return (Pair s (num y)) }++    , mkBinBIF "ExpI-xx" tc ArgX ArgX (numGuard (> 1))    -- (x^y1 ~ x^y2) {x>1}=> (y1 ~ y2)+    , mkBinBIF "ExpI-yy" tc ArgY ArgY (numGuard (/= 0))   -- (x1*y ~ x2*y) {y/=0}=> (x1 ~ x2)+    ]+  where+    tc = typeNatExpTyCon++-------------------------------------------------------------------------------+--                   Logarithm: Log2+-------------------------------------------------------------------------------++typeNatLogTyCon :: TyCon+typeNatLogTyCon = mkTypeNatFunTyCon1 name+  BuiltInSynFamily { sfMatchFam = axLogRewrites+                   , sfInteract = [] }+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Log2")+            typeNatLogTyFamNameKey typeNatLogTyCon++axLogRewrites :: [BuiltInFamRewrite]+axLogRewrites+  = [ mkUnaryConstFoldAxiom tc "LogDef" isNumLitTy $       -- log 8 --> 3+      \x -> do { (a,_) <- genLog x 2; return (num a) } ]+  where+    tc = typeNatLogTyCon++-------------------------------------------------------------------------------+--               Comparision of Nats: CmpNat+-------------------------------------------------------------------------------++typeNatCmpTyCon :: TyCon+typeNatCmpTyCon+  = mkFamilyTyCon name+      (mkTemplateAnonTyConBinders [ naturalTy, naturalTy ])+      orderingKind+      Nothing+      (BuiltInSynFamTyCon ops)+      Nothing+      NotInjective++  where+    name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS_INTERNAL (fsLit "CmpNat")+                  typeNatCmpTyFamNameKey typeNatCmpTyCon+    ops = BuiltInSynFamily { sfMatchFam = axCmpNatRewrites+                           , sfInteract = axCmpNatInjectivity }++axCmpNatRewrites :: [BuiltInFamRewrite]+axCmpNatRewrites+  = [ mkRewriteAxiom   tc "CmpNatRefl" [sn] [var sn, var sn] (ordering EQ)    -- s `cmp` s --> EQ+    , mkBinConstFoldAxiom tc "CmpNatDef" isNumLitTy isNumLitTy $              -- 2 `cmp` 3 --> LT+      \x y -> Just (ordering (compare x y)) ]+  where+    tc = typeNatCmpTyCon++axCmpNatInjectivity :: [BuiltInFamInjectivity]+axCmpNatInjectivity+  = [ -- s `cmp` t ~ EQ   ==>   s ~ t+      mkTopBinFamDeduction "CmpNatT3" typeNatCmpTyCon $ \ s t r ->+      do { EQ <- isOrderingLitTy r; return (Pair s t) } ]++-------------------------------------------------------------------------------+--              Comparsion of Symbols: CmpSymbol+-------------------------------------------------------------------------------++typeSymbolCmpTyCon :: TyCon+typeSymbolCmpTyCon =+  mkFamilyTyCon name+    (mkTemplateAnonTyConBinders [typeSymbolKind, typeSymbolKind])+    orderingKind+    Nothing+    (BuiltInSynFamTyCon ops)+    Nothing+    NotInjective++  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS_INTERNAL (fsLit "CmpSymbol")+                typeSymbolCmpTyFamNameKey typeSymbolCmpTyCon+  ops = BuiltInSynFamily { sfMatchFam = axSymbolCmpRewrites+                         , sfInteract = axSymbolCmpInjectivity }++ss,ts :: TyVar  -- Of kind Symbol+(ss: ts: _) = mkTemplateTyVars (repeat typeSymbolKind)++axSymbolCmpRewrites :: [BuiltInFamRewrite]+axSymbolCmpRewrites+  = [ mkRewriteAxiom   tc "CmpSymbolRefl" [ss] [var ss, var ss] (ordering EQ) -- s `cmp` s --> EQ+    , mkBinConstFoldAxiom tc "CmpSymbolDef" isStrLitTy isStrLitTy $           -- "a" `cmp` "b" --> LT+      \x y -> Just (ordering (lexicalCompareFS x y)) ]+  where+    tc = typeSymbolCmpTyCon++axSymbolCmpInjectivity :: [BuiltInFamInjectivity]+axSymbolCmpInjectivity+  = [ mkTopBinFamDeduction "CmpSymbolT" typeSymbolCmpTyCon $ \ s t r ->+      do { EQ <- isOrderingLitTy r; return (Pair s t) } ]+++-------------------------------------------------------------------------------+--            AppendSymbol+-------------------------------------------------------------------------------++typeSymbolAppendTyCon :: TyCon+typeSymbolAppendTyCon = mkTypeSymbolFunTyCon2 name+  BuiltInSynFamily { sfMatchFam = axAppendRewrites+                   , sfInteract = axAppendInjectivity }+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "AppendSymbol")+                typeSymbolAppendFamNameKey typeSymbolAppendTyCon++axAppendRewrites :: [BuiltInFamRewrite]+axAppendRewrites+  = [ mkRewriteAxiom   tc "Concat0R" [ts] [nullStrLitTy, var ts] (var ts) -- "" ++ t --> t+    , mkRewriteAxiom   tc "Concat0L" [ss] [var ss, nullStrLitTy] (var ss) -- s ++ "" --> s+    , mkBinConstFoldAxiom tc "AppendSymbolDef" isStrLitTy isStrLitTy $    -- "a" ++ "b" --> "ab"+      \x y -> Just (mkStrLitTy (appendFS x y)) ]+  where+    tc = typeSymbolAppendTyCon++axAppendInjectivity :: [BuiltInFamInjectivity]+axAppendInjectivity+ = [ -- (AppendSymbol a b ~ "") => (a ~ "")+     mkTopBinFamDeduction "AppendSymbolT1" tc $ \ a _b r ->+     do { rs <- isStrLitTy r; guard (nullFS rs); return (Pair a nullStrLitTy) }++   , -- (AppendSymbol a b ~ "") => (b ~ "")+     mkTopBinFamDeduction "AppendSymbolT2" tc $ \ _a b r ->+     do { rs <- isStrLitTy r; guard (nullFS rs); return (Pair b nullStrLitTy) }++   , -- (AppendSymbol "foo" b ~ "foobar") => (b ~ "bar")+     mkTopBinFamDeduction "AppendSymbolT3" tc $ \ a b r ->+     do { as <- isStrLitTyS a; rs <- isStrLitTyS r; guard (as `isPrefixOf` rs)+        ; return (Pair b (mkStrLitTyS (drop (length as) rs))) }++   , -- (AppendSymbol f "bar" ~ "foobar") => (f ~ "foo")+     mkTopBinFamDeduction "AppendSymbolT3" tc $ \ a b r ->+     do { bs <- isStrLitTyS b; rs <- isStrLitTyS r; guard (bs `isSuffixOf` rs)+        ; return (Pair a (mkStrLitTyS (take (length rs - length bs) rs))) }++    , mkBinBIF "AppI-xx" tc ArgX ArgX noGuard  -- (x++y1 ~ x++y2) => (y1 ~ y2)+    , mkBinBIF "AppI-yy" tc ArgY ArgY noGuard  -- (x1++y ~ x2++y) => (x1 ~ x2)+    ]+  where+    tc = typeSymbolAppendTyCon++-------------------------------------------------------------------------------+--            ConsSymbol+-------------------------------------------------------------------------------++typeConsSymbolTyCon :: TyCon+typeConsSymbolTyCon =+  mkFamilyTyCon name+    (mkTemplateAnonTyConBinders [ charTy, typeSymbolKind ])+    typeSymbolKind+    Nothing+    (BuiltInSynFamTyCon ops)+    Nothing+    (Injective [True, True])+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "ConsSymbol")+                  typeConsSymbolTyFamNameKey typeConsSymbolTyCon+  ops = BuiltInSynFamily  { sfMatchFam = axConsRewrites+                          , sfInteract = axConsInjectivity }++axConsRewrites :: [BuiltInFamRewrite]+axConsRewrites+  = [ mkBinConstFoldAxiom tc "ConsSymbolDef" isCharLitTy isStrLitTy $    -- 'a' : "bc" --> "abc"+      \x y -> Just $ mkStrLitTy (consFS x y) ]+  where+    tc = typeConsSymbolTyCon++axConsInjectivity :: [BuiltInFamInjectivity]+axConsInjectivity+  = [ -- ConsSymbol a b ~ "blah" => (a ~ 'b')+      mkTopBinFamDeduction "ConsSymbolT1" tc $ \ a _b r ->+      do { rs <- isStrLitTy r; (x,_) <- unconsFS rs; return (Pair a (mkCharLitTy x)) }++    , -- ConsSymbol a b ~ "blah" => (b ~ "lah")+      mkTopBinFamDeduction "ConsSymbolT2" tc $ \ _a b r ->+      do { rs <- isStrLitTy r; (_,xs) <- unconsFS rs; return (Pair b (mkStrLitTy xs)) }+++    , mkBinBIF "ConsI-xx" tc ArgX ArgX noGuard  -- (x:y1 ~ x:y2) => (y1 ~ y2)+    , mkBinBIF "ConsI-yy" tc ArgY ArgY noGuard  -- (x1:y ~ x2:y) => (x1 ~ x2)+    ]+  where+    tc = typeConsSymbolTyCon++-------------------------------------------------------------------------------+--            UnconsSymbol+-------------------------------------------------------------------------------++typeUnconsSymbolTyCon :: TyCon+typeUnconsSymbolTyCon =+  mkFamilyTyCon name+    (mkTemplateAnonTyConBinders [ typeSymbolKind ])+    (mkMaybeTy charSymbolPairKind)+    Nothing+    (BuiltInSynFamTyCon ops)+    Nothing+    (Injective [True])+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "UnconsSymbol")+                  typeUnconsSymbolTyFamNameKey typeUnconsSymbolTyCon+  ops = BuiltInSynFamily { sfMatchFam = axUnconsRewrites+                         , sfInteract = axUnconsInjectivity }++computeUncons :: FastString -> Type+computeUncons str+  = mkPromotedMaybeTy charSymbolPairKind (fmap reify (unconsFS str))+  where+    reify :: (Char, FastString) -> Type+    reify (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s)++axUnconsRewrites :: [BuiltInFamRewrite]+axUnconsRewrites+  = [ mkUnaryConstFoldAxiom tc "ConsSymbolDef" isStrLitTy $    -- 'a' : "bc" --> "abc"+      \x -> Just $ computeUncons x ]+  where+    tc = typeUnconsSymbolTyCon++axUnconsInjectivity :: [BuiltInFamInjectivity]+axUnconsInjectivity+  = [ -- (UnconsSymbol b ~ Nothing) => (b ~ "")+      mkTopUnaryFamDeduction "UnconsSymbolT1" tc $ \b r ->+      do { Nothing  <- isPromotedMaybeTy r; return (Pair b nullStrLitTy) }++    , -- (UnconsSymbol b ~ Just ('f',"oobar")) => (b ~ "foobar")+      mkTopUnaryFamDeduction "UnconsSymbolT2" tc $ \b r ->+      do { Just pr <- isPromotedMaybeTy r+         ; (c,s) <- isPromotedPairType pr+         ; chr <- isCharLitTy c+         ; str <- isStrLitTy s+         ; return (Pair b (mkStrLitTy (consFS chr str))) }++    , mkUnaryBIF "UnconsI1" tc  -- (UnconsSymbol x1 ~ z, UnconsSymbol x2 ~ z) => (x1 ~ x2)+    ]+  where+    tc = typeUnconsSymbolTyCon++-------------------------------------------------------------------------------+--            CharToNat+-------------------------------------------------------------------------------++typeCharToNatTyCon :: TyCon+typeCharToNatTyCon =+  mkFamilyTyCon name+    (mkTemplateAnonTyConBinders [ charTy ])+    naturalTy+    Nothing+    (BuiltInSynFamTyCon ops)+    Nothing+    (Injective [True])+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "CharToNat")+                  typeCharToNatTyFamNameKey typeCharToNatTyCon+  ops = BuiltInSynFamily { sfMatchFam = axCharToNatRewrites+                         , sfInteract = axCharToNatInjectivity }++axCharToNatRewrites :: [BuiltInFamRewrite]+axCharToNatRewrites+  = [ mkUnaryConstFoldAxiom tc "CharToNatDef" isCharLitTy $    -- CharToNat 'a' --> 97+      \x -> Just $ num (charToInteger x) ]+  where+    tc = typeCharToNatTyCon++axCharToNatInjectivity :: [BuiltInFamInjectivity]+axCharToNatInjectivity+  = [ -- (CharToNat c ~ 122) => (c ~ 'z')+      mkTopUnaryFamDeduction "CharToNatT1" typeCharToNatTyCon $ \c r ->+      do { nr <- isNumLitTy r; chr <- integerToChar nr; return (Pair c (mkCharLitTy chr)) } ]++-------------------------------------------------------------------------------+--            NatToChar+-------------------------------------------------------------------------------++typeNatToCharTyCon :: TyCon+typeNatToCharTyCon =+  mkFamilyTyCon name+    (mkTemplateAnonTyConBinders [ naturalTy ])+    charTy+    Nothing+    (BuiltInSynFamTyCon ops)+    Nothing+    (Injective [True])+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "NatToChar")+                  typeNatToCharTyFamNameKey typeNatToCharTyCon+  ops = BuiltInSynFamily { sfMatchFam = axNatToCharRewrites+                         , sfInteract = axNatToCharInjectivity }++axNatToCharRewrites :: [BuiltInFamRewrite]+axNatToCharRewrites+  = [ mkUnaryConstFoldAxiom tc "NatToCharDef" isNumLitTy $    -- NatToChar 97 --> 'a'+      \n -> fmap mkCharLitTy (integerToChar n) ]+  where+    tc = typeNatToCharTyCon++axNatToCharInjectivity :: [BuiltInFamInjectivity]+axNatToCharInjectivity+  = [ -- (NatToChar n ~ 'z') => (n ~ 122)+      mkTopUnaryFamDeduction "CharToNatT1" typeNatToCharTyCon $ \n r ->+      do { c <- isCharLitTy r; return (Pair n (mkNumLitTy (charToInteger c))) } ]+++-----------------------------------------------------------------------------+--                       CmpChar+-----------------------------------------------------------------------------++typeCharCmpTyCon :: TyCon+typeCharCmpTyCon =+  mkFamilyTyCon name+    (mkTemplateAnonTyConBinders [ charTy, charTy ])+    orderingKind+    Nothing+    (BuiltInSynFamTyCon ops)+    Nothing+    NotInjective+  where+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS_INTERNAL (fsLit "CmpChar")+                  typeCharCmpTyFamNameKey typeCharCmpTyCon+  ops = BuiltInSynFamily { sfMatchFam = axCharCmpRewrites+                         , sfInteract = axCharCmpInjectivity }++sc :: TyVar  -- Of kind Char+(sc: _) = mkTemplateTyVars (repeat charTy)++axCharCmpRewrites :: [BuiltInFamRewrite]+axCharCmpRewrites+  = [ mkRewriteAxiom   tc "CmpCharRefl" [sc] [var sc, var sc] (ordering EQ) -- s `cmp` s --> EQ+    , mkBinConstFoldAxiom tc "CmpCharDef" isCharLitTy isCharLitTy $         -- 'a' `cmp` 'b' --> LT+      \chr1 chr2 -> Just $ ordering $ compare chr1 chr2 ]+  where+    tc = typeCharCmpTyCon++axCharCmpInjectivity :: [BuiltInFamInjectivity]+axCharCmpInjectivity+  = [  -- (CmpChar s t ~ EQ) => s ~ t+      mkTopBinFamDeduction "CmpCharT" typeCharCmpTyCon $ \ s t r ->+      do { EQ <- isOrderingLitTy r; return (Pair s t) } ]+++{-------------------------------------------------------------------------------+Various utilities for making axioms and types+-------------------------------------------------------------------------------}++(===) :: Type -> Type -> Pair Type+x === y = Pair x y++num :: Integer -> Type+num = mkNumLitTy++var :: TyVar -> Type+var = mkTyVarTy++(.+.) :: Type -> Type -> Type+s .+. t = mkTyConApp typeNatAddTyCon [s,t]++{-+(.-.) :: Type -> Type -> Type+s .-. t = mkTyConApp typeNatSubTyCon [s,t]++(.*.) :: Type -> Type -> Type+s .*. t = mkTyConApp typeNatMulTyCon [s,t]++tDiv :: Type -> Type -> Type+tDiv s t = mkTyConApp typeNatDivTyCon [s,t]++tMod :: Type -> Type -> Type+tMod s t = mkTyConApp typeNatModTyCon [s,t]++(.^.) :: Type -> Type -> Type+s .^. t = mkTyConApp typeNatExpTyCon [s,t]++cmpNat :: Type -> Type -> Type+cmpNat s t = mkTyConApp typeNatCmpTyCon [s,t]++cmpSymbol :: Type -> Type -> Type+cmpSymbol s t = mkTyConApp typeSymbolCmpTyCon [s,t]++appendSymbol :: Type -> Type -> Type+appendSymbol s t = mkTyConApp typeSymbolAppendTyCon [s, t]+-}+++nullStrLitTy :: Type  -- The type ""+nullStrLitTy = mkStrLitTy nilFS++isStrLitTyS :: Type -> Maybe String+isStrLitTyS ty = do { fs <- isStrLitTy ty; return (unpackFS fs) }++mkStrLitTyS :: String -> Type+mkStrLitTyS s = mkStrLitTy (mkFastString s)++charSymbolPair :: Type -> Type -> Type+charSymbolPair = mkPromotedPairTy charTy typeSymbolKind++charSymbolPairKind :: Kind+charSymbolPairKind = mkTyConApp pairTyCon [charTy, typeSymbolKind]++orderingKind :: Kind+orderingKind = mkTyConApp orderingTyCon []++ordering :: Ordering -> Type+ordering o =+  case o of+    LT -> mkTyConApp promotedLTDataCon []+    EQ -> mkTyConApp promotedEQDataCon []+    GT -> mkTyConApp promotedGTDataCon []++isOrderingLitTy :: Type -> Maybe Ordering+isOrderingLitTy tc =+  do (tc1,[]) <- splitTyConApp_maybe tc+     case () of+       _ | tc1 == promotedLTDataCon -> return LT+         | tc1 == promotedEQDataCon -> return EQ+         | tc1 == promotedGTDataCon -> return GT+         | otherwise                -> Nothing++-- Make a unary built-in constructor of kind: Nat -> Nat+mkTypeNatFunTyCon1 :: Name -> BuiltInSynFamily -> TyCon+mkTypeNatFunTyCon1 op tcb =+  mkFamilyTyCon op+    (mkTemplateAnonTyConBinders [ naturalTy ])+    naturalTy+    Nothing+    (BuiltInSynFamTyCon tcb)+    Nothing+    NotInjective++-- Make a binary built-in constructor of kind: Nat -> Nat -> Nat+mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon+mkTypeNatFunTyCon2 op tcb =+  mkFamilyTyCon op+    (mkTemplateAnonTyConBinders [ naturalTy, naturalTy ])+    naturalTy+    Nothing+    (BuiltInSynFamTyCon tcb)+    Nothing+    NotInjective++-- Make a binary built-in constructor of kind: Symbol -> Symbol -> Symbol+mkTypeSymbolFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon+mkTypeSymbolFunTyCon2 op tcb =+  mkFamilyTyCon op+    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])+    typeSymbolKind+    Nothing+    (BuiltInSynFamTyCon tcb)+    Nothing+    NotInjective++same :: Type -> Type -> Maybe ()+same ty1 ty2 = guard (ty1 `tcEqType` ty2)++known :: Type -> (Integer -> Bool) -> Maybe Integer+known x p = do { nx <- isNumLitTy x; guard (p nx); return nx }++charToInteger :: Char -> Integer+charToInteger c = fromIntegral (Char.ord c)++integerToChar :: Integer -> Maybe Char+integerToChar n | inBounds = Just (Char.chr (fromInteger n))+  where inBounds = n >= charToInteger minBound &&+                   n <= charToInteger maxBound+integerToChar _ = Nothing+++{- -----------------------------------------------------------------------------+These inverse functions are used for simplifying propositions using+concrete natural numbers.+----------------------------------------------------------------------------- -}++-- | Subtract two natural numbers.+minus :: Integer -> Integer -> Maybe Integer+minus x y = if x >= y then Just (x - y) else Nothing++-- | Compute the exact logarithm of a natural number.+-- The logarithm base is the second argument.+logExact :: Integer -> Integer -> Maybe Integer+logExact x y = do (z,True) <- genLog x y+                  return z+++-- | Divide two natural numbers.+divide :: Integer -> Integer -> Maybe Integer+divide _ 0  = Nothing+divide x y  = case divMod x y of+                (a,0) -> Just a+                _     -> Nothing++-- | Compute the exact root of a natural number.+-- The second argument specifies which root we are computing.+rootExact :: Integer -> Integer -> Maybe Integer+rootExact x y = do (z,True) <- genRoot x y+                   return z++++{- | Compute the n-th root of a natural number, rounded down to+the closest natural number.  The boolean indicates if the result+is exact (i.e., True means no rounding was done, False means rounded down).+The second argument specifies which root we are computing. -}+genRoot :: Integer -> Integer -> Maybe (Integer, Bool)+genRoot _  0    = Nothing+genRoot x0 1    = Just (x0, True)+genRoot x0 root = Just (search 0 (x0+1))+  where+  search from to = let x = from + div (to - from) 2+                       a = x ^ root+                   in case compare a x0 of+                        EQ              -> (x, True)+                        LT | x /= from  -> search x to+                           | otherwise  -> (from, False)+                        GT | x /= to    -> search from x+                           | otherwise  -> (from, False)++{- | Compute the logarithm of a number in the given base, rounded down to the+closest integer.  The boolean indicates if we the result is exact+(i.e., True means no rounding happened, False means we rounded down).+The logarithm base is the second argument. -}+genLog :: Integer -> Integer -> Maybe (Integer, Bool)+genLog x 0    = if x == 1 then Just (0, True) else Nothing+genLog _ 1    = Nothing+genLog 0 _    = Nothing+genLog x base = Just (exactLoop 0 x)+  where+  exactLoop s i+    | i == 1     = (s,True)+    | i < base   = (s,False)+    | otherwise  =+        let s1 = s + 1+        in s1 `seq` case divMod i base of+                      (j,r)+                        | r == 0    -> exactLoop s1 j+                        | otherwise -> (underLoop s1 j, False)++  underLoop s i+    | i < base  = s+    | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base)+
compiler/GHC/ByteCode/Types.hs view
@@ -32,6 +32,7 @@ import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Builtin.PrimOps+import GHC.Types.SptEntry import GHC.Types.SrcLoc import GHCi.BreakArray import GHCi.RemoteTypes@@ -54,19 +55,32 @@ -- Compiled Byte Code  data CompiledByteCode = CompiledByteCode-  { bc_bcos   :: [UnlinkedBCO]  -- Bunch of interpretable bindings-  , bc_itbls  :: ItblEnv        -- A mapping from DataCons to their itbls-  , bc_ffis   :: [FFIInfo]      -- ffi blocks we allocated-  , bc_strs   :: AddrEnv        -- malloc'd top-level strings-  , bc_breaks :: Maybe ModBreaks -- breakpoint info (Nothing if we're not-                                 -- creating breakpoints, for some reason)+  { bc_bcos   :: FlatBag UnlinkedBCO+    -- ^ Bunch of interpretable bindings++  , bc_itbls  :: ItblEnv+    -- ^ Mapping from DataCons to their info tables++  , bc_ffis   :: [FFIInfo]+    -- ^ ffi blocks we allocated++  , bc_strs   :: AddrEnv+    -- ^ top-level strings (heap allocated)++  , bc_breaks :: Maybe ModBreaks+    -- ^ breakpoint info (Nothing if breakpoints are disabled)++  , bc_spt_entries :: ![SptEntry]+    -- ^ Static pointer table entries which should be loaded along with the+    -- BCOs. See Note [Grand plan for static forms] in+    -- "GHC.Iface.Tidy.StaticPtrTable".   }                 -- ToDo: we're not tracking strings that we malloc'd newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)   deriving (Show, NFData)  instance Outputable CompiledByteCode where-  ppr CompiledByteCode{..} = ppr bc_bcos+  ppr CompiledByteCode{..} = ppr $ elemsFlatBag bc_bcos  -- Not a real NFData instance, because ModBreaks contains some things -- we can't rnf
compiler/GHC/Cmm.hs view
@@ -12,22 +12,28 @@  module GHC.Cmm (      -- * Cmm top-level datatypes+     DCmmGroup,      CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,-     CmmDecl, CmmDeclSRTs, GenCmmDecl(..),-     CmmDataDecl, cmmDataDeclCmmDecl,-     CmmGraph, GenCmmGraph(..),+     CmmDecl, DCmmDecl, CmmDeclSRTs, GenCmmDecl(..),+     CmmDataDecl, cmmDataDeclCmmDecl, DCmmGraph,+     CmmGraph, GenCmmGraph, GenGenCmmGraph(..),      toBlockMap, revPostorder, toBlockList,      CmmBlock, RawCmmDecl,      Section(..), SectionType(..),      GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),      SectionProtection(..), sectionProtection, +     DWrap(..), unDeterm, removeDeterm, removeDetermDecl, removeDetermGraph,+      -- ** Blocks containing lists      GenBasicBlock(..), blockId,      ListGraph(..), pprBBlock,       -- * Info Tables-     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,+     GenCmmTopInfo(..)+     , DCmmTopInfo+     , CmmTopInfo+     , CmmStackInfo(..), CmmInfoTable(..), topInfoTable, topInfoTableD,      ClosureTypeInfo(..),      ProfilingInfo(..), ConstrDescription, @@ -74,6 +80,8 @@ type CmmProgram = [CmmGroup]  type GenCmmGroup d h g = [GenCmmDecl d h g]+-- | Cmm group after STG generation+type DCmmGroup    = GenCmmGroup CmmStatics    DCmmTopInfo              DCmmGraph -- | Cmm group before SRT generation type CmmGroup     = GenCmmGroup CmmStatics    CmmTopInfo               CmmGraph -- | Cmm group with SRTs@@ -100,7 +108,7 @@   = CmmProc     -- A procedure      h                 -- Extra header such as the info table      CLabel            -- Entry label-     [GlobalReg]       -- Registers live on entry. Note that the set of live+     [GlobalRegUse]    -- Registers live on entry. Note that the set of live                        -- registers will be correct in generated C-- code, but                        -- not in hand-written C-- code. However,                        -- splitAtProcPoints calculates correct liveness@@ -117,6 +125,7 @@       => OutputableP Platform (GenCmmDecl d info i) where     pdoc = pprTop +type DCmmDecl    = GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph type CmmDecl     = GenCmmDecl CmmStatics    CmmTopInfo CmmGraph type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph type CmmDataDecl = GenCmmDataDecl CmmStatics@@ -139,7 +148,11 @@ -----------------------------------------------------------------------------  type CmmGraph = GenCmmGraph CmmNode-data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }+type DCmmGraph = GenGenCmmGraph DWrap CmmNode++type GenCmmGraph n = GenGenCmmGraph LabelMap n++data GenGenCmmGraph s n = CmmGraph { g_entry :: BlockId, g_graph :: Graph' s Block n C C } type CmmBlock = Block CmmNode C C  instance OutputableP Platform CmmGraph where@@ -171,9 +184,17 @@  -- | CmmTopInfo is attached to each CmmDecl (see defn of CmmGroup), and contains -- the extra info (beyond the executable code) that belongs to that CmmDecl.-data CmmTopInfo   = TopInfo { info_tbls  :: LabelMap CmmInfoTable-                            , stack_info :: CmmStackInfo }+data GenCmmTopInfo f = TopInfo { info_tbls  :: f CmmInfoTable+                               , stack_info :: CmmStackInfo } +newtype DWrap a = DWrap [(BlockId, a)]++unDeterm :: DWrap a -> [(BlockId, a)]+unDeterm (DWrap f) = f++type DCmmTopInfo = GenCmmTopInfo DWrap+type CmmTopInfo  = GenCmmTopInfo LabelMap+ instance OutputableP Platform CmmTopInfo where     pdoc = pprTopInfo @@ -182,7 +203,12 @@   vcat [text "info_tbls: " <> pdoc platform info_tbl,         text "stack_info: " <> ppr stack_info] -topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable+topInfoTableD :: GenCmmDecl a DCmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable+topInfoTableD (CmmProc infos _ _ g) = case (info_tbls infos) of+                                          DWrap xs -> lookup (g_entry g) xs+topInfoTableD _                     = Nothing++topInfoTable :: GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable topInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos) topInfoTable _                     = Nothing @@ -237,6 +263,7 @@   = NoProfilingInfo   | ProfilingInfo ByteString ByteString -- closure_type, closure_desc   deriving (Eq, Ord)+ ----------------------------------------------------------------------------- --              Static Data -----------------------------------------------------------------------------@@ -304,7 +331,7 @@   ppr (CmmString _) = text "CmmString"   ppr (CmmFileEmbed fp _) = text "CmmFileEmbed" <+> text fp --- Static data before SRT generation+-- | Static data before or after SRT generation data GenCmmStatics (rawOnly :: Bool) where     CmmStatics       :: CLabel       -- Label of statics@@ -327,6 +354,61 @@  type CmmStatics    = GenCmmStatics 'False type RawCmmStatics = GenCmmStatics 'True++{-+-----------------------------------------------------------------------------+--              Deterministic Cmm / Info Tables+-----------------------------------------------------------------------------++Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Consulting Note [Object determinism] one will learn that in order to produce+deterministic objects just after cmm is produced we perform a renaming pass which+provides fresh uniques for all unique-able things in the input Cmm.++After this point, we use a deterministic unique supply (an incrementing counter)+so any resulting labels which make their way into object code have a deterministic name.++A key assumption to this process is that the input is deterministic modulo the uniques+and the order that bindings appear in the definitions is the same.++CmmGroup uses LabelMap in two places:++* In CmmProc for info tables+* In CmmGraph for the blocks of the graph++LabelMap is not a deterministic structure, so traversing a LabelMap can process+elements in different order (depending on the given uniques).++Therefore before we do the renaming we need to use a deterministic structure, one+which we can traverse in a guaranteed order. A list does the job perfectly.++Once the renaming happens it is converted back into a LabelMap, which is now deterministic+due to the uniques being generated and assigned in a deterministic manner.++We prefer using the renamed LabelMap rather than the list in the rest of the+code generation because it is much more efficient than lists for the needs of+the code generator.+-}++-- Converting out of deterministic Cmm++removeDeterm :: DCmmGroup -> CmmGroup+removeDeterm = map removeDetermDecl++removeDetermDecl :: DCmmDecl -> CmmDecl+removeDetermDecl (CmmProc h e r g) = CmmProc (removeDetermTop h) e r (removeDetermGraph g)+removeDetermDecl (CmmData a b) = CmmData a b++removeDetermTop :: DCmmTopInfo -> CmmTopInfo+removeDetermTop (TopInfo a b) = TopInfo (mapFromList $ unDeterm a) b++removeDetermGraph :: DCmmGraph -> CmmGraph+removeDetermGraph (CmmGraph x y) =+  let y' = case y of+            GMany a (DWrap b) c -> GMany a (mapFromList b) c+  in CmmGraph x y'  -- ----------------------------------------------------------------------------- -- Basic blocks consisting of lists
compiler/GHC/Cmm/BlockId.hs view
@@ -15,7 +15,7 @@ import GHC.Types.Id.Info import GHC.Types.Name import GHC.Types.Unique-import GHC.Types.Unique.Supply+import qualified GHC.Types.Unique.DSM as DSM  import GHC.Cmm.Dataflow.Label (Label, mkHooplLabel) @@ -36,8 +36,12 @@ mkBlockId :: Unique -> BlockId mkBlockId unique = mkHooplLabel $ getKey unique -newBlockId :: MonadUnique m => m BlockId-newBlockId = mkBlockId <$> getUniqueM+-- If the monad unique instance uses a deterministic unique supply, this will+-- give you a deterministic unique. Otherwise, it will not. Note that from Cmm+-- onwards (after deterministic renaming in 'codeGen'), there should only exist+-- deterministic block labels.+newBlockId :: DSM.MonadGetUnique m => m BlockId+newBlockId = mkBlockId <$> DSM.getUniqueM  blockLbl :: BlockId -> CLabel blockLbl label = mkLocalBlockLabel (getUnique label)
compiler/GHC/Cmm/CLabel.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ ----------------------------------------------------------------------------- -- -- Object-file symbols (called CLabel for historical reasons).@@ -123,6 +125,7 @@         toSlowEntryLbl,         toEntryLbl,         toInfoLbl,+        toProcDelimiterLbl,          -- * Pretty-printing         LabelStyle (..),@@ -133,8 +136,10 @@          -- * Others         dynamicLinkerLabelInfo,-        addLabelSize,-        foreignLabelStdcallInfo+        CStubLabel (..),+        cStubLabel,+        fromCStubLabel,+        mapInternalNonDetUniques     ) where  import GHC.Prelude@@ -235,10 +240,6 @@   | ForeignLabel         FastString              -- ^ name of the imported label. -        (Maybe Int)             -- ^ possible '@n' suffix for stdcall functions-                                -- When generating C, the '@n' suffix is omitted, but when-                                -- generating assembler we must add it to the label.-         ForeignLabelSource      -- ^ what package the foreign label is in.          FunctionOrData@@ -341,29 +342,40 @@    deriving (Ord,Eq)  -- This is laborious, but necessary. We can't derive Ord because--- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the--- implementation. See Note [No Ord for Unique]--- This is non-deterministic but we do not currently support deterministic--- code-generation. See Note [Unique Determinism and code generation]+-- Unique has a special Ord instance that cares for object determinism.+-- Note nonDetCmpUnique and stableNameCmp in the implementation:+--  * If -fobject-determinism, the internal uniques will be renamed, thus the+--  comparison will actually be deterministic+--  * Stable name compare guarantees deterministic ordering of Names despite+--  the non-deterministic uniques underlying external names (which aren't+--  renamed on -fobject-determinism).+-- See Note [Unique Determinism and code generation] and Note [Object determinism] instance Ord CLabel where+  compare (IdLabel a1 b1 c1)+          (IdLabel a2 b2 c2)+          | isExternalName a1, isExternalName a2 = stableNameCmp a1 a2 S.<> compare b1 b2 S.<> compare c1 c2+          | isExternalName a1 = GT+          | isExternalName a2 = LT+   compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =+    -- Comparing names here should deterministic because all unique should have+    -- been renamed deterministically, and external names compared above.     compare a1 a2 S.<>     compare b1 b2 S.<>     compare c1 c2   compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =     compare a1 a2 S.<>     compare b1 b2 S.<>-    -- This non-determinism is "safe" in the sense that it only affects object code,-    -- which is currently not covered by GHC's determinism guarantees. See #12935.+    -- This is not non-deterministic because the uniques have been deterministically renamed.+    -- See Note [Object determinism]     uniqCompareFS c1 c2 S.<>     compare d1 d2   compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2   compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2-  compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =+  compare (ForeignLabel a1 b1 c1) (ForeignLabel a2 b2 c2) =     uniqCompareFS a1 a2 S.<>     compare b1 b2 S.<>-    compare c1 c2 S.<>-    compare d1 d2+    compare c1 c2   compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2   compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =     compare a1 a2 S.<>@@ -465,8 +477,8 @@          RtsLabel{}             -> text "RtsLabel" -         ForeignLabel _name mSuffix src funOrData-             -> text "ForeignLabel" <+> ppr mSuffix <+> ppr src <+> ppr funOrData+         ForeignLabel _name src funOrData+             -> text "ForeignLabel" <+> ppr src <+> ppr funOrData           _  -> text "other CLabel" @@ -647,7 +659,7 @@     mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel,     mkOutOfBoundsAccessLabel, mkMemcpyRangeOverlapLabel,     mkMUT_VAR_CLEAN_infoLabel :: CLabel-mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction+mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel                                 = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData mkOrigThunkInfoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo@@ -665,8 +677,8 @@ mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo mkBadAlignmentLabel             = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment")      CmmEntry-mkOutOfBoundsAccessLabel        = mkForeignLabel (fsLit "rtsOutOfBoundsAccess")  Nothing ForeignLabelInExternalPackage IsFunction-mkMemcpyRangeOverlapLabel       = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") Nothing ForeignLabelInExternalPackage IsFunction+mkOutOfBoundsAccessLabel        = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") ForeignLabelInExternalPackage IsFunction+mkMemcpyRangeOverlapLabel       = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") ForeignLabelInExternalPackage IsFunction mkMUT_VAR_CLEAN_infoLabel       = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN")     CmmInfo  mkSRTInfoLabel :: Int -> CLabel@@ -750,21 +762,12 @@ -- | Make a foreign label mkForeignLabel         :: FastString           -- name-        -> Maybe Int            -- size prefix         -> ForeignLabelSource   -- what package it's in         -> FunctionOrData         -> CLabel  mkForeignLabel = ForeignLabel ---- | Update the label size field in a ForeignLabel-addLabelSize :: CLabel -> Int -> CLabel-addLabelSize (ForeignLabel str _ src  fod) sz-    = ForeignLabel str (Just sz) src fod-addLabelSize label _-    = label- -- | Whether label is a top-level string literal isBytesLabel :: CLabel -> Bool isBytesLabel (IdLabel _ _ Bytes) = True@@ -772,7 +775,7 @@  -- | Whether label is a non-haskell label (defined in C code) isForeignLabel :: CLabel -> Bool-isForeignLabel (ForeignLabel _ _ _ _) = True+isForeignLabel (ForeignLabel _ _ _) = True isForeignLabel _lbl = False  -- | Whether label is a static closure label (can come from haskell or cmm)@@ -815,12 +818,6 @@ isConInfoTableLabel (IdLabel _ _ ConInfoTable {})   = True isConInfoTableLabel _                            = False --- | Get the label size field from a ForeignLabel-foreignLabelStdcallInfo :: CLabel -> Maybe Int-foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info-foreignLabelStdcallInfo _lbl = Nothing-- -- Constructing Large*Labels mkBitmapLabel   :: Unique -> CLabel mkBitmapLabel   uniq            = LargeBitmapLabel uniq@@ -945,6 +942,16 @@    CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet    _                             -> pprPanic "toEntryLbl" (pprDebugCLabel platform lbl) +-- | Generate a CmmProc delimiter label from the actual entry label.+--+-- This delimiter label might be the entry label itself, except when the entry+-- label is a LocalBlockLabel. If we reused the entry label to delimit the proc,+-- we would generate redundant labels (see #22792)+toProcDelimiterLbl :: CLabel -> CLabel+toProcDelimiterLbl lbl = case lbl of+  LocalBlockLabel {} -> mkAsmTempDerivedLabel lbl (fsLit "_entry")+  _                  -> lbl+ toInfoLbl :: Platform -> CLabel -> CLabel toInfoLbl platform lbl = case lbl of    IdLabel n c LocalEntry      -> IdLabel n c LocalInfoTable@@ -1052,7 +1059,7 @@ --      to the C compiler. For these labels we avoid generating our --      own C prototypes. isMathFun :: CLabel -> Bool-isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs+isMathFun (ForeignLabel fs _ _)       = fs `elementOfUniqSet` math_funs isMathFun _ = False  math_funs :: UniqSet FastString@@ -1217,8 +1224,8 @@ labelType (RtsLabel (RtsSlowFastTickyCtr _))    = DataLabel labelType (LocalBlockLabel _)                   = CodeLabel labelType (SRTLabel _)                          = DataLabel-labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel-labelType (ForeignLabel _ _ _ IsData)           = DataLabel+labelType (ForeignLabel _ _ IsFunction)         = CodeLabel+labelType (ForeignLabel _ _ IsData)             = DataLabel labelType (AsmTempLabel _)                      = panic "labelType(AsmTempLabel)" labelType (AsmTempDerivedLabel _ _)             = panic "labelType(AsmTempDerivedLabel)" labelType (StringLitLabel _)                    = DataLabel@@ -1297,7 +1304,7 @@     LocalBlockLabel _    -> False -   ForeignLabel _ _ source _  ->+   ForeignLabel _ source _  ->        if os == OSMinGW32        then case source of             -- Foreign label is in some un-named foreign package (or DLL).@@ -1424,11 +1431,11 @@  -- | Style of label pretty-printing. ----- When we produce C sources or headers, we have to take into account that C--- compilers transform C labels when they convert them into symbols. For--- example, they can add prefixes (e.g., "_" on Darwin) or suffixes (size for--- stdcalls on Windows). So we provide two ways to pretty-print CLabels: C style--- or Asm style.+-- When we produce C sources or headers, we have to take into account+-- that C compilers transform C labels when they convert them into+-- symbols. For example, they can add prefixes (e.g., "_" on Darwin).+-- So we provide two ways to pretty-print CLabels: C style or Asm+-- style. -- data LabelStyle    = CStyle   -- ^ C label style (used by C and LLVM backends)@@ -1479,10 +1486,17 @@       -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u     AsmTempDerivedLabel l suf-      -> asmTempLabelPrefix platform-         <> case l of AsmTempLabel u    -> pprUniqueAlways u-                      LocalBlockLabel u -> pprUniqueAlways u-                      _other            -> pprCLabelStyle platform sty l+         -- we print a derived label, so we just print the parent label+         -- recursively. However we don't want to print the temp prefix (e.g.+         -- ".L") twice, so we must explicitely handle these cases.+      -> let skipTempPrefix = \case+                AsmTempLabel u            -> pprUniqueAlways u+                AsmTempDerivedLabel l suf -> skipTempPrefix l <> ftext suf+                LocalBlockLabel u         -> pprUniqueAlways u+                lbl                       -> pprAsmLabel platform lbl+         in+         asmTempLabelPrefix platform+         <> skipTempPrefix l          <> ftext suf     DynamicLinkerLabel info lbl@@ -1504,17 +1518,9 @@    StringLitLabel u       -> maybe_underscore $ pprUniqueAlways u <> text "_str" -   ForeignLabel fs (Just sz) _ _-      | AsmStyle <- sty-      , OSMinGW32 <- platformOS platform-      -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.-         -- (The C compiler does this itself).-         maybe_underscore $ ftext fs <> char '@' <> int sz--   ForeignLabel fs _ _ _+   ForeignLabel fs _ _       -> maybe_underscore $ ftext fs -    IdLabel name _cafs flavor -> case sty of       AsmStyle -> maybe_underscore $ internalNamePrefix <> pprName name <> ppIdFlavor flavor                    where@@ -1689,11 +1695,7 @@             GotSymbolPtr    -> ppLbl <> text "@GOTPCREL"             GotSymbolOffset -> ppLbl         | platformArch platform == ArchAArch64 -> ppLbl-        | otherwise ->-          case dllInfo of-            CodeStub  -> char 'L' <> ppLbl <> text "$stub"-            SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"-            _         -> panic "pprDynamicLinkerAsmLabel"+        | otherwise -> panic "pprDynamicLinkerAsmLabel"        OSAIX ->           case dllInfo of@@ -1720,6 +1722,8 @@       | platformArch platform == ArchAArch64       = ppLbl +      | platformArch platform == ArchRISCV64+      = ppLbl        | platformArch platform == ArchX86_64       = case dllInfo of@@ -1878,3 +1882,74 @@      T15155.a_closure `mayRedirectTo` a1_rXq_closure+1 returns True. -}++-- | This type encodes the subset of 'CLabel' that occurs in C stubs of foreign+-- declarations for the purpose of serializing to interface files.+--+-- See Note [Foreign stubs and TH bytecode linking]+data CStubLabel =+  CStubLabel {+    csl_is_initializer :: Bool,+    csl_module :: Module,+    csl_name :: FastString+  }++instance Outputable CStubLabel where+  ppr CStubLabel {csl_is_initializer, csl_module, csl_name} =+    text ini <+> ppr csl_module <> colon <> text (unpackFS csl_name)+    where+      ini = if csl_is_initializer then "initializer" else "finalizer"++-- | Project the constructor 'ModuleLabel' out of 'CLabel' if it is an+-- initializer or finalizer.+cStubLabel :: CLabel -> Maybe CStubLabel+cStubLabel = \case+  ModuleLabel csl_module label_kind -> do+    (csl_is_initializer, csl_name) <- case label_kind of+      MLK_Initializer (LexicalFastString s) -> Just (True, s)+      MLK_Finalizer (LexicalFastString s) -> Just (False, s)+      _ -> Nothing+    Just (CStubLabel {csl_is_initializer, csl_module, csl_name})+  _ -> Nothing++-- | Inject a 'CStubLabel' into a 'CLabel' as a 'ModuleLabel'.+fromCStubLabel :: CStubLabel -> CLabel+fromCStubLabel (CStubLabel {csl_is_initializer, csl_module, csl_name}) =+  ModuleLabel csl_module (label_kind (LexicalFastString csl_name))+  where+    label_kind =+      if csl_is_initializer+      then MLK_Initializer+      else MLK_Finalizer++-- | A utility for renaming uniques in CLabels to produce deterministic object.+-- Note that not all Uniques are mapped over. Only those that can be safely alpha+-- renamed, e.g. uniques of local symbols, but not of external ones.+-- See Note [Renaming uniques deterministically].+mapInternalNonDetUniques :: Applicative m => (Unique -> m Unique) -> CLabel -> m CLabel+-- todo: Can we do less work here, e.g., do we really need to rename AsmTempLabel, LocalBlockLabel?+mapInternalNonDetUniques f x = case x of+  IdLabel name cafInfo idLabelInfo+    | not (isExternalName name) -> IdLabel . setNameUnique name <$> f (nameUnique name) <*> pure cafInfo <*> pure idLabelInfo+    | otherwise -> pure x+  cl@CmmLabel{} -> pure cl+  RtsLabel rtsLblInfo -> pure $ RtsLabel rtsLblInfo+  LocalBlockLabel unique -> LocalBlockLabel <$> f unique+  fl@ForeignLabel{} -> pure fl+  AsmTempLabel unique -> AsmTempLabel <$> f unique+  AsmTempDerivedLabel clbl fs -> AsmTempDerivedLabel <$> mapInternalNonDetUniques f clbl <*> pure fs+  StringLitLabel unique -> StringLitLabel <$> f unique+  CC_Label  cc -> pure $ CC_Label cc+  CCS_Label ccs -> pure $ CCS_Label ccs+  IPE_Label ipe@InfoProvEnt{infoTablePtr} ->+    (\cl' -> IPE_Label ipe{infoTablePtr = cl'}) <$> mapInternalNonDetUniques f infoTablePtr+  ml@ModuleLabel{} -> pure ml+  DynamicLinkerLabel dlli clbl -> DynamicLinkerLabel dlli <$> mapInternalNonDetUniques f clbl+  PicBaseLabel -> pure PicBaseLabel+  DeadStripPreventer clbl -> DeadStripPreventer <$> mapInternalNonDetUniques f clbl+  HpcTicksLabel mod -> pure $ HpcTicksLabel mod+  SRTLabel unique -> SRTLabel <$> f unique+  LargeBitmapLabel unique -> LargeBitmapLabel <$> f unique+-- This is called *a lot* if renaming Cmm uniques, and won't specialise without this pragma:+{-# INLINABLE mapInternalNonDetUniques #-}+
compiler/GHC/Cmm/Dataflow/Graph.hs view
@@ -26,10 +26,10 @@ import Data.Kind  -- | A (possibly empty) collection of closed/closed blocks-type Body n = LabelMap (Block n C C)+type Body s n = Body' s Block n  -- | @Body@ abstracted over @block@-type Body' block (n :: Extensibility -> Extensibility -> Type) = LabelMap (block n C C)+type Body' s block (n :: Extensibility -> Extensibility -> Type) = s (block n C C)  ------------------------------- -- | Gives access to the anchor points for@@ -46,13 +46,13 @@   successors (BlockCC _ _ n) = successors n  -emptyBody :: Body' block n+emptyBody :: Body' LabelMap block n emptyBody = mapEmpty -bodyList :: Body' block n -> [(Label,block n C C)]+bodyList :: Body' LabelMap block n -> [(Label,block n C C)] bodyList body = mapToList body -bodyToBlockList :: Body n -> [Block n C C]+bodyToBlockList :: Body LabelMap n -> [Block n C C] bodyToBlockList body = mapElems body  addBlock@@ -72,18 +72,18 @@ -- O/C, C/O, C/C).  A graph open at the entry has a single, -- distinguished, anonymous entry point; if a graph is closed at the -- entry, its entry point(s) are supplied by a context.-type Graph = Graph' Block+type Graph = Graph' LabelMap Block  -- | @Graph'@ is abstracted over the block type, so that we can build -- graphs of annotated blocks for example (Compiler.Hoopl.Dataflow -- needs this).-data Graph' block (n :: Extensibility -> Extensibility -> Type) e x where-  GNil  :: Graph' block n O O-  GUnit :: block n O O -> Graph' block n O O+data Graph' s block (n :: Extensibility -> Extensibility -> Type) e x where+  GNil  :: Graph' s block n O O+  GUnit :: block n O O -> Graph' s block n O O   GMany :: MaybeO e (block n O C)-        -> Body' block n+        -> Body' s block n         -> MaybeO x (block n C O)-        -> Graph' block n e x+        -> Graph' s block n e x   -- -----------------------------------------------------------------------------@@ -91,26 +91,27 @@  -- | Maps over all nodes in a graph. mapGraph :: (forall e x. n e x -> n' e x) -> Graph n e x -> Graph n' e x-mapGraph f = mapGraphBlocks (mapBlock f)+mapGraph f = mapGraphBlocks mapMap (mapBlock f)  -- | Function 'mapGraphBlocks' enables a change of representation of blocks, -- nodes, or both.  It lifts a polymorphic block transform into a polymorphic -- graph transform.  When the block representation stabilizes, a similar -- function should be provided for blocks.-mapGraphBlocks :: forall block n block' n' e x .-                  (forall e x . block n e x -> block' n' e x)-               -> (Graph' block n e x -> Graph' block' n' e x)+mapGraphBlocks :: forall s block n block' n' e x .+                  (forall a b . (a -> b) -> s a -> s b)+               -> (forall e x . block n e x -> block' n' e x)+               -> (Graph' s block n e x -> Graph' s block' n' e x) -mapGraphBlocks f = map-  where map :: Graph' block n e x -> Graph' block' n' e x+mapGraphBlocks f g = map+  where map :: Graph' s block n e x -> Graph' s block' n' e x         map GNil = GNil-        map (GUnit b) = GUnit (f b)-        map (GMany e b x) = GMany (fmap f e) (mapMap f b) (fmap f x)+        map (GUnit b) = GUnit (g b)+        map (GMany e b x) = GMany (fmap g e) (f g b) (fmap g x)  -- ----------------------------------------------------------------------------- -- Extracting Labels from graphs -labelsDefined :: forall block n e x . NonLocal (block n) => Graph' block n e x+labelsDefined :: forall block n e x . NonLocal (block n) => Graph' LabelMap block n e x               -> LabelSet labelsDefined GNil      = setEmpty labelsDefined (GUnit{}) = setEmpty
compiler/GHC/Cmm/MachOp.hs view
@@ -7,6 +7,7 @@     , pprMachOp, isCommutableMachOp, isAssociativeMachOp     , isComparisonMachOp, maybeIntComparison, machOpResultType     , machOpArgReps, maybeInvertComparison, isFloatComparison+    , isCommutableCallishMachOp      -- MachOp builders     , mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot@@ -115,7 +116,7 @@    -- Floating-point fused multiply-add operations   -- | Fused multiply-add, see 'FMASign'.-  | MO_FMA FMASign Width+  | MO_FMA FMASign Length Width    -- Floating point comparison   | MO_F_Eq Width@@ -125,6 +126,9 @@   | MO_F_Gt Width   | MO_F_Lt Width +  | MO_F_Min Width+  | MO_F_Max Width+   -- Bitwise operations.  Not all of these may be supported   -- at all sizes, and only integral Widths are valid.   | MO_And   Width@@ -139,8 +143,8 @@    -- Conversions.  Some of these will be NOPs.   -- Floating-point conversions use the signed variant.-  | MO_SF_Conv Width Width      -- Signed int -> Float-  | MO_FS_Conv Width Width      -- Float -> Signed int+  | MO_SF_Round    Width Width  -- Signed int -> Float+  | MO_FS_Truncate Width Width  -- Float -> Signed int   | MO_SS_Conv Width Width      -- Signed int -> Signed int   | MO_UU_Conv Width Width      -- unsigned int -> unsigned int   | MO_XX_Conv Width Width      -- int -> int; puts no requirements on the@@ -151,11 +155,15 @@                                 -- MO_XX_Conv, e.g.,                                 --   MO_XX_CONV W64 W8 (MO_XX_CONV W8 W64 x)                                 -- is equivalent to just x.-  | MO_FF_Conv Width Width      -- Float -> Float+  | MO_FF_Conv Width Width      -- Float  -> Float +  | MO_WF_Bitcast Width      -- Word32/Word64   -> Float/Double+  | MO_FW_Bitcast Width      -- Float/Double  -> Word32/Word64+   -- Vector element insertion and extraction operations-  | MO_V_Insert  Length Width   -- Insert scalar into vector-  | MO_V_Extract Length Width   -- Extract scalar from vector+  | MO_V_Broadcast Length Width -- Broadcast a scalar into a vector+  | MO_V_Insert    Length Width -- Insert scalar into vector+  | MO_V_Extract   Length Width -- Extract scalar from vector    -- Integer vector operations   | MO_V_Add Length Width@@ -171,9 +179,14 @@   | MO_VU_Quot Length Width   | MO_VU_Rem  Length Width +  -- Vector shuffles+  | MO_V_Shuffle  Length Width [Int]+  | MO_VF_Shuffle Length Width [Int]+   -- Floating point vector element insertion and extraction operations-  | MO_VF_Insert  Length Width   -- Insert scalar into vector-  | MO_VF_Extract Length Width   -- Extract scalar from vector+  | MO_VF_Broadcast Length Width   -- Broadcast a scalar into a vector+  | MO_VF_Insert    Length Width   -- Insert scalar into vector+  | MO_VF_Extract   Length Width   -- Extract scalar from vector    -- Floating point vector operations   | MO_VF_Add  Length Width@@ -182,6 +195,14 @@   | MO_VF_Mul  Length Width   | MO_VF_Quot Length Width +  -- Min/max operations+  | MO_VS_Min Length Width+  | MO_VS_Max Length Width+  | MO_VU_Min Length Width+  | MO_VU_Max Length Width+  | MO_VF_Min Length Width+  | MO_VF_Max Length Width+   -- | An atomic read with no memory ordering. Address msut   -- be naturally aligned.   | MO_RelaxedRead Width@@ -312,6 +333,8 @@         MO_Xor _                -> True         MO_F_Add _              -> True         MO_F_Mul _              -> True+        MO_F_Min {}             -> True+        MO_F_Max {}             -> True         _other                  -> False  -- ----------------------------------------------------------------------------@@ -406,16 +429,16 @@ maybeInvertComparison :: MachOp -> Maybe MachOp maybeInvertComparison op   = case op of  -- None of these Just cases include floating point-        MO_Eq r   -> Just (MO_Ne r)-        MO_Ne r   -> Just (MO_Eq r)-        MO_U_Lt r -> Just (MO_U_Ge r)-        MO_U_Gt r -> Just (MO_U_Le r)-        MO_U_Le r -> Just (MO_U_Gt r)-        MO_U_Ge r -> Just (MO_U_Lt r)-        MO_S_Lt r -> Just (MO_S_Ge r)-        MO_S_Gt r -> Just (MO_S_Le r)-        MO_S_Le r -> Just (MO_S_Gt r)-        MO_S_Ge r -> Just (MO_S_Lt r)+        MO_Eq w   -> Just (MO_Ne w)+        MO_Ne w   -> Just (MO_Eq w)+        MO_U_Lt w -> Just (MO_U_Ge w)+        MO_U_Gt w -> Just (MO_U_Le w)+        MO_U_Le w -> Just (MO_U_Gt w)+        MO_U_Ge w -> Just (MO_U_Lt w)+        MO_S_Lt w -> Just (MO_S_Ge w)+        MO_S_Gt w -> Just (MO_S_Le w)+        MO_S_Le w -> Just (MO_S_Gt w)+        MO_S_Ge w -> Just (MO_S_Lt w)         _other    -> Nothing  -- ----------------------------------------------------------------------------@@ -429,13 +452,13 @@   case mop of     MO_Add {}           -> ty1  -- Preserve GC-ptr-hood     MO_Sub {}           -> ty1  -- of first arg-    MO_Mul    r         -> cmmBits r-    MO_S_MulMayOflo r   -> cmmBits r-    MO_S_Quot r         -> cmmBits r-    MO_S_Rem  r         -> cmmBits r-    MO_S_Neg  r         -> cmmBits r-    MO_U_Quot r         -> cmmBits r-    MO_U_Rem  r         -> cmmBits r+    MO_Mul    w         -> cmmBits w+    MO_S_MulMayOflo w   -> cmmBits w+    MO_S_Quot w         -> cmmBits w+    MO_S_Rem  w         -> cmmBits w+    MO_S_Neg  w         -> cmmBits w+    MO_U_Quot w         -> cmmBits w+    MO_U_Rem  w         -> cmmBits w      MO_Eq {}            -> comparisonResultRep platform     MO_Ne {}            -> comparisonResultRep platform@@ -449,13 +472,15 @@     MO_U_Gt {}          -> comparisonResultRep platform     MO_U_Lt {}          -> comparisonResultRep platform -    MO_F_Add r          -> cmmFloat r-    MO_F_Sub r          -> cmmFloat r-    MO_F_Mul r          -> cmmFloat r-    MO_F_Quot r         -> cmmFloat r-    MO_F_Neg r          -> cmmFloat r+    MO_F_Add w          -> cmmFloat w+    MO_F_Sub w          -> cmmFloat w+    MO_F_Mul w          -> cmmFloat w+    MO_F_Quot w         -> cmmFloat w+    MO_F_Neg w          -> cmmFloat w+    MO_F_Min w          -> cmmFloat w+    MO_F_Max w          -> cmmFloat w -    MO_FMA _ r          -> cmmFloat r+    MO_FMA _ l w        -> if l == 1 then cmmFloat w else cmmVec l (cmmFloat w)      MO_F_Eq  {}         -> comparisonResultRep platform     MO_F_Ne  {}         -> comparisonResultRep platform@@ -467,18 +492,21 @@     MO_And {}           -> ty1  -- Used for pointer masking     MO_Or {}            -> ty1     MO_Xor {}           -> ty1-    MO_Not   r          -> cmmBits r-    MO_Shl   r          -> cmmBits r-    MO_U_Shr r          -> cmmBits r-    MO_S_Shr r          -> cmmBits r+    MO_Not   w          -> cmmBits w+    MO_Shl   w          -> cmmBits w+    MO_U_Shr w          -> cmmBits w+    MO_S_Shr w          -> cmmBits w      MO_SS_Conv _ to     -> cmmBits to     MO_UU_Conv _ to     -> cmmBits to     MO_XX_Conv _ to     -> cmmBits to-    MO_FS_Conv _ to     -> cmmBits to-    MO_SF_Conv _ to     -> cmmFloat to+    MO_FS_Truncate _ to -> cmmBits to+    MO_SF_Round _ to    -> cmmFloat to     MO_FF_Conv _ to     -> cmmFloat to+    MO_WF_Bitcast   w   -> cmmFloat w+    MO_FW_Bitcast   w   -> cmmBits w +    MO_V_Broadcast l w  -> cmmVec l (cmmBits w)     MO_V_Insert  l w    -> cmmVec l (cmmBits w)     MO_V_Extract _ w    -> cmmBits w @@ -489,10 +517,18 @@     MO_VS_Quot l w      -> cmmVec l (cmmBits w)     MO_VS_Rem  l w      -> cmmVec l (cmmBits w)     MO_VS_Neg  l w      -> cmmVec l (cmmBits w)+    MO_VS_Min  l w      -> cmmVec l (cmmBits w)+    MO_VS_Max  l w      -> cmmVec l (cmmBits w)      MO_VU_Quot l w      -> cmmVec l (cmmBits w)     MO_VU_Rem  l w      -> cmmVec l (cmmBits w)+    MO_VU_Min  l w      -> cmmVec l (cmmBits w)+    MO_VU_Max  l w      -> cmmVec l (cmmBits w) +    MO_V_Shuffle  l w _ -> cmmVec l (cmmBits w)+    MO_VF_Shuffle l w _ -> cmmVec l (cmmFloat w)++    MO_VF_Broadcast l w -> cmmVec l (cmmFloat w)     MO_VF_Insert  l w   -> cmmVec l (cmmFloat w)     MO_VF_Extract _ w   -> cmmFloat w @@ -501,8 +537,10 @@     MO_VF_Mul  l w      -> cmmVec l (cmmFloat w)     MO_VF_Quot l w      -> cmmVec l (cmmFloat w)     MO_VF_Neg  l w      -> cmmVec l (cmmFloat w)+    MO_VF_Min  l w      -> cmmVec l (cmmFloat w)+    MO_VF_Max  l w      -> cmmVec l (cmmFloat w) -    MO_RelaxedRead r    -> cmmBits r+    MO_RelaxedRead w    -> cmmBits w     MO_AlignmentCheck _ _ -> ty1   where     (ty1:_) = tys@@ -522,83 +560,101 @@ machOpArgReps :: Platform -> MachOp -> [Width] machOpArgReps platform op =   case op of-    MO_Add    r         -> [r,r]-    MO_Sub    r         -> [r,r]-    MO_Eq     r         -> [r,r]-    MO_Ne     r         -> [r,r]-    MO_Mul    r         -> [r,r]-    MO_S_MulMayOflo r   -> [r,r]-    MO_S_Quot r         -> [r,r]-    MO_S_Rem  r         -> [r,r]-    MO_S_Neg  r         -> [r]-    MO_U_Quot r         -> [r,r]-    MO_U_Rem  r         -> [r,r]+    MO_Add    w         -> [w,w]+    MO_Sub    w         -> [w,w]+    MO_Eq     w         -> [w,w]+    MO_Ne     w         -> [w,w]+    MO_Mul    w         -> [w,w]+    MO_S_MulMayOflo w   -> [w,w]+    MO_S_Quot w         -> [w,w]+    MO_S_Rem  w         -> [w,w]+    MO_S_Neg  w         -> [w]+    MO_U_Quot w         -> [w,w]+    MO_U_Rem  w         -> [w,w] -    MO_S_Ge r           -> [r,r]-    MO_S_Le r           -> [r,r]-    MO_S_Gt r           -> [r,r]-    MO_S_Lt r           -> [r,r]+    MO_S_Ge w           -> [w,w]+    MO_S_Le w           -> [w,w]+    MO_S_Gt w           -> [w,w]+    MO_S_Lt w           -> [w,w] -    MO_U_Ge r           -> [r,r]-    MO_U_Le r           -> [r,r]-    MO_U_Gt r           -> [r,r]-    MO_U_Lt r           -> [r,r]+    MO_U_Ge w           -> [w,w]+    MO_U_Le w           -> [w,w]+    MO_U_Gt w           -> [w,w]+    MO_U_Lt w           -> [w,w] -    MO_F_Add r          -> [r,r]-    MO_F_Sub r          -> [r,r]-    MO_F_Mul r          -> [r,r]-    MO_F_Quot r         -> [r,r]-    MO_F_Neg r          -> [r]+    MO_F_Add w          -> [w,w]+    MO_F_Sub w          -> [w,w]+    MO_F_Mul w          -> [w,w]+    MO_F_Quot w         -> [w,w]+    MO_F_Neg w          -> [w]+    MO_F_Min w          -> [w,w]+    MO_F_Max w          -> [w,w] -    MO_FMA _ r          -> [r,r,r]+    MO_FMA _ l w        -> [vecwidth l w, vecwidth l w, vecwidth l w] -    MO_F_Eq  r          -> [r,r]-    MO_F_Ne  r          -> [r,r]-    MO_F_Ge  r          -> [r,r]-    MO_F_Le  r          -> [r,r]-    MO_F_Gt  r          -> [r,r]-    MO_F_Lt  r          -> [r,r]+    MO_F_Eq  w          -> [w,w]+    MO_F_Ne  w          -> [w,w]+    MO_F_Ge  w          -> [w,w]+    MO_F_Le  w          -> [w,w]+    MO_F_Gt  w          -> [w,w]+    MO_F_Lt  w          -> [w,w] -    MO_And   r          -> [r,r]-    MO_Or    r          -> [r,r]-    MO_Xor   r          -> [r,r]-    MO_Not   r          -> [r]-    MO_Shl   r          -> [r, wordWidth platform]-    MO_U_Shr r          -> [r, wordWidth platform]-    MO_S_Shr r          -> [r, wordWidth platform]+    MO_And   w          -> [w,w]+    MO_Or    w          -> [w,w]+    MO_Xor   w          -> [w,w]+    MO_Not   w          -> [w]+    MO_Shl   w          -> [w, wordWidth platform]+    MO_U_Shr w          -> [w, wordWidth platform]+    MO_S_Shr w          -> [w, wordWidth platform] -    MO_SS_Conv from _   -> [from]-    MO_UU_Conv from _   -> [from]-    MO_XX_Conv from _   -> [from]-    MO_SF_Conv from _   -> [from]-    MO_FS_Conv from _   -> [from]-    MO_FF_Conv from _   -> [from]+    MO_SS_Conv from _     -> [from]+    MO_UU_Conv from _     -> [from]+    MO_XX_Conv from _     -> [from]+    MO_SF_Round from _    -> [from]+    MO_FS_Truncate from _ -> [from]+    MO_FF_Conv from _     -> [from]+    MO_WF_Bitcast w       -> [w]+    MO_FW_Bitcast w       -> [w] -    MO_V_Insert   l r   -> [typeWidth (vec l (cmmBits r)),r, W32]-    MO_V_Extract  l r   -> [typeWidth (vec l (cmmBits r)), W32]-    MO_VF_Insert  l r   -> [typeWidth (vec l (cmmFloat r)),r,W32]-    MO_VF_Extract l r   -> [typeWidth (vec l (cmmFloat r)),W32]+    MO_V_Shuffle  l w _ -> [vecwidth l w, vecwidth l w]+    MO_VF_Shuffle l w _ -> [vecwidth l w, vecwidth l w]++    MO_V_Broadcast _ w  -> [w]+    MO_V_Insert   l w   -> [vecwidth l w, w, W32]+    MO_V_Extract  l w   -> [vecwidth l w, W32]+    MO_VF_Broadcast _ w -> [w]+    MO_VF_Insert  l w   -> [vecwidth l w, w, W32]+    MO_VF_Extract l w   -> [vecwidth l w, W32]       -- SIMD vector indices are always 32 bit -    MO_V_Add _ r        -> [r,r]-    MO_V_Sub _ r        -> [r,r]-    MO_V_Mul _ r        -> [r,r]+    MO_V_Add l w        -> [vecwidth l w, vecwidth l w]+    MO_V_Sub l w        -> [vecwidth l w, vecwidth l w]+    MO_V_Mul l w        -> [vecwidth l w, vecwidth l w] -    MO_VS_Quot _ r      -> [r,r]-    MO_VS_Rem  _ r      -> [r,r]-    MO_VS_Neg  _ r      -> [r]+    MO_VS_Quot l w      -> [vecwidth l w, vecwidth l w]+    MO_VS_Rem  l w      -> [vecwidth l w, vecwidth l w]+    MO_VS_Neg  l w      -> [vecwidth l w]+    MO_VS_Min  l w      -> [vecwidth l w, vecwidth l w]+    MO_VS_Max  l w      -> [vecwidth l w, vecwidth l w] -    MO_VU_Quot _ r      -> [r,r]-    MO_VU_Rem  _ r      -> [r,r]+    MO_VU_Quot l w      -> [vecwidth l w, vecwidth l w]+    MO_VU_Rem  l w      -> [vecwidth l w, vecwidth l w]+    MO_VU_Min  l w      -> [vecwidth l w, vecwidth l w]+    MO_VU_Max  l w      -> [vecwidth l w, vecwidth l w] -    MO_VF_Add  _ r      -> [r,r]-    MO_VF_Sub  _ r      -> [r,r]-    MO_VF_Mul  _ r      -> [r,r]-    MO_VF_Quot _ r      -> [r,r]-    MO_VF_Neg  _ r      -> [r]+    -- NOTE: The below is owing to the fact that floats use the SSE registers+    MO_VF_Add  l w      -> [vecwidth l w, vecwidth l w]+    MO_VF_Sub  l w      -> [vecwidth l w, vecwidth l w]+    MO_VF_Mul  l w      -> [vecwidth l w, vecwidth l w]+    MO_VF_Quot l w      -> [vecwidth l w, vecwidth l w]+    MO_VF_Neg  l w      -> [vecwidth l w]+    MO_VF_Min  l w      -> [vecwidth l w, vecwidth l w]+    MO_VF_Max  l w      -> [vecwidth l w, vecwidth l w]      MO_RelaxedRead _    -> [wordWidth platform]-    MO_AlignmentCheck _ r -> [r]+    MO_AlignmentCheck _ w -> [w]+  where+    vecwidth l w = widthFromBytes (l * widthInBytes w)  ----------------------------------------------------------------------------- -- CallishMachOp@@ -790,3 +846,17 @@   MO_Memmove align -> Just align   MO_Memcmp  align -> Just align   _                -> Nothing++isCommutableCallishMachOp :: CallishMachOp -> Bool+isCommutableCallishMachOp op =+  case op of+    MO_x64_Add  -> True+    MO_x64_Mul  -> True+    MO_x64_Eq   -> True+    MO_x64_Ne   -> True+    MO_x64_And  -> True+    MO_x64_Or   -> True+    MO_x64_Xor  -> True+    MO_S_Mul2 _ -> True+    MO_U_Mul2 _ -> True+    _ -> False
compiler/GHC/Cmm/Node.hs view
@@ -118,7 +118,7 @@           -- occur in CmmExprs, namely as (CmmLit (CmmBlock b)) or           -- (CmmStackSlot (Young b) _). -      cml_args_regs :: [GlobalReg],+      cml_args_regs :: [GlobalRegUse],           -- The argument GlobalRegs (Rx, Fx, Dx, Lx) that are passed           -- to the call.  This is essential information for the           -- native code generator's register allocator; without@@ -502,7 +502,7 @@  = pdoc platform                (mkForeignLabel                           (mkFastString (show op))-                          Nothing ForeignLabelInThisPackage IsFunction)+                          ForeignLabelInThisPackage IsFunction)  instance Outputable Convention where   ppr = pprConvention@@ -544,7 +544,7 @@                => (b -> LocalReg -> b) -> b -> a -> b           fold f z n = foldRegsUsed platform f z n -instance UserOfRegs GlobalReg (CmmNode e x) where+instance UserOfRegs GlobalRegUse (CmmNode e x) where   {-# INLINEABLE foldRegsUsed #-}   foldRegsUsed platform f !z n = case n of     CmmAssign _ expr -> fold f z expr@@ -555,8 +555,8 @@     CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt     CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args     _ -> z-    where fold :: forall a b.  UserOfRegs GlobalReg a-               => (b -> GlobalReg -> b) -> b -> a -> b+    where fold :: forall a b.  UserOfRegs GlobalRegUse a+               => (b -> GlobalRegUse -> b) -> b -> a -> b           fold f z n = foldRegsUsed platform f z n instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where   -- The (Ord r) in the context is necessary here@@ -576,7 +576,7 @@                => (b -> LocalReg -> b) -> b -> a -> b           fold f z n = foldRegsDefd platform f z n -instance DefinerOfRegs GlobalReg (CmmNode e x) where+instance DefinerOfRegs GlobalRegUse (CmmNode e x) where   {-# INLINEABLE foldRegsDefd #-}   foldRegsDefd platform f !z n = case n of     CmmAssign lhs _ -> fold f z lhs@@ -585,12 +585,13 @@     CmmForeignCall {} -> fold f z activeRegs                       -- See Note [Safe foreign calls clobber STG registers]     _ -> z-    where fold :: forall a b. DefinerOfRegs GlobalReg a-               => (b -> GlobalReg -> b) -> b -> a -> b+    where fold :: forall a b. DefinerOfRegs GlobalRegUse a+               => (b -> GlobalRegUse -> b) -> b -> a -> b           fold f z n = foldRegsDefd platform f z n -          activeRegs = activeStgRegs platform-          activeCallerSavesRegs = filter (callerSaves platform) activeRegs+          activeRegs :: [GlobalRegUse]+          activeRegs = map (\ r -> GlobalRegUse r (globalRegSpillType platform r)) $ activeStgRegs platform+          activeCallerSavesRegs = filter (callerSaves platform . globalRegUse_reg) activeRegs            foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []           foreignTargetRegs _ = activeCallerSavesRegs
compiler/GHC/Cmm/Reg.hs view
@@ -16,6 +16,8 @@     , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg     , node, baseReg     , GlobalRegUse(..), pprGlobalRegUse++    , GlobalArgRegs(..)     ) where  import GHC.Prelude@@ -61,14 +63,14 @@ -- See Note [GlobalReg vs GlobalRegUse] for more information. data GlobalRegUse   = GlobalRegUse-    { globalRegUseGlobalReg :: !GlobalReg+    { globalRegUse_reg  :: !GlobalReg       -- ^ The underlying 'GlobalReg'-    , globalRegUseType      :: !CmmType+    , globalRegUse_type :: !CmmType       -- ^ The 'CmmType' at which we are using the 'GlobalReg'.       --       -- Its width must be less than the width of the 'GlobalReg':       ---      -- > typeWidth ty <= typeWidth (globalRegSpillType reg)+      -- > typeWidth ty <= typeWidth (globalRegSpillType platform reg)     }   deriving Show @@ -96,12 +98,12 @@ pprReg :: CmmReg -> SDoc pprReg r    = case r of-        CmmLocal  local                   -> pprLocalReg  local-        CmmGlobal (GlobalRegUse global _) -> pprGlobalReg global+        CmmLocal  local                     -> pprLocalReg  local+        CmmGlobal (GlobalRegUse global _ty) -> pprGlobalReg global  cmmRegType :: CmmReg -> CmmType cmmRegType (CmmLocal  reg) = localRegType reg-cmmRegType (CmmGlobal reg) = globalRegUseType reg+cmmRegType (CmmGlobal reg) = globalRegUse_type reg  cmmRegWidth :: CmmReg -> Width cmmRegWidth = typeWidth . cmmRegType@@ -202,6 +204,13 @@   | LongReg             -- long int registers (64-bit, really)         {-# UNPACK #-} !Int     -- its number +  -- I think we should redesign 'GlobalReg', for example instead of+  -- FloatReg/DoubleReg/XmmReg/YmmReg/ZmmReg we could have a single VecReg+  -- which also stores the type we are storing in it.+  --+  -- We might then be able to get rid of GlobalRegUse, as the type information+  -- would already be contained in a 'GlobalReg'.+   | XmmReg                      -- 128-bit SIMD vector register         {-# UNPACK #-} !Int     -- its number @@ -212,39 +221,40 @@         {-# UNPACK #-} !Int     -- its number    -- STG registers-  | Sp                  -- Stack ptr; points to last occupied stack location.-  | SpLim               -- Stack limit-  | Hp                  -- Heap ptr; points to last occupied heap location.-  | HpLim               -- Heap limit register-  | CCCS                -- Current cost-centre stack-  | CurrentTSO          -- pointer to current thread's TSO-  | CurrentNursery      -- pointer to allocation area-  | HpAlloc             -- allocation count for heap check failure+  | Sp                  -- ^ Stack ptr; points to last occupied stack location.+  | SpLim               -- ^ Stack limit+  | Hp                  -- ^ Heap ptr; points to last occupied heap location.+  | HpLim               -- ^ Heap limit register+  | CCCS                -- ^ Current cost-centre stack+  | CurrentTSO          -- ^ pointer to current thread's TSO+  | CurrentNursery      -- ^ pointer to allocation area+  | HpAlloc             -- ^ allocation count for heap check failure                  -- We keep the address of some commonly-called                 -- functions in the register table, to keep code                 -- size down:-  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info-  | GCEnter1            -- stg_gc_enter_1-  | GCFun               -- stg_gc_fun+  | EagerBlackholeInfo  -- ^ address of stg_EAGER_BLACKHOLE_info+  | GCEnter1            -- ^ address of stg_gc_enter_1+  | GCFun               -- ^ address of stg_gc_fun -  -- Base offset for the register table, used for accessing registers+  -- | Base offset for the register table, used for accessing registers   -- which do not have real registers assigned to them.  This register   -- will only appear after we have expanded GlobalReg into memory accesses   -- (where necessary) in the native code generator.   | BaseReg -  -- The register used by the platform for the C stack pointer. This is+  -- | The register used by the platform for the C stack pointer. This is   -- a break in the STG abstraction used exclusively to setup stack unwinding   -- information.   | MachSp -  -- The is a dummy register used to indicate to the stack unwinder where+  -- | A dummy register used to indicate to the stack unwinder where   -- a routine would return to.   | UnwindReturnReg -  -- Base Register for PIC (position-independent code) calculations-  -- Only used inside the native code generator. It's exact meaning differs+  -- | Base Register for PIC (position-independent code) calculations.+  --+  -- Only used inside the native code generator. Its exact meaning differs   -- from platform to platform (see module PositionIndependentCode).   | PicBaseReg @@ -331,3 +341,24 @@ isArgReg (YmmReg {})     = True isArgReg (ZmmReg {})     = True isArgReg _               = False++-- --------------------------------------------------------------------------++-- | Global registers used for argument passing.+--+-- See Note [realArgRegsCover] in GHC.Cmm.CallConv.+data GlobalArgRegs+  -- | General-purpose (integer) argument-passing registers.+  = GP_ARG_REGS+  -- | Scalar (integer & floating-point) argument-passing registers.+  | SCALAR_ARG_REGS+  -- | 16 byte vector argument-passing registers, together with+  -- integer & floating-point argument-passing scalar registers.+  | V16_ARG_REGS+  -- | 32 byte vector argument-passing registers, together with+  -- integer & floating-point argument-passing scalar registers.+  | V32_ARG_REGS+  -- | 64 byte vector argument-passing registers, together with+  -- integer & floating-point argument-passing scalar registers.+  | V64_ARG_REGS+  deriving ( Show, Eq, Ord )
compiler/GHC/Cmm/Switch.hs view
@@ -4,7 +4,7 @@      SwitchTargets,      mkSwitchTargets,      switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned,-     mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough,+     mapSwitchTargets, mapSwitchTargetsA, switchTargetsToTable, switchTargetsFallThrough,      switchTargetsToList, eqSwitchTargetWith,       SwitchPlan(..),@@ -135,6 +135,11 @@ mapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets mapSwitchTargets f (SwitchTargets signed range mbdef branches)     = SwitchTargets signed range (fmap f mbdef) (fmap f branches)++-- | Changes all labels mentioned in the SwitchTargets value+mapSwitchTargetsA :: Applicative m => (Label -> m Label) -> SwitchTargets -> m SwitchTargets+mapSwitchTargetsA f (SwitchTargets signed range mbdef branches)+    = SwitchTargets signed range <$> traverse f mbdef <*> traverse f branches  -- | Returns the list of non-default branches of the SwitchTargets value switchTargetsCases :: SwitchTargets -> [(Integer, Label)]
compiler/GHC/Cmm/Type.hs view
@@ -4,7 +4,7 @@     , cInt     , cmmBits, cmmFloat     , typeWidth, setCmmTypeWidth-    , cmmEqType, cmmEqType_ignoring_ptrhood+    , cmmEqType, cmmCompatType     , isFloatType, isGcPtrType, isBitsType     , isWordAny, isWord32, isWord64     , isFloat64, isFloat32@@ -87,21 +87,27 @@ cmmEqType :: CmmType -> CmmType -> Bool -- Exact equality cmmEqType (CmmType c1 w1) (CmmType c2 w2) = c1==c2 && w1==w2 -cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool-  -- This equality is temporary; used in CmmLint-  -- but the RTS files are not yet well-typed wrt pointers-cmmEqType_ignoring_ptrhood (CmmType c1 w1) (CmmType c2 w2)-   = c1 `weak_eq` c2 && w1==w2+-- | A weaker notion of equality of 'CmmType's than 'cmmEqType',+-- used (only) in Cmm Lint.+--+-- Why "weaker"? Because:+--+--  - we don't distinguish GcPtr vs NonGcPtr, because the the RTS files+--    are not yet well-typed wrt pointers,+--  - for vectors, we only compare the widths, because in practice things like+--    X86 xmm registers support different types of data (e.g. 4xf32, 2xf64, 2xu64 etc).+cmmCompatType :: CmmType -> CmmType -> Bool+cmmCompatType (CmmType c1 w1) (CmmType c2 w2)+   = c1 `weak_eq` c2 && w1 == w2    where      weak_eq :: CmmCat -> CmmCat -> Bool-     FloatCat         `weak_eq` FloatCat         = True-     FloatCat         `weak_eq` _other           = False-     _other           `weak_eq` FloatCat         = False-     (VecCat l1 cat1) `weak_eq` (VecCat l2 cat2) = l1 == l2-                                                   && cat1 `weak_eq` cat2-     (VecCat {})      `weak_eq` _other           = False-     _other           `weak_eq` (VecCat {})      = False-     _word1           `weak_eq` _word2           = True        -- Ignores GcPtr+     FloatCat    `weak_eq` FloatCat    = True+     FloatCat    `weak_eq` _other      = False+     _other      `weak_eq` FloatCat    = False+     (VecCat {}) `weak_eq` (VecCat {}) = True  -- only compare overall width+     (VecCat {}) `weak_eq` _other      = False+     _other      `weak_eq` (VecCat {}) = False+     _word1      `weak_eq` _word2      = True  -- Ignores GcPtr  --- Simple operations on CmmType ----- typeWidth :: CmmType -> Width
+ compiler/GHC/Cmm/Utils.hs view
@@ -0,0 +1,603 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}++{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++-----------------------------------------------------------------------------+--+-- Cmm utilities.+--+-- (c) The University of Glasgow 2004-2006+--+-----------------------------------------------------------------------------++module GHC.Cmm.Utils(+        -- CmmType+        primRepCmmType, slotCmmType,+        typeCmmType, typeForeignHint, primRepForeignHint,++        -- CmmLit+        zeroCLit, mkIntCLit,+        mkWordCLit, packHalfWordsCLit,+        mkByteStringCLit, mkFileEmbedLit,+        mkDataLits, mkRODataLits,+        mkStgWordCLit,++        -- CmmExpr+        mkIntExpr, zeroExpr,+        mkLblExpr,+        cmmRegOff,  cmmOffset,  cmmLabelOff,  cmmOffsetLit,  cmmOffsetExpr,+        cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB,+        cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW,+        cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW,+        cmmLoadBWord, cmmLoadGCWord,+        cmmNegate,+        cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,+        cmmSLtWord,+        cmmNeWord, cmmEqWord,+        cmmOrWord, cmmAndWord,+        cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord,+        cmmToWord,++        cmmMkAssign,++        baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,+        currentTSOExpr, currentNurseryExpr, cccsExpr,++        -- Tagging+        cmmTagMask, cmmPointerMask, cmmUntag, cmmIsTagged, cmmIsNotTagged,+        cmmConstrTag1, mAX_PTR_TAG, tAG_MASK,++        -- Overlap and usage+        regsOverlap, globalRegsOverlap, regUsedIn, globalRegUsedIn,++        -- Liveness and bitmaps+        mkLiveness,++        -- * Operations that probably don't belong here+        modifyGraph,++        ofBlockMap, toBlockMap,+        ofBlockList, toBlockList,+        toBlockListEntryFirst, toBlockListEntryFirstFalseFallthrough,+        foldlGraphBlocks, mapGraphNodes, mapGraphNodes1,++        -- * Ticks+        blockTicks+  ) where++import GHC.Prelude++import GHC.Core.TyCon     ( PrimRep(..), PrimElemRep(..) )+import GHC.Types.RepType  ( NvUnaryType, SlotTy (..), typePrimRepU )++import GHC.Platform+import GHC.Runtime.Heap.Layout+import GHC.Cmm+import GHC.Cmm.BlockId+import GHC.Cmm.CLabel+import GHC.Utils.Outputable+import GHC.Utils.Panic+import GHC.Types.Unique+import GHC.Platform.Regs++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import GHC.Cmm.Dataflow.Graph+import GHC.Cmm.Dataflow.Label+import GHC.Cmm.Dataflow.Block++---------------------------------------------------+--+--      CmmTypes+--+---------------------------------------------------++primRepCmmType :: Platform -> PrimRep -> CmmType+primRepCmmType platform = \case+   BoxedRep _       -> gcWord platform+   IntRep           -> bWord platform+   WordRep          -> bWord platform+   Int8Rep          -> b8+   Word8Rep         -> b8+   Int16Rep         -> b16+   Word16Rep        -> b16+   Int32Rep         -> b32+   Word32Rep        -> b32+   Int64Rep         -> b64+   Word64Rep        -> b64+   AddrRep          -> bWord platform+   FloatRep         -> f32+   DoubleRep        -> f64+   VecRep len rep   -> vec len (primElemRepCmmType rep)++slotCmmType :: Platform -> SlotTy -> CmmType+slotCmmType platform = \case+   PtrUnliftedSlot -> gcWord platform+   PtrLiftedSlot   -> gcWord platform+   WordSlot        -> bWord platform+   Word64Slot      -> b64+   FloatSlot       -> f32+   DoubleSlot      -> f64+   VecSlot l e     -> vec l (primElemRepCmmType e)++primElemRepCmmType :: PrimElemRep -> CmmType+primElemRepCmmType Int8ElemRep   = b8+primElemRepCmmType Int16ElemRep  = b16+primElemRepCmmType Int32ElemRep  = b32+primElemRepCmmType Int64ElemRep  = b64+primElemRepCmmType Word8ElemRep  = b8+primElemRepCmmType Word16ElemRep = b16+primElemRepCmmType Word32ElemRep = b32+primElemRepCmmType Word64ElemRep = b64+primElemRepCmmType FloatElemRep  = f32+primElemRepCmmType DoubleElemRep = f64++typeCmmType :: Platform -> NvUnaryType -> CmmType+typeCmmType platform ty = primRepCmmType platform (typePrimRepU ty)++primRepForeignHint :: PrimRep -> ForeignHint+primRepForeignHint (BoxedRep _) = AddrHint+primRepForeignHint IntRep       = SignedHint+primRepForeignHint Int8Rep      = SignedHint+primRepForeignHint Int16Rep     = SignedHint+primRepForeignHint Int32Rep     = SignedHint+primRepForeignHint Int64Rep     = SignedHint+primRepForeignHint WordRep      = NoHint+primRepForeignHint Word8Rep     = NoHint+primRepForeignHint Word16Rep    = NoHint+primRepForeignHint Word32Rep    = NoHint+primRepForeignHint Word64Rep    = NoHint+primRepForeignHint AddrRep      = AddrHint -- NB! AddrHint, but NonPtrArg+primRepForeignHint FloatRep     = NoHint+primRepForeignHint DoubleRep    = NoHint+primRepForeignHint (VecRep {})  = NoHint++typeForeignHint :: NvUnaryType -> ForeignHint+typeForeignHint = primRepForeignHint . typePrimRepU++---------------------------------------------------+--+--      CmmLit+--+---------------------------------------------------++-- XXX: should really be Integer, since Int doesn't necessarily cover+-- the full range of target Ints.+mkIntCLit :: Platform -> Int -> CmmLit+mkIntCLit platform i = CmmInt (toInteger i) (wordWidth platform)++mkIntExpr :: Platform -> Int -> CmmExpr+mkIntExpr platform i = CmmLit $! mkIntCLit platform i++zeroCLit :: Platform -> CmmLit+zeroCLit platform = CmmInt 0 (wordWidth platform)++zeroExpr :: Platform -> CmmExpr+zeroExpr platform = CmmLit (zeroCLit platform)++mkWordCLit :: Platform -> Integer -> CmmLit+mkWordCLit platform wd = CmmInt wd (wordWidth platform)++-- | We make a top-level decl for the string, and return a label pointing to it+mkByteStringCLit+  :: CLabel -> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)+mkByteStringCLit lbl bytes+  = (CmmLabel lbl, CmmData (Section sec lbl) $ CmmStaticsRaw lbl [CmmString bytes])+  where+    -- This can not happen for String literals (as there \NUL is replaced by+    -- C0 80). However, it can happen with Addr# literals.+    sec = if 0 `BS.elem` bytes then ReadOnlyData else CString++-- | We make a top-level decl for the embedded binary file, and return a label pointing to it+mkFileEmbedLit+  :: CLabel -> FilePath -> Int -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)+mkFileEmbedLit lbl path len+  = (CmmLabel lbl, CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmFileEmbed path len]))+++-- | Build a data-segment data block+mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt+mkDataLits section lbl lits+  = CmmData section (CmmStaticsRaw lbl $ map CmmStaticLit lits)++mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt+-- Build a read-only data block+mkRODataLits lbl lits+  = mkDataLits section lbl lits+  where+    section | any needsRelocation lits = Section RelocatableReadOnlyData lbl+            | otherwise                = Section ReadOnlyData lbl+    needsRelocation (CmmLabel _)      = True+    needsRelocation (CmmLabelOff _ _) = True+    needsRelocation _                 = False++mkStgWordCLit :: Platform -> StgWord -> CmmLit+mkStgWordCLit platform wd = CmmInt (fromStgWord wd) (wordWidth platform)++packHalfWordsCLit :: Platform -> StgHalfWord -> StgHalfWord -> CmmLit+-- Make a single word literal in which the lower_half_word is+-- at the lower address, and the upper_half_word is at the+-- higher address+-- ToDo: consider using half-word lits instead+--       but be careful: that's vulnerable when reversed+packHalfWordsCLit platform lower_half_word upper_half_word+   = case platformByteOrder platform of+       BigEndian    -> mkWordCLit platform ((l `shiftL` halfWordSizeInBits platform) .|. u)+       LittleEndian -> mkWordCLit platform (l .|. (u `shiftL` halfWordSizeInBits platform))+    where l = fromStgHalfWord lower_half_word+          u = fromStgHalfWord upper_half_word++---------------------------------------------------+--+--      CmmExpr+--+---------------------------------------------------++mkLblExpr :: CLabel -> CmmExpr+mkLblExpr lbl = CmmLit (CmmLabel lbl)++cmmOffsetExpr :: Platform -> CmmExpr -> CmmExpr -> CmmExpr+-- assumes base and offset have the same CmmType+cmmOffsetExpr platform e (CmmLit (CmmInt n _)) = cmmOffset platform e (fromInteger n)+cmmOffsetExpr platform e byte_off = CmmMachOp (MO_Add (cmmExprWidth platform e)) [e, byte_off]++cmmOffset :: Platform -> CmmExpr -> Int -> CmmExpr+cmmOffset _platform e 0        = e+cmmOffset platform  e byte_off = case e of+   CmmReg reg            -> cmmRegOff reg byte_off+   CmmRegOff reg m       -> cmmRegOff reg (m+byte_off)+   CmmLit lit            -> CmmLit (cmmOffsetLit lit byte_off)+   CmmStackSlot area off -> CmmStackSlot area (off - byte_off)+  -- note stack area offsets increase towards lower addresses+   CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]+      -> let !lit_off = (byte_off1 + toInteger byte_off)+         in CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt lit_off rep)]+   _ -> let !width = cmmExprWidth platform e+        in+        CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)]++-- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.+cmmRegOff :: CmmReg -> Int -> CmmExpr+cmmRegOff reg 0        = CmmReg reg+cmmRegOff reg byte_off = CmmRegOff reg byte_off++cmmOffsetLit :: CmmLit -> Int -> CmmLit+cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff l byte_off+cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)+cmmOffsetLit (CmmLabelDiffOff l1 l2 m w) byte_off+                                        = CmmLabelDiffOff l1 l2 (m+byte_off) w+cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep+cmmOffsetLit _                 byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)++cmmLabelOff :: CLabel -> Int -> CmmLit+-- Smart constructor for CmmLabelOff+cmmLabelOff lbl 0        = CmmLabel lbl+cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off++-- | Useful for creating an index into an array, with a statically known offset.+-- The type is the element type; used for making the multiplier+cmmIndex :: Platform+         -> Width       -- Width w+         -> CmmExpr     -- Address of vector of items of width w+         -> Int         -- Which element of the vector (0 based)+         -> CmmExpr     -- Address of i'th element+cmmIndex platform width base idx = cmmOffset platform base (idx * widthInBytes width)++-- | Useful for creating an index into an array, with an unknown offset.+cmmIndexExpr :: Platform+             -> Width           -- Width w+             -> CmmExpr         -- Address of vector of items of width w+             -> CmmExpr         -- Which element of the vector (0 based)+             -> CmmExpr         -- Address of i'th element+cmmIndexExpr platform width base (CmmLit (CmmInt n _)) = cmmIndex platform width base (fromInteger n)+cmmIndexExpr platform width base idx =+  cmmOffsetExpr platform base byte_off+  where+    idx_w = cmmExprWidth platform idx+    byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr platform (widthInLog width)]++cmmLoadIndex :: Platform -> CmmType -> CmmExpr -> Int -> CmmExpr+cmmLoadIndex platform ty expr ix =+    CmmLoad (cmmIndex platform (typeWidth ty) expr ix) ty NaturallyAligned -- TODO: Audit uses++-- | Load a naturally-aligned non-pointer word.+cmmLoadBWord :: Platform -> CmmExpr -> CmmExpr+cmmLoadBWord platform ptr = CmmLoad ptr (bWord platform) NaturallyAligned++-- | Load a naturally-aligned GC pointer.+cmmLoadGCWord :: Platform -> CmmExpr -> CmmExpr+cmmLoadGCWord platform ptr = CmmLoad ptr (gcWord platform) NaturallyAligned++-- The "B" variants take byte offsets+cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr+cmmRegOffB = cmmRegOff++cmmOffsetB :: Platform -> CmmExpr -> ByteOff -> CmmExpr+cmmOffsetB = cmmOffset++cmmOffsetExprB :: Platform -> CmmExpr -> CmmExpr -> CmmExpr+cmmOffsetExprB = cmmOffsetExpr++cmmLabelOffB :: CLabel -> ByteOff -> CmmLit+cmmLabelOffB = cmmLabelOff++cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit+cmmOffsetLitB = cmmOffsetLit++-----------------------+-- The "W" variants take word offsets++cmmOffsetExprW :: Platform -> CmmExpr -> CmmExpr -> CmmExpr+-- The second arg is a *word* offset; need to change it to bytes+cmmOffsetExprW platform  e (CmmLit (CmmInt n _)) = cmmOffsetW platform e (fromInteger n)+cmmOffsetExprW platform e wd_off = cmmIndexExpr platform (wordWidth platform) e wd_off++cmmOffsetW :: Platform -> CmmExpr -> WordOff -> CmmExpr+cmmOffsetW platform e n = cmmOffsetB platform e (wordsToBytes platform n)++cmmRegOffW :: Platform -> CmmReg -> WordOff -> CmmExpr+cmmRegOffW platform reg wd_off = cmmRegOffB reg (wordsToBytes platform wd_off)++cmmOffsetLitW :: Platform -> CmmLit -> WordOff -> CmmLit+cmmOffsetLitW platform lit wd_off = cmmOffsetLitB lit (wordsToBytes platform wd_off)++cmmLabelOffW :: Platform -> CLabel -> WordOff -> CmmLit+cmmLabelOffW platform lbl wd_off = cmmLabelOffB lbl (wordsToBytes platform wd_off)++cmmLoadIndexW :: Platform -> CmmExpr -> Int -> CmmType -> CmmExpr+cmmLoadIndexW platform base off ty =+    CmmLoad (cmmOffsetW platform base off) ty NaturallyAligned -- TODO: Audit ses++-----------------------+cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,+  cmmSLtWord,+  cmmNeWord, cmmEqWord,+  cmmOrWord, cmmAndWord,+  cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord+  :: Platform -> CmmExpr -> CmmExpr -> CmmExpr+cmmOrWord platform  e1 e2 = CmmMachOp (mo_wordOr platform)  [e1, e2]+cmmAndWord platform e1 e2 = CmmMachOp (mo_wordAnd platform) [e1, e2]+cmmNeWord platform  e1 e2 = CmmMachOp (mo_wordNe platform)  [e1, e2]+cmmEqWord platform  e1 e2 = CmmMachOp (mo_wordEq platform)  [e1, e2]+cmmULtWord platform e1 e2 = CmmMachOp (mo_wordULt platform) [e1, e2]+cmmUGeWord platform e1 e2 = CmmMachOp (mo_wordUGe platform) [e1, e2]+cmmUGtWord platform e1 e2 = CmmMachOp (mo_wordUGt platform) [e1, e2]+cmmSLtWord platform e1 e2 = CmmMachOp (mo_wordSLt platform) [e1, e2]+cmmUShrWord platform e1 e2 = CmmMachOp (mo_wordUShr platform) [e1, e2]+cmmAddWord platform e1 e2 = CmmMachOp (mo_wordAdd platform) [e1, e2]+cmmSubWord platform e1 e2 = CmmMachOp (mo_wordSub platform) [e1, e2]+cmmMulWord platform e1 e2 = CmmMachOp (mo_wordMul platform) [e1, e2]+cmmQuotWord platform e1 e2 = CmmMachOp (mo_wordUQuot platform) [e1, e2]++cmmNegate :: Platform -> CmmExpr -> CmmExpr+cmmNegate platform = \case+   (CmmLit (CmmInt n rep))+     -> CmmLit (CmmInt (-n) rep)+   e -> CmmMachOp (MO_S_Neg (cmmExprWidth platform e)) [e]++cmmToWord :: Platform -> CmmExpr -> CmmExpr+cmmToWord platform e+  | w == word  = e+  | otherwise  = CmmMachOp (MO_UU_Conv w word) [e]+  where+    w = cmmExprWidth platform e+    word = wordWidth platform++cmmMkAssign :: Platform -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr)+cmmMkAssign platform expr uq =+  let !ty = cmmExprType platform expr+      reg = (CmmLocal (LocalReg uq ty))+  in  (CmmAssign reg expr, CmmReg reg)+++---------------------------------------------------+--+--      Tagging+--+---------------------------------------------------++tAG_MASK :: Platform -> Int+tAG_MASK platform = (1 `shiftL` pc_TAG_BITS (platformConstants platform)) - 1++mAX_PTR_TAG :: Platform -> Int+mAX_PTR_TAG = tAG_MASK++-- Tag bits mask+cmmTagMask, cmmPointerMask :: Platform -> CmmExpr+cmmTagMask platform = mkIntExpr platform (tAG_MASK platform)+cmmPointerMask platform = mkIntExpr platform (complement (tAG_MASK platform))++-- Used to untag a possibly tagged pointer+-- A static label need not be untagged+cmmUntag, cmmIsTagged, cmmIsNotTagged, cmmConstrTag1 :: Platform -> CmmExpr -> CmmExpr+cmmUntag _ e@(CmmLit (CmmLabel _)) = e+-- Default case+cmmUntag platform e = cmmAndWord platform e (cmmPointerMask platform)++-- Test if a closure pointer is untagged/tagged.+cmmIsTagged platform e = cmmNeWord platform (cmmAndWord platform e (cmmTagMask platform)) (zeroExpr platform)+cmmIsNotTagged platform e = cmmEqWord platform (cmmAndWord platform e (cmmTagMask platform)) (zeroExpr platform)++-- Get constructor tag, but one based.+cmmConstrTag1 platform e = cmmAndWord platform e (cmmTagMask platform)+++-----------------------------------------------------------------------------+-- Overlap and usage++-- | Returns True if the two STG registers overlap on the specified+-- platform, in the sense that writing to one will clobber the+-- other. This includes the case that the two registers are the same+-- STG register. See Note [Overlapping global registers] for details.+regsOverlap :: Platform -> CmmReg -> CmmReg -> Bool+regsOverlap platform (CmmGlobal (GlobalRegUse g1 _)) (CmmGlobal (GlobalRegUse g2 _))+  = globalRegsOverlap platform g1 g2+regsOverlap _ reg reg' = reg == reg'++globalRegsOverlap :: Platform -> GlobalReg -> GlobalReg -> Bool+globalRegsOverlap platform g1 g2+  | Just real  <- globalRegMaybe platform g1+  , Just real' <- globalRegMaybe platform g2+  , real == real'+  = True+  | otherwise+  = g1 == g2++-- | Returns True if the STG register is used by the expression, in+-- the sense that a store to the register might affect the value of+-- the expression.+--+-- We must check for overlapping registers and not just equal+-- registers here, otherwise CmmSink may incorrectly reorder+-- assignments that conflict due to overlap. See #10521 and Note+-- [Overlapping global registers].+regUsedIn :: Platform -> CmmReg -> CmmExpr -> Bool+regUsedIn platform = regUsedIn_ where+  _   `regUsedIn_` CmmLit _         = False+  reg `regUsedIn_` CmmLoad e _ _    = reg `regUsedIn_` e+  reg `regUsedIn_` CmmReg reg'      = regsOverlap platform reg reg'+  reg `regUsedIn_` CmmRegOff reg' _ = regsOverlap platform reg reg'+  reg `regUsedIn_` CmmMachOp _ es   = any (reg `regUsedIn_`) es+  _   `regUsedIn_` CmmStackSlot _ _ = False++globalRegUsedIn :: Platform -> GlobalReg -> CmmExpr -> Bool+globalRegUsedIn platform = globalRegUsedIn_ where+  _   `globalRegUsedIn_` CmmLit _+    = False+  reg `globalRegUsedIn_` CmmLoad e _ _+    = reg `globalRegUsedIn_` e+  reg `globalRegUsedIn_` CmmReg reg'+    | CmmGlobal (GlobalRegUse reg' _) <- reg'+    = globalRegsOverlap platform reg reg'+    | otherwise+    = False+  reg `globalRegUsedIn_` CmmRegOff reg' _+    | CmmGlobal (GlobalRegUse reg' _) <- reg'+    = globalRegsOverlap platform reg reg'+    | otherwise+    = False+  reg `globalRegUsedIn_` CmmMachOp _ es+    = any (reg `globalRegUsedIn_`) es+  _   `globalRegUsedIn_` CmmStackSlot _ _+    = False++--------------------------------------------+--+--        mkLiveness+--+---------------------------------------------++mkLiveness :: Platform -> [LocalReg] -> Liveness+mkLiveness _      [] = []+mkLiveness platform (reg:regs)+  = bits ++ mkLiveness platform regs+  where+    word_size = platformWordSizeInBytes platform+    sizeW = (widthInBytes (typeWidth (localRegType reg)) + word_size - 1)+            `quot` word_size+            -- number of words, rounded up+    bits = replicate sizeW is_non_ptr -- True <=> Non Ptr++    is_non_ptr = not $ isGcPtrType (localRegType reg)+++-- ============================================== -+-- ============================================== -+-- ============================================== -++---------------------------------------------------+--+--      Manipulating CmmGraphs+--+---------------------------------------------------++modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'+modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}++ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph+ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}++-- | like 'toBlockList', but the entry block always comes first+toBlockListEntryFirst :: CmmGraph -> [CmmBlock]+toBlockListEntryFirst g+  | mapNull m  = []+  | otherwise  = entry_block : others+  where+    m = toBlockMap g+    entry_id = g_entry g+    Just entry_block = mapLookup entry_id m+    others = filter ((/= entry_id) . entryLabel) (mapElems m)++-- | Like 'toBlockListEntryFirst', but we strive to ensure that we order blocks+-- so that the false case of a conditional jumps to the next block in the output+-- list of blocks. This matches the way OldCmm blocks were output since in+-- OldCmm the false case was a fallthrough, whereas in Cmm conditional branches+-- have both true and false successors. Block ordering can make a big difference+-- in performance in the LLVM backend. Note that we rely crucially on the order+-- of successors returned for CmmCondBranch by the NonLocal instance for CmmNode+-- defined in "GHC.Cmm.Node". -GBM+toBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock]+toBlockListEntryFirstFalseFallthrough g+  | mapNull m  = []+  | otherwise  = dfs setEmpty [entry_block]+  where+    m = toBlockMap g+    entry_id = g_entry g+    Just entry_block = mapLookup entry_id m++    dfs :: LabelSet -> [CmmBlock] -> [CmmBlock]+    dfs _ [] = []+    dfs visited (block:bs)+      | id `setMember` visited = dfs visited bs+      | otherwise              = block : dfs (setInsert id visited) bs'+      where id = entryLabel block+            bs' = foldr add_id bs (successors block)+            add_id id bs = case mapLookup id m of+                              Just b  -> b : bs+                              Nothing -> bs++ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph+ofBlockList entry blocks = CmmGraph { g_entry = entry+                                    , g_graph = GMany NothingO body NothingO }+  where body = foldr addBlock emptyBody blocks++mapGraphNodes :: ( CmmNode C O -> CmmNode C O+                 , CmmNode O O -> CmmNode O O+                 , CmmNode O C -> CmmNode O C)+              -> CmmGraph -> CmmGraph+mapGraphNodes funs@(mf,_,_) g =+  ofBlockMap (entryLabel $ mf $ CmmEntry (g_entry g) GlobalScope) $+  mapMap (mapBlock3' funs) $ toBlockMap g++mapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph+mapGraphNodes1 f = modifyGraph (mapGraph f)+++foldlGraphBlocks :: (a -> CmmBlock -> a) -> a -> CmmGraph -> a+foldlGraphBlocks k z g = mapFoldl k z $ toBlockMap g++-------------------------------------------------+-- Tick utilities++-- | Extract all tick annotations from the given block+blockTicks :: Block CmmNode C C -> [CmmTickish]+blockTicks b = reverse $ foldBlockNodesF goStmt b []+  where goStmt :: CmmNode e x -> [CmmTickish] -> [CmmTickish]+        goStmt  (CmmTick t) ts = t:ts+        goStmt  _other      ts = ts+++-- -----------------------------------------------------------------------------+-- Access to common global registers++baseExpr, spExpr, hpExpr, currentTSOExpr, currentNurseryExpr,+  spLimExpr, hpLimExpr, cccsExpr :: Platform -> CmmExpr+baseExpr           p = CmmReg $ baseReg           p+spExpr             p = CmmReg $ spReg             p+spLimExpr          p = CmmReg $ spLimReg          p+hpExpr             p = CmmReg $ hpReg             p+hpLimExpr          p = CmmReg $ hpLimReg          p+currentTSOExpr     p = CmmReg $ currentTSOReg     p+currentNurseryExpr p = CmmReg $ currentNurseryReg p+cccsExpr           p = CmmReg $ cccsReg           p
+ compiler/GHC/CmmToLlvm/Version.hs view
@@ -0,0 +1,43 @@+module GHC.CmmToLlvm.Version+  ( LlvmVersion(..)+  , supportedLlvmVersionLowerBound+  , supportedLlvmVersionUpperBound+  , parseLlvmVersion+  , llvmVersionSupported+  , llvmVersionStr+  , llvmVersionList+  )+where++import GHC.Prelude++import GHC.CmmToLlvm.Version.Type+import GHC.CmmToLlvm.Version.Bounds++import Data.Char (isDigit)+import Data.List (intercalate)+import qualified Data.List.NonEmpty as NE++parseLlvmVersion :: String -> Maybe LlvmVersion+parseLlvmVersion =+    fmap LlvmVersion . NE.nonEmpty . go [] . dropWhile (not . isDigit)+  where+    go vs s+      | null ver_str+      = reverse vs+      | '.' : rest' <- rest+      = go (read ver_str : vs) rest'+      | otherwise+      = reverse (read ver_str : vs)+      where+        (ver_str, rest) = span isDigit s++llvmVersionSupported :: LlvmVersion -> Bool+llvmVersionSupported v =+  v >= supportedLlvmVersionLowerBound && v < supportedLlvmVersionUpperBound++llvmVersionStr :: LlvmVersion -> String+llvmVersionStr = intercalate "." . map show . llvmVersionList++llvmVersionList :: LlvmVersion -> [Int]+llvmVersionList = NE.toList . llvmVersionNE
+ compiler/GHC/CmmToLlvm/Version/Bounds.hs view
@@ -0,0 +1,19 @@+module GHC.CmmToLlvm.Version.Bounds+  ( supportedLlvmVersionLowerBound+  , supportedLlvmVersionUpperBound+  )+where++import GHC.Prelude ()++import GHC.CmmToLlvm.Version.Type++import qualified Data.List.NonEmpty as NE++-- | The (inclusive) lower bound on the LLVM Version that is currently supported.+supportedLlvmVersionLowerBound :: LlvmVersion+supportedLlvmVersionLowerBound = LlvmVersion (13 NE.:| [])++-- | The (not-inclusive) upper bound  bound on the LLVM Version that is currently supported.+supportedLlvmVersionUpperBound :: LlvmVersion+supportedLlvmVersionUpperBound = LlvmVersion (20 NE.:| [])
compiler/GHC/Core.hs view
@@ -64,7 +64,7 @@         isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,         isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,         isStableUnfolding, isStableUserUnfolding, isStableSystemUnfolding,-        isInlineUnfolding, isBootUnfolding,+        isInlineUnfolding, isBootUnfolding, isBetterUnfoldingThan,         hasCoreUnfolding, hasSomeUnfolding,         canUnfold, neverUnfoldGuidance, isStableSource, @@ -694,7 +694,7 @@ 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. @@ -1556,7 +1556,6 @@ -- | @True@ if the unfolding is a constructor application, the application -- of a CONLIKE function or 'OtherCon' isConLikeUnfolding :: Unfolding -> Bool-isConLikeUnfolding (OtherCon _)                         = True isConLikeUnfolding (CoreUnfolding { uf_cache = cache }) = uf_is_conlike cache isConLikeUnfolding _                                    = False @@ -1641,6 +1640,33 @@ canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g) canUnfold _                                   = False +isBetterUnfoldingThan :: Unfolding -> Unfolding -> Bool+-- See Note [Better unfolding]+isBetterUnfoldingThan NoUnfolding   _ = False+isBetterUnfoldingThan BootUnfolding _ = False++isBetterUnfoldingThan (CoreUnfolding {uf_cache = uc1}) unf2+  = case unf2 of+      CoreUnfolding {uf_cache = uc2} -> uf_is_value uc1 && not (uf_is_value uc2)+      OtherCon _                     -> uf_is_value uc1+      _                              -> True+         -- Default case: CoreUnfolding better than NoUnfolding etc+         -- Better than DFunUnfolding? I don't care.++isBetterUnfoldingThan (DFunUnfolding {}) unf2+  | DFunUnfolding {} <- unf2 = False+  | otherwise                = True++isBetterUnfoldingThan (OtherCon cs1) unf2+  = case unf2 of+      CoreUnfolding {uf_cache = uc}             -- If unf1 is OtherCon and unf2 is+                       -> not (uf_is_value uc)  -- just a thunk, unf1 is better++      OtherCon cs2     -> not (null cs1) && null cs2  -- A bit crude+      DFunUnfolding {} -> False+      NoUnfolding      -> True+      BootUnfolding    -> True+ {- Note [Fragile unfoldings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ An unfolding is "fragile" if it mentions free variables (and hence would@@ -1654,6 +1680,20 @@                   info in simpleOptExpr; see #13077.  We consider even a StableUnfolding as fragile, because it needs substitution.++Note [Better unfolding]+~~~~~~~~~~~~~~~~~~~~~~~+(unf1 `isBetterUnfoldingThan` unf2) is used when we have+    let x = <rhs> in   -- unf2+    let $j y = ...x...+    in case x of+          K a -> ...$j v....++At the /call site/ of $j, `x` has a better unfolding than it does at the+/defnition site/ of $j; so we are keener to inline $j.  See+Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline for discussion.++The notion of "better" is encapsulated here.  Note [Stable unfoldings] ~~~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Core/Class.hs view
@@ -76,10 +76,6 @@ -- >  class C a b c | a b -> c, a c -> b where... -- --  Here fun-deps are [([a,b],[c]), ([a,c],[b])]------  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'',---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation type FunDep a = ([a],[a])  type ClassOpItem = (Id, DefMethInfo)
compiler/GHC/Core/Coercion.hs view
@@ -24,28 +24,28 @@          -- ** Functions over coercions         coVarRType, coVarLType, coVarTypes,-        coVarKind, coVarKindsTypesRole, coVarRole,+        coVarKind, coVarTypesRole, coVarRole,         coercionType, mkCoercionType,         coercionKind, coercionLKind, coercionRKind,coercionKinds,         coercionRole, coercionKindRole,          -- ** Constructing coercions-        mkGReflCo, mkReflCo, mkRepReflCo, mkNomReflCo,+        mkGReflCo, mkGReflMCo, mkReflCo, mkRepReflCo, mkNomReflCo,         mkCoVarCo, mkCoVarCos,         mkAxInstCo, mkUnbranchedAxInstCo,         mkAxInstRHS, mkUnbranchedAxInstRHS,         mkAxInstLHS, mkUnbranchedAxInstLHS,         mkPiCo, mkPiCos, mkCoCast,         mkSymCo, mkTransCo,-        mkSelCo, getNthFun, getNthFromType, mkLRCo,+        mkSelCo, mkSelCoResRole, getNthFun, selectFromType, mkLRCo,         mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo,         mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo,         mkNakedFunCo,         mkNakedForAllCo, mkForAllCo, mkHomoForAllCos,         mkPhantomCo,         mkHoleCo, mkUnivCo, mkSubCo,-        mkAxiomInstCo, mkProofIrrelCo,-        downgradeRole, mkAxiomRuleCo,+        mkProofIrrelCo,+        downgradeRole, mkAxiomCo,         mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo,         mkKindCo,         castCoercionKind, castCoercionKind1, castCoercionKind2,@@ -97,7 +97,7 @@         emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope,         liftCoSubstVarBndrUsing, isMappedByLC, extendLiftingContextCvSubst, -        mkSubstLiftingContext, zapLiftingContext,+        mkSubstLiftingContext, liftingContextSubst, zapLiftingContext,         substForAllCoBndrUsingLC, lcLookupCoVar, lcInScopeSet,          LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight,@@ -334,9 +334,24 @@ mkGReflCo :: Role -> Type -> MCoercionN -> Coercion mkGReflCo r ty mco   | isGReflMCo mco = if r == Nominal then Refl ty-                     else GRefl r ty MRefl-  | otherwise    = GRefl r ty mco+                                     else GRefl r ty MRefl+  | otherwise+  = -- I'd like to have this assert, but sadly it's not true during type+    -- inference because the types are not fully zonked+    -- assertPpr (case mco of+    --              MCo co -> typeKind ty `eqType` coercionLKind co+    --              MRefl  -> True)+    --          (vcat [ text "ty" <+> ppr ty <+> dcolon <+> ppr (typeKind ty)+    --                , case mco of+    --                     MCo co -> text "co" <+> ppr co+    --                                  <+> dcolon <+> ppr (coercionKind co)+    --                     MRefl  -> text "MRefl"+    --                , callStackDoc ]) $+    GRefl r ty mco +mkGReflMCo :: HasDebugCallStack => Role -> Type -> CoercionN -> Coercion+mkGReflMCo r ty co = mkGReflCo r ty (MCo co)+ -- | Compose two MCoercions via transitivity mkTransMCo :: MCoercion -> MCoercion -> MCoercion mkTransMCo MRefl     co2       = co2@@ -555,6 +570,10 @@ splitForAllCo_maybe (ForAllCo { fco_tcv = tv, fco_visL = vL, fco_visR = vR                               , fco_kind = k_co, fco_body = co })   = Just (tv, vL, vR, k_co, co)+splitForAllCo_maybe co+  | Just (ty, r)        <- isReflCo_maybe co+  , Just (Bndr tcv vis, body_ty) <- splitForAllForAllTyBinder_maybe ty+  = Just (tcv, vis, vis, mkNomReflCo (varType tcv), mkReflCo r body_ty) splitForAllCo_maybe _ = Nothing  -- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder@@ -573,25 +592,22 @@   = Just stuff splitForAllCo_co_maybe _ = Nothing - ------------------------------------------------------- -- and some coercion kind stuff  coVarLType, coVarRType :: HasDebugCallStack => CoVar -> Type-coVarLType cv | (_, _, ty1, _, _) <- coVarKindsTypesRole cv = ty1-coVarRType cv | (_, _, _, ty2, _) <- coVarKindsTypesRole cv = ty2+coVarLType cv | (ty1, _, _) <- coVarTypesRole cv = ty1+coVarRType cv | (_, ty2, _) <- coVarTypesRole cv = ty2  coVarTypes :: HasDebugCallStack => CoVar -> Pair Type-coVarTypes cv-  | (_, _, ty1, ty2, _) <- coVarKindsTypesRole cv-  = Pair ty1 ty2+coVarTypes cv | (ty1, ty2, _) <- coVarTypesRole cv = Pair ty1 ty2 -coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind,Kind,Type,Type,Role)-coVarKindsTypesRole cv- | Just (tc, [k1,k2,ty1,ty2]) <- splitTyConApp_maybe (varType cv)- = (k1, k2, ty1, ty2, eqTyConRole tc)+coVarTypesRole :: HasDebugCallStack => CoVar -> (Type,Type,Role)+coVarTypesRole cv+ | Just (tc, [_,_,ty1,ty2]) <- splitTyConApp_maybe (varType cv)+ = (ty1, ty2, eqTyConRole tc)  | otherwise- = pprPanic "coVarKindsTypesRole, non coercion variable"+ = pprPanic "coVarTypesRole, non coercion variable"             (ppr cv $$ ppr (varType cv))  coVarKind :: CoVar -> Type@@ -1019,41 +1035,39 @@ optCoercion.  Not a big deal either way. -} -mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion]+mkAxInstCo :: Role+           -> CoAxiomRule   -- Always BranchedAxiom or UnbranchedAxiom+           -> [Type] -> [Coercion]            -> Coercion -- mkAxInstCo can legitimately be called over-saturated; -- i.e. with more type arguments than the coercion requires-mkAxInstCo role ax index tys cos+-- Only called with BranchedAxiom or UnbranchedAxiom+mkAxInstCo role axr tys cos   | arity == n_tys = downgradeRole role ax_role $-                     mkAxiomInstCo ax_br index (rtys `chkAppend` cos)+                     AxiomCo axr (rtys `chkAppend` cos)   | otherwise      = assert (arity < n_tys) $                      downgradeRole role ax_role $-                     mkAppCos (mkAxiomInstCo ax_br index-                                             (ax_args `chkAppend` cos))+                     mkAppCos (AxiomCo axr (ax_args `chkAppend` cos))                               leftover_args   where-    n_tys         = length tys-    ax_br         = toBranchedAxiom ax-    branch        = coAxiomNthBranch ax_br index-    tvs           = coAxBranchTyVars branch-    arity         = length tvs-    arg_roles     = coAxBranchRoles branch-    rtys          = zipWith mkReflCo (arg_roles ++ repeat Nominal) tys-    (ax_args, leftover_args)-                  = splitAt arity rtys-    ax_role       = coAxiomRole ax+    (ax_role, branch)        = case coAxiomRuleBranch_maybe axr of+                                  Just (_tc, ax_role, branch) -> (ax_role, branch)+                                  Nothing -> pprPanic "mkAxInstCo" (ppr axr)+    n_tys                    = length tys+    arity                    = length (coAxBranchTyVars branch)+    arg_roles                = coAxBranchRoles branch+    rtys                     = zipWith mkReflCo (arg_roles ++ repeat Nominal) tys+    (ax_args, leftover_args) = splitAt arity rtys  -- worker function-mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion-mkAxiomInstCo ax index args-  = assert (args `lengthIs` coAxiomArity ax index) $-    AxiomInstCo ax index args+mkAxiomCo :: CoAxiomRule -> [Coercion] -> Coercion+mkAxiomCo = AxiomCo  -- to be used only with unbranched axioms mkUnbranchedAxInstCo :: Role -> CoAxiom Unbranched                      -> [Type] -> [Coercion] -> Coercion mkUnbranchedAxInstCo role ax tys cos-  = mkAxInstCo role ax 0 tys cos+  = mkAxInstCo role (UnbranchedAxiom ax) tys cos  mkAxInstRHS :: CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type -- Instantiate the axiom with specified types,@@ -1101,60 +1115,76 @@  -- | Make a universal coercion between two arbitrary types. mkUnivCo :: UnivCoProvenance+         -> [Coercion] -- ^ Coercions on which this depends          -> Role       -- ^ role of the built coercion, "r"          -> Type       -- ^ t1 :: k1          -> Type       -- ^ t2 :: k2          -> Coercion   -- ^ :: t1 ~r t2-mkUnivCo prov role ty1 ty2+mkUnivCo prov deps role ty1 ty2   | ty1 `eqType` ty2 = mkReflCo role ty1-  | otherwise        = UnivCo prov role ty1 ty2+  | otherwise        = UnivCo { uco_prov = prov, uco_role = role+                              , uco_lty = ty1, uco_rty = ty2+                              , uco_deps = deps }  -- | Create a symmetric version of the given 'Coercion' that asserts --   equality between the same types but in the other "direction", so --   a kind of @t1 ~ t2@ becomes the kind @t2 ~ t1@. mkSymCo :: Coercion -> Coercion --- Do a few simple optimizations, but don't bother pushing occurrences--- of symmetry to the leaves; the optimizer will take care of that.-mkSymCo co | isReflCo co          = co-mkSymCo    (SymCo co)             = co-mkSymCo    (SubCo (SymCo co))     = SubCo co-mkSymCo co                        = SymCo co+-- Do a few simple optimizations, mainly to expose the underlying+-- constructors to other 'mk' functions.  E.g.+--   mkInstCo (mkSymCo (ForAllCo ...)) ty+-- We want to push the SymCo inside the ForallCo, so that we can instantiate+-- This can make a big difference.  E.g without coercion optimisation, GHC.Read+-- totally explodes; but when we push Sym inside ForAll, it's fine.+mkSymCo co | isReflCo co   = co+mkSymCo (SymCo co)         = co+mkSymCo (SubCo (SymCo co)) = SubCo co+mkSymCo co@(ForAllCo { fco_kind = kco, fco_body = body_co })+  | isReflCo kco           = co { fco_body = mkSymCo body_co }+mkSymCo co                 = SymCo co --- | Create a new 'Coercion' by composing the two given 'Coercion's transitively.---   (co1 ; co2)-mkTransCo :: Coercion -> Coercion -> Coercion-mkTransCo co1 co2 | isReflCo co1 = co2-                  | isReflCo co2 = co1-mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2))-  = GRefl r t1 (MCo $ mkTransCo co1 co2)-mkTransCo co1 co2                = TransCo co1 co2+-- | mkTransCo creates a new 'Coercion' by composing the two+--   given 'Coercion's transitively: (co1 ; co2)+mkTransCo :: HasDebugCallStack => Coercion -> Coercion -> Coercion+mkTransCo co1 co2+   | isReflCo co1 = co2+   | isReflCo co2 = co1 +   | GRefl r t1 (MCo kco1) <- co1+   , GRefl _ _  (MCo kco2) <- co2+   = GRefl r t1 (MCo $ mkTransCo kco1 kco2)++   | otherwise+   = TransCo co1 co2++--------------------+{- Note [mkSelCo precondition]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To satisfy the Purely Kinded Type Invariant (PKTI), we require that+  in any call (mkSelCo cs co)+  * selectFromType cs (coercionLKind co) works+  * selectFromType cs (coercionRKind co) works+  * and hence coercionKind (SelCo cs co) works (PKTI)+-}+ mkSelCo :: HasDebugCallStack         => CoSel         -> Coercion         -> Coercion+-- See Note [mkSelCo precondition] mkSelCo n co = mkSelCo_maybe n co `orElse` SelCo n co  mkSelCo_maybe :: HasDebugCallStack         => CoSel         -> Coercion         -> Maybe Coercion--- mkSelCo_maybe tries to optimise call to mkSelCo+-- Note [mkSelCo precondition] mkSelCo_maybe cs co   = assertPpr (good_call cs) bad_call_msg $     go cs co   where-    Pair ty1 ty2 = coercionKind co -    go cs co-      | Just (ty, _co_role) <- isReflCo_maybe co-      = let new_role = coercionRole (SelCo cs co)-        in Just (mkReflCo new_role (getNthFromType cs ty))-        -- The role of the result (new_role) does not have to-        -- be equal to _co_role, the role of co, per Note [SelCo].-        -- This was revealed by #23938.-     go SelForAll (ForAllCo { fco_kind = kind_co })       = Just kind_co       -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2)@@ -1173,9 +1203,30 @@     go cs (SymCo co)  -- Recurse, hoping to get to a TyConAppCo or FunCo       = do { co' <- go cs co; return (mkSymCo co') } -    go _ _ = Nothing+    go cs co+      | Just (ty, co_role) <- isReflCo_maybe co+      = Just (mkReflCo (mkSelCoResRole cs co_role) (selectFromType cs ty))+        -- mkSelCoreResRole: The role of the result may not be+        -- be equal to co_role, the role of co, per Note [SelCo].+        -- This was revealed by #23938. -    -- Assertion checking+      | Pair ty1 ty2 <- coercionKind co+      , let sty1    = selectFromType cs ty1+            sty2    = selectFromType cs ty2+            co_role = coercionRole co+      , sty1 `eqType` sty2+      = Just (mkReflCo (mkSelCoResRole cs co_role) sty1)+            -- Checking for fully reflexive-ness (by seeing if sty1=sty2)+            -- is worthwhile, because a non-Refl coercion `co` may well have a+            -- reflexive (SelCo cs co).+            -- E.g. co :: Either a b ~ Either a c+            --      Then (SubCo (SelTyCon 0) co) is reflexive++      | otherwise = Nothing++    ----------- Assertion checking --------------+    -- NB: using coercionKind requires Note [mkSelCo precondition]+    Pair ty1 ty2 = coercionKind co     bad_call_msg = vcat [ text "Coercion =" <+> ppr co                         , text "LHS ty =" <+> ppr ty1                         , text "RHS ty =" <+> ppr ty2@@ -1204,6 +1255,14 @@      good_call _ = False +mkSelCoResRole :: CoSel -> Role -> Role+-- What is the role of (SelCo cs co), if co has role 'r'?+-- It is not just 'r'!+-- c.f. the SelCo case of coercionRole+mkSelCoResRole SelForAll       _ = Nominal+mkSelCoResRole (SelTyCon _ r') _ = r'+mkSelCoResRole (SelFun fs)     r = funRole r fs+ -- | Extract the nth field of a FunCo getNthFun :: FunSel           -> a    -- ^ multiplicity@@ -1214,6 +1273,24 @@ getNthFun SelArg _     arg _   = arg getNthFun SelRes _     _   res = res +selectFromType :: HasDebugCallStack => CoSel -> Type -> Type+selectFromType (SelFun fs) ty+  | Just (_af, mult, arg, res) <- splitFunTy_maybe ty+  = getNthFun fs mult arg res++selectFromType (SelTyCon n _) ty+  | Just args <- tyConAppArgs_maybe ty+  = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $+    args `getNth` n++selectFromType SelForAll ty       -- Works for both tyvar and covar+  | Just (tv,_) <- splitForAllTyCoVar_maybe ty+  = tyVarKind tv++selectFromType cs ty+  = pprPanic "selectFromType" (ppr cs $$ ppr ty)++-------------------- mkLRCo :: LeftOrRight -> Coercion -> Coercion mkLRCo lr co   | Just (ty, eq) <- isReflCo_maybe co@@ -1222,11 +1299,14 @@   = LRCo lr co  -- | Instantiates a 'Coercion'.+-- Works for both tyvar and covar mkInstCo :: Coercion -> CoercionN -> Coercion-mkInstCo (ForAllCo { fco_tcv = tcv, fco_body = body_co }) co-  | Just (arg, _) <- isReflCo_maybe co-      -- works for both tyvar and covar-  = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co+mkInstCo co_fun co_arg+  | Just (tcv, _, _, kind_co, body_co) <- splitForAllCo_maybe co_fun+  , Just (arg, _) <- isReflCo_maybe co_arg+  = assertPpr (isReflexiveCo kind_co) (ppr co_fun $$ ppr co_arg) $+       -- If the arg is Refl, then kind_co must be reflexive too+    substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co mkInstCo co arg = InstCo co arg  -- | Given @ty :: k1@, @co :: k1 ~ k2@,@@ -1236,7 +1316,7 @@   | isGReflCo co = mkReflCo r ty     -- the kinds of @k1@ and @k2@ are the same, thus @isGReflCo@     -- instead of @isReflCo@-  | otherwise = GRefl r ty (MCo co)+  | otherwise = mkGReflMCo r ty co  -- | Given @r@, @ty :: k1@, and @co :: k1 ~N k2@, -- produces @co' :: (ty |> co) ~r ty@@@ -1245,7 +1325,7 @@   | isGReflCo co = mkReflCo r ty     -- the kinds of @k1@ and @k2@ are the same, thus @isGReflCo@     -- instead of @isReflCo@-  | otherwise    = mkSymCo $ GRefl r ty (MCo co)+  | otherwise    = mkSymCo $ mkGReflMCo r ty co  -- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty ~r ty'@, -- produces @co' :: (ty |> co) ~r ty'@@ -1254,26 +1334,24 @@ mkCoherenceLeftCo :: Role -> Type -> CoercionN -> Coercion -> Coercion mkCoherenceLeftCo r ty co co2   | isGReflCo co = co2-  | otherwise    = (mkSymCo $ GRefl r ty (MCo co)) `mkTransCo` co2+  | otherwise    = (mkSymCo $ mkGReflMCo r ty co) `mkTransCo` co2  -- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty' ~r ty@, -- produces @co' :: ty' ~r (ty |> co) -- It is not only a utility function, but it saves allocation when co -- is a GRefl coercion.-mkCoherenceRightCo :: Role -> Type -> CoercionN -> Coercion -> Coercion+mkCoherenceRightCo :: HasDebugCallStack => Role -> Type -> CoercionN -> Coercion -> Coercion mkCoherenceRightCo r ty co co2   | isGReflCo co = co2-  | otherwise    = co2 `mkTransCo` GRefl r ty (MCo co)+  | otherwise    = co2 `mkTransCo` mkGReflMCo r ty co  -- | Given @co :: (a :: k) ~ (b :: k')@ produce @co' :: k ~ k'@. mkKindCo :: Coercion -> Coercion mkKindCo co | Just (ty, _) <- isReflCo_maybe co = Refl (typeKind ty) mkKindCo (GRefl _ _ (MCo co)) = co-mkKindCo (UnivCo (PhantomProv h) _ _ _)    = h-mkKindCo (UnivCo (ProofIrrelProv h) _ _ _) = h mkKindCo co   | Pair ty1 ty2 <- coercionKind co-       -- generally, calling coercionKind during coercion creation is a bad idea,+       -- Generally, calling coercionKind during coercion creation is a bad idea,        -- as it can lead to exponential behavior. But, we don't have nested mkKindCos,        -- so it's OK here.   , let tk1 = typeKind ty1@@ -1324,9 +1402,6 @@       Just co' -> co'       Nothing  -> pprPanic "downgradeRole" (ppr co) -mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion-mkAxiomRuleCo = AxiomRuleCo- -- | Make a "coercion between coercions". mkProofIrrelCo :: Role       -- ^ role of the created coercion, "r"                -> CoercionN  -- ^ :: phi1 ~N phi2@@ -1338,8 +1413,8 @@ -- the individual coercions are. mkProofIrrelCo r co g  _ | isGReflCo co  = mkReflCo r (mkCoercionTy g)   -- kco is a kind coercion, thus @isGReflCo@ rather than @isReflCo@-mkProofIrrelCo r kco        g1 g2 = mkUnivCo (ProofIrrelProv kco) r-                                             (mkCoercionTy g1) (mkCoercionTy g2)+mkProofIrrelCo r kco g1 g2 = mkUnivCo ProofIrrelProv [kco] r+                                      (mkCoercionTy g1) (mkCoercionTy g2)  {- %************************************************************************@@ -1394,11 +1469,11 @@           pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co)     setNominalRole_maybe_helper (InstCo co arg)       = InstCo <$> setNominalRole_maybe_helper co <*> pure arg-    setNominalRole_maybe_helper (UnivCo prov _ co1 co2)-      | case prov of PhantomProv _    -> False  -- should always be phantom-                     ProofIrrelProv _ -> True   -- it's always safe-                     PluginProv _     -> False  -- who knows? This choice is conservative.-      = Just $ UnivCo prov Nominal co1 co2+    setNominalRole_maybe_helper co@(UnivCo { uco_prov = prov })+      | case prov of PhantomProv {}    -> False  -- should always be phantom+                     ProofIrrelProv {} -> True   -- it's always safe+                     PluginProv {}     -> False  -- who knows? This choice is conservative.+      = Just $ co { uco_role = Nominal }     setNominalRole_maybe_helper _ = Nothing  -- | Make a phantom coercion between two types. The coercion passed@@ -1406,7 +1481,7 @@ -- types. mkPhantomCo :: Coercion -> Type -> Type -> Coercion mkPhantomCo h t1 t2-  = mkUnivCo (PhantomProv h) Phantom t1 t2+  = mkUnivCo PhantomProv [h] Phantom t1 t2  -- takes any coercion and turns it into a Phantom coercion toPhantomCo :: Coercion -> Coercion@@ -1515,14 +1590,12 @@        -- We can get Type~Constraint or Constraint~Type        -- from FunCo {} :: (a -> (b::Type)) ~ (a -=> (b'::Constraint)) -    CoVarCo {}     -> mkKindCo co-    HoleCo {}      -> mkKindCo co-    AxiomInstCo {} -> mkKindCo co-    AxiomRuleCo {} -> mkKindCo co--    UnivCo (PhantomProv kco)    _ _ _ -> kco-    UnivCo (ProofIrrelProv kco) _ _ _ -> kco-    UnivCo (PluginProv _)       _ _ _ -> mkKindCo co+    CoVarCo {} -> mkKindCo co+    HoleCo {}  -> mkKindCo co+    AxiomCo {} -> mkKindCo co+    UnivCo {}  -> mkKindCo co  -- We could instead return the (single) `uco_deps` coercion in+                               -- the `ProofIrrelProv` and `PhantomProv` cases, but it doesn't+                               -- quite seem worth doing.      SymCo g       -> mkSymCo (promoteCoercion g)@@ -1629,8 +1702,8 @@                  mkNomReflCo (mkCastTy t2 h)       GRefl _ _ mco -> case mco of            MRefl       -> mkReflCo r (mkCastTy t2 h)-           MCo kind_co -> GRefl r (mkCastTy t1 h) $-                          MCo (mkSymCo h `mkTransCo` kind_co `mkTransCo` h)+           MCo kind_co -> mkGReflMCo r (mkCastTy t1 h)+                               (mkSymCo h `mkTransCo` kind_co `mkTransCo` h)       _ -> castCoercionKind2 g r t1 t2 h h  -- | Creates a new coercion with both of its types casted by different casts@@ -1979,6 +2052,9 @@ mkSubstLiftingContext :: Subst -> LiftingContext mkSubstLiftingContext subst = LC subst emptyVarEnv +liftingContextSubst :: LiftingContext -> Subst+liftingContextSubst (LC subst _) = subst+ -- | Extend a lifting context with a new mapping. extendLiftingContext :: LiftingContext  -- ^ original LC                      -> TyCoVar         -- ^ new variable to map...@@ -2034,7 +2110,7 @@     -- lift_s2 :: s2 ~r s2'     -- kco     :: (s1 ~r s2) ~N (s1' ~r s2')     assert (isCoVar v) $-    let (_, _, s1, s2, r) = coVarKindsTypesRole v+    let (s1, s2, r) = coVarTypesRole v         lift_s1 = ty_co_subst lc r s1         lift_s2 = ty_co_subst lc r s2         kco     = mkTyConAppCo Nominal (equalityTyCon r)@@ -2054,10 +2130,10 @@ zapLiftingContext (LC subst _) = LC (zapSubst subst) emptyVarEnv  -- | Like 'substForAllCoBndr', but works on a lifting context-substForAllCoBndrUsingLC :: Bool-                            -> (Coercion -> Coercion)-                            -> LiftingContext -> TyCoVar -> Coercion-                            -> (LiftingContext, TyCoVar, Coercion)+substForAllCoBndrUsingLC :: SwapFlag+                         -> (Coercion -> Coercion)+                         -> LiftingContext -> TyCoVar -> Coercion+                         -> (LiftingContext, TyCoVar, Coercion) substForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co   = (LC subst' lc_env, tv', co')   where@@ -2328,33 +2404,28 @@ seqMCo (MCo co) = seqCo co  seqCo :: Coercion -> ()-seqCo (Refl ty)                 = seqType ty-seqCo (GRefl r ty mco)          = r `seq` seqType ty `seq` seqMCo mco-seqCo (TyConAppCo r tc cos)     = r `seq` tc `seq` seqCos cos-seqCo (AppCo co1 co2)           = seqCo co1 `seq` seqCo co2-seqCo (ForAllCo tv visL visR k co) = seqType (varType tv) `seq`-                                      rnf visL `seq` rnf visR `seq`-                                      seqCo k `seq` seqCo co-seqCo (FunCo r af1 af2 w co1 co2) = r `seq` af1 `seq` af2 `seq`-                                    seqCo w `seq` seqCo co1 `seq` seqCo co2-seqCo (CoVarCo cv)              = cv `seq` ()-seqCo (HoleCo h)                = coHoleCoVar h `seq` ()-seqCo (AxiomInstCo con ind cos) = con `seq` ind `seq` seqCos cos-seqCo (UnivCo p r t1 t2)-  = seqProv p `seq` r `seq` seqType t1 `seq` seqType t2-seqCo (SymCo co)                = seqCo co-seqCo (TransCo co1 co2)         = seqCo co1 `seq` seqCo co2-seqCo (SelCo n co)              = n `seq` seqCo co-seqCo (LRCo lr co)              = lr `seq` seqCo co-seqCo (InstCo co arg)           = seqCo co `seq` seqCo arg-seqCo (KindCo co)               = seqCo co-seqCo (SubCo co)                = seqCo co-seqCo (AxiomRuleCo _ cs)        = seqCos cs--seqProv :: UnivCoProvenance -> ()-seqProv (PhantomProv co)    = seqCo co-seqProv (ProofIrrelProv co) = seqCo co-seqProv (PluginProv _)      = ()+seqCo (Refl ty)             = seqType ty+seqCo (GRefl r ty mco)      = r `seq` seqType ty `seq` seqMCo mco+seqCo (TyConAppCo r tc cos) = r `seq` tc `seq` seqCos cos+seqCo (AppCo co1 co2)       = seqCo co1 `seq` seqCo co2+seqCo (CoVarCo cv)          = cv `seq` ()+seqCo (HoleCo h)            = coHoleCoVar h `seq` ()+seqCo (SymCo co)            = seqCo co+seqCo (TransCo co1 co2)     = seqCo co1 `seq` seqCo co2+seqCo (SelCo n co)          = n `seq` seqCo co+seqCo (LRCo lr co)          = lr `seq` seqCo co+seqCo (InstCo co arg)       = seqCo co `seq` seqCo arg+seqCo (KindCo co)           = seqCo co+seqCo (SubCo co)            = seqCo co+seqCo (AxiomCo _ cs)        = seqCos cs+seqCo (ForAllCo tv visL visR k co)+  = seqType (varType tv) `seq` rnf visL `seq` rnf visR `seq`+    seqCo k `seq` seqCo co+seqCo (FunCo r af1 af2 w co1 co2)+  = r `seq` af1 `seq` af2 `seq` seqCo w `seq` seqCo co1 `seq` seqCo co2+seqCo (UnivCo { uco_prov = p, uco_role = r+              , uco_lty = t1, uco_rty = t2, uco_deps = deps })+  = p `seq` r `seq` seqType t1 `seq` seqType t2 `seq` seqCos deps  seqCos :: [Coercion] -> () seqCos []       = ()@@ -2368,6 +2439,23 @@ %************************************************************************ -} +{- Note [coercionKind performance]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+coercionKind, coercionLKind, and coercionRKind are very "hot" functions; in some+coercion-heavy programs they can have a material effect on compile time/allocation.++Hence+* Rather than making one function which returns a pair (lots of allocation and+  de-allocation) we have two functions, coercionLKind and coercionRKind, which+  return the left and right kind respectively.++* Both are defined by a single worker function `coercion_lr_kind`, which takes a+  flag of type `LeftOrRight`.  This worker function is marked INLINE, and inlined+  at its precisely-two call-sites in coercionLKind and coercionRKind.++Take care when making changes here... it's easy to accidentally add allocation!+-}+ -- | Apply 'coercionKind' to multiple 'Coercion's coercionKinds :: [Coercion] -> Pair [Type] coercionKinds tys = sequenceA $ map coercionKind tys@@ -2387,127 +2475,108 @@ -- -- i.e. the kind of @c@ relates @t1@ and @t2@, then @coercionKind c = Pair t1 t2@. -coercionKind :: Coercion -> Pair Type+coercionKind :: HasDebugCallStack => Coercion -> Pair Type+-- See Note [coercionKind performance] coercionKind co = Pair (coercionLKind co) (coercionRKind co) -coercionLKind :: Coercion -> Type-coercionLKind co-  = go co+coercionLKind, coercionRKind :: HasDebugCallStack => Coercion -> Type+-- See Note [coercionKind performance]+coercionLKind co = coercion_lr_kind CLeft  co+coercionRKind co = coercion_lr_kind CRight co++coercion_lr_kind :: HasDebugCallStack => LeftOrRight -> Coercion -> Type+{-# INLINE coercion_lr_kind #-}+-- See Note [coercionKind performance]+coercion_lr_kind which orig_co+  = go orig_co   where-    go (Refl ty)                 = ty-    go (GRefl _ ty _)            = ty-    go (TyConAppCo _ tc cos)     = mkTyConApp tc (map go cos)-    go (AppCo co1 co2)           = mkAppTy (go co1) (go co2)-    go (ForAllCo { fco_tcv = tv1, fco_visL = visL, fco_body = co1 })-                                 = mkTyCoForAllTy tv1 visL (go co1)-    go (FunCo { fco_afl = af, fco_mult = mult, fco_arg = arg, fco_res = res})-       {- See Note [FunCo] -}    = FunTy { ft_af = af, ft_mult = go mult-                                         , ft_arg = go arg, ft_res = go res }-    go (CoVarCo cv)              = coVarLType cv-    go (HoleCo h)                = coVarLType (coHoleCoVar h)-    go (UnivCo _ _ ty1 _)        = ty1-    go (SymCo co)                = coercionRKind co-    go (TransCo co1 _)           = go co1-    go (LRCo lr co)              = pickLR lr (splitAppTy (go co))-    go (InstCo aco arg)          = go_app aco [go arg]-    go (KindCo co)               = typeKind (go co)-    go (SubCo co)                = go co-    go (SelCo d co)              = getNthFromType d (go co)-    go (AxiomInstCo ax ind cos)  = go_ax_inst ax ind (map go cos)-    go (AxiomRuleCo ax cos)      = pFst $ expectJust "coercionKind" $-                                   coaxrProves ax $ map coercionKind cos+    go (Refl ty)              = ty+    go (GRefl _ ty MRefl)     = ty+    go (GRefl _ ty (MCo co1)) = pickLR which (ty, mkCastTy ty co1)+    go (TyConAppCo _ tc cos)  = mkTyConApp tc (map go cos)+    go (AppCo co1 co2)        = mkAppTy (go co1) (go co2)+    go (CoVarCo cv)           = go_covar cv+    go (HoleCo h)             = go_covar (coHoleCoVar h)+    go (SymCo co)             = pickLR which (coercionRKind co, coercionLKind co)+    go (TransCo co1 co2)      = pickLR which (go co1,           go co2)+    go (LRCo lr co)           = pickLR lr (splitAppTy (go co))+    go (InstCo aco arg)       = go_app aco [go arg]+    go (KindCo co)            = typeKind (go co)+    go (SubCo co)             = go co+    go (SelCo d co)           = selectFromType d (go co)+    go (AxiomCo ax cos)       = go_ax ax cos -    go_ax_inst ax ind tys-      | CoAxBranch { cab_tvs = tvs, cab_cvs = cvs-                   , cab_lhs = lhs } <- coAxiomNthBranch ax ind-      , let (tys1, cotys1) = splitAtList tvs tys-            cos1           = map stripCoercionTy cotys1-      = assert (tys `equalLength` (tvs ++ cvs)) $-                  -- Invariant of AxiomInstCo: cos should-                  -- exactly saturate the axiom branch-        substTyWith tvs tys1       $-        substTyWithCoVars cvs cos1 $-        mkTyConApp (coAxiomTyCon ax) lhs+    go (UnivCo { uco_lty = lty, uco_rty = rty})+      = pickLR which (lty, rty)+    go (FunCo { fco_afl = afl, fco_afr = afr, fco_mult = mult+              , fco_arg = arg, fco_res = res})+      = -- See Note [FunCo]+        FunTy { ft_af = pickLR which (afl, afr), ft_mult = go mult+              , ft_arg = go arg, ft_res = go res } +    go co@(ForAllCo { fco_tcv = tv1, fco_visL = visL, fco_visR = visR+                    , fco_kind = k_co, fco_body = co1 })+      = case which of+          CLeft  -> mkTyCoForAllTy tv1 visL (go co1)+          CRight | isGReflCo k_co  -- kind_co always has kind `Type`, thus `isGReflCo`+                 -> mkTyCoForAllTy tv1 visR (go co1)+                 | otherwise+                 -> go_forall_right empty_subst co+      where+         empty_subst = mkEmptySubst (mkInScopeSet $ tyCoVarsOfCo co)++    -------------+    go_covar cv = pickLR which (coVarLType cv, coVarRType cv)++    -------------     go_app :: Coercion -> [Type] -> Type     -- Collect up all the arguments and apply all at once     -- See Note [Nested InstCos]     go_app (InstCo co arg) args = go_app co (go arg:args)     go_app co              args = piResultTys (go co) args -getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type-getNthFromType (SelFun fs) ty-  | Just (_af, mult, arg, res) <- splitFunTy_maybe ty-  = getNthFun fs mult arg res--getNthFromType (SelTyCon n _) ty-  | Just args <- tyConAppArgs_maybe ty-  = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $-    args `getNth` n--getNthFromType SelForAll ty       -- Works for both tyvar and covar-  | Just (tv,_) <- splitForAllTyCoVar_maybe ty-  = tyVarKind tv--getNthFromType cs ty-  = pprPanic "getNthFromType" (ppr cs $$ ppr ty)+    -------------+    go_ax axr@(BuiltInFamRew  bif) cos  = check_bif_res axr (bifrw_proves  bif (map coercionKind cos))+    go_ax axr@(BuiltInFamInj bif) [co]  = check_bif_res axr (bifinj_proves bif (coercionKind co))+    go_ax axr@(BuiltInFamInj {})  _     = crash axr+    go_ax     (UnbranchedAxiom ax) cos  = go_branch ax (coAxiomSingleBranch ax) cos+    go_ax     (BranchedAxiom ax i) cos  = go_branch ax (coAxiomNthBranch ax i)  cos -coercionRKind :: Coercion -> Type-coercionRKind co-  = go co-  where-    go (Refl ty)                 = ty-    go (GRefl _ ty MRefl)        = ty-    go (GRefl _ ty (MCo co1))    = mkCastTy ty co1-    go (TyConAppCo _ tc cos)     = mkTyConApp tc (map go cos)-    go (AppCo co1 co2)           = mkAppTy (go co1) (go co2)-    go (CoVarCo cv)              = coVarRType cv-    go (HoleCo h)                = coVarRType (coHoleCoVar h)-    go (FunCo { fco_afr = af, fco_mult = mult, fco_arg = arg, fco_res = res})-       {- See Note [FunCo] -}    = FunTy { ft_af = af, ft_mult = go mult-                                         , ft_arg = go arg, ft_res = go res }-    go (UnivCo _ _ _ ty2)        = ty2-    go (SymCo co)                = coercionLKind co-    go (TransCo _ co2)           = go co2-    go (LRCo lr co)              = pickLR lr (splitAppTy (go co))-    go (InstCo aco arg)          = go_app aco [go arg]-    go (KindCo co)               = typeKind (go co)-    go (SubCo co)                = go co-    go (SelCo d co)              = getNthFromType d (go co)-    go (AxiomInstCo ax ind cos)  = go_ax_inst ax ind (map go cos)-    go (AxiomRuleCo ax cos)      = pSnd $ expectJust "coercionKind" $-                                   coaxrProves ax $ map coercionKind cos+    -------------+    check_bif_res _   (Just (Pair lhs rhs)) = pickLR which (lhs,rhs)+    check_bif_res axr Nothing               = crash axr -    go co@(ForAllCo { fco_tcv = tv1, fco_visR = visR-                    , fco_kind = k_co, fco_body = co1 }) -- works for both tyvar and covar-       | isGReflCo k_co           = mkTyCoForAllTy tv1 visR (go co1)-         -- kind_co always has kind @Type@, thus @isGReflCo@-       | otherwise                = go_forall empty_subst co-       where-         empty_subst = mkEmptySubst (mkInScopeSet $ tyCoVarsOfCo co)+    crash :: CoAxiomRule -> Type+    crash axr = pprPanic "coercionKind" (ppr axr) -    go_ax_inst ax ind tys-      | CoAxBranch { cab_tvs = tvs, cab_cvs = cvs-                   , cab_rhs = rhs } <- coAxiomNthBranch ax ind-      , let (tys2, cotys2) = splitAtList tvs tys-            cos2           = map stripCoercionTy cotys2-      = assert (tys `equalLength` (tvs ++ cvs)) $-                  -- Invariant of AxiomInstCo: cos should+    -------------+    go_branch :: CoAxiom br -> CoAxBranch -> [Coercion] -> Type+    go_branch ax (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs+                             , cab_lhs = lhs_tys, cab_rhs = rhs_ty }) cos+      = assert (cos `equalLength` tcvs) $+                  -- Invariant of AxiomRuleCo: cos should                   -- exactly saturate the axiom branch-        substTyWith tvs tys2 $-        substTyWithCoVars cvs cos2 rhs--    go_app :: Coercion -> [Type] -> Type-    -- Collect up all the arguments and apply all at once-    -- See Note [Nested InstCos]-    go_app (InstCo co arg) args = go_app co (go arg:args)-    go_app co              args = piResultTys (go co) args+        let (tys1, cotys1) = splitAtList tvs tys+            cos1           = map stripCoercionTy cotys1+        in+        -- You might think to use+        --        substTy (zipTCvSubst tcvs ltys) (pickLR ...)+        -- but #25066 makes it much less efficient than the silly calls below+        substTyWith tvs tys1       $+        substTyWithCoVars cvs cos1 $+        pickLR which (mkTyConApp tc lhs_tys, rhs_ty)+     where+       tc   = coAxiomTyCon ax+       tcvs | null cvs  = tvs  -- Very common case (currently always!)+            | otherwise = tvs ++ cvs+       tys = map go cos -    go_forall subst (ForAllCo { fco_tcv = tv1, fco_visR = visR-                              , fco_kind = k_co, fco_body = co })+    -------------+    go_forall_right subst (ForAllCo { fco_tcv = tv1, fco_visR = visR+                                    , fco_kind = k_co, fco_body = co })       -- See Note [Nested ForAllCos]       | isTyVar tv1-      = mkForAllTy (Bndr tv2 visR) (go_forall subst' co)+      = mkForAllTy (Bndr tv2 visR) (go_forall_right subst' co)       where         k2  = coercionRKind k_co         tv2 = setTyVarKind tv1 (substTy subst k2)@@ -2516,10 +2585,10 @@                | otherwise      = extendTvSubst (extendSubstInScope subst tv2) tv1 $                                   TyVarTy tv2 `mkCastTy` mkSymCo k_co -    go_forall subst (ForAllCo { fco_tcv = cv1, fco_visR = visR-                              , fco_kind = k_co, fco_body = co })+    go_forall_right subst (ForAllCo { fco_tcv = cv1, fco_visR = visR+                                    , fco_kind = k_co, fco_body = co })       | isCoVar cv1-      = mkTyCoForAllTy cv2 visR (go_forall subst' co)+      = mkTyCoForAllTy cv2 visR (go_forall_right subst' co)       where         k2    = coercionRKind k_co         r     = coVarRole cv1@@ -2542,25 +2611,35 @@                 | otherwise     = extendCvSubst (extendSubstInScope subst cv2)                                                 cv1 n_subst -    go_forall subst other_co+    go_forall_right subst other_co       -- when other_co is not a ForAllCo       = substTy subst (go other_co) -{---Note [Nested ForAllCos]-~~~~~~~~~~~~~~~~~~~~~~~--Suppose we need `coercionKind (ForAllCo a1 (ForAllCo a2 ... (ForAllCo an-co)...) )`.   We do not want to perform `n` single-type-variable-substitutions over the kind of `co`; rather we want to do one substitution-which substitutes for all of `a1`, `a2` ... simultaneously.  If we do one-at a time we get the performance hole reported in #11735.+{- Note [Nested ForAllCos]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we need `coercionKind (ForAllCo a1 (ForAllCo a2 ... (ForAllCo an co)...) )`.+We do not want to perform `n` single-type-variable substitutions over the kind+of `co`; rather we want to do one substitution which substitutes for all of+`a1`, `a2` ... simultaneously.  If we do one at a time we get the performance+hole reported in #11735.  Solution: gather up the type variables for nested `ForAllCos`, and substitute for them all at once.  Remarkably, for #11735 this single change reduces /total/ compile time by a factor of more than ten. +Note [Nested InstCos]+~~~~~~~~~~~~~~~~~~~~~+In #5631 we found that 70% of the entire compilation time was+being spent in coercionKind!  The reason was that we had+   (g @ ty1 @ ty2 .. @ ty100)    -- The "@s" are InstCos+where+   g :: forall a1 a2 .. a100. phi+If we deal with the InstCos one at a time, we'll do this:+   1.  Find the kind of (g @ ty1 .. @ ty99) : forall a100. phi'+   2.  Substitute phi'[ ty100/a100 ], a single tyvar->type subst+But this is a *quadratic* algorithm, and the blew up #5631.+So it's very important to do the substitution simultaneously;+cf Type.piResultTys (which in fact we call here). -}  -- | Retrieve the role from a coercion.@@ -2575,35 +2654,15 @@     go (FunCo { fco_role = r })     = r     go (CoVarCo cv)                 = coVarRole cv     go (HoleCo h)                   = coVarRole (coHoleCoVar h)-    go (AxiomInstCo ax _ _)         = coAxiomRole ax-    go (UnivCo _ r _ _)             = r+    go (UnivCo { uco_role = r })    = r     go (SymCo co)                   = go co     go (TransCo co1 _co2)           = go co1-    go (SelCo SelForAll      _co)   = Nominal-    go (SelCo (SelTyCon _ r) _co)   = r-    go (SelCo (SelFun fs)     co)   = funRole (coercionRole co) fs+    go (SelCo cs co)                = mkSelCoResRole cs (coercionRole co)     go (LRCo {})                    = Nominal     go (InstCo co _)                = go co     go (KindCo {})                  = Nominal     go (SubCo _)                    = Representational-    go (AxiomRuleCo ax _)           = coaxrRole ax--{--Note [Nested InstCos]-~~~~~~~~~~~~~~~~~~~~~-In #5631 we found that 70% of the entire compilation time was-being spent in coercionKind!  The reason was that we had-   (g @ ty1 @ ty2 .. @ ty100)    -- The "@s" are InstCos-where-   g :: forall a1 a2 .. a100. phi-If we deal with the InstCos one at a time, we'll do this:-   1.  Find the kind of (g @ ty1 .. @ ty99) : forall a100. phi'-   2.  Substitute phi'[ ty100/a100 ], a single tyvar->type subst-But this is a *quadratic* algorithm, and the blew up #5631.-So it's very important to do the substitution simultaneously;-cf Type.piResultTys (which in fact we call here).---}+    go (AxiomCo ax _)               = coAxiomRuleRole ax  -- | Makes a coercion type from two types: the types whose equality -- is proven by the relevant 'Coercion'@@ -2652,7 +2711,7 @@ -- transitivity over coercion applications, where splitting two -- AppCos might yield different kinds. See Note [EtaAppCo] in -- "GHC.Core.Coercion.Opt".-buildCoercion :: Type -> Type -> CoercionN+buildCoercion :: HasDebugCallStack => Type -> Type -> CoercionN buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2   where     go ty1 ty2 | Just ty1' <- coreView ty1 = go ty1' ty2@@ -2680,7 +2739,10 @@         mkFunCo Nominal af1 (go w1 w2) (go arg1 arg2) (go res1 res2)      go (TyConApp tc1 args1) (TyConApp tc2 args2)-      = assert (tc1 == tc2) $+      = assertPpr (tc1 == tc2) (vcat [ ppr tc1 <+> ppr tc2+                                     , text "orig_ty1:" <+> ppr orig_ty1+                                     , text "orig_ty2:" <+> ppr orig_ty2+                                     ]) $         mkTyConAppCo Nominal tc1 (zipWith go args1 args2)      go (AppTy ty1a ty1b) ty2
compiler/GHC/Core/Coercion.hs-boot view
@@ -21,11 +21,10 @@ mkNakedFunCo :: Role -> FunTyFlag -> CoercionN -> Coercion -> Coercion -> Coercion mkFunCo2     :: Role -> FunTyFlag -> FunTyFlag -> CoercionN -> Coercion -> Coercion -> Coercion mkCoVarCo :: CoVar -> Coercion-mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion mkPhantomCo :: Coercion -> Type -> Type -> Coercion-mkUnivCo :: UnivCoProvenance -> Role -> Type -> Type -> Coercion+mkUnivCo :: UnivCoProvenance -> [Coercion] -> Role -> Type -> Type -> Coercion mkSymCo :: Coercion -> Coercion-mkTransCo :: Coercion -> Coercion -> Coercion+mkTransCo :: HasDebugCallStack => Coercion -> Coercion -> Coercion mkSelCo :: HasDebugCallStack => CoSel -> Coercion -> Coercion mkLRCo :: LeftOrRight -> Coercion -> Coercion mkInstCo :: Coercion -> Coercion -> Coercion@@ -34,7 +33,7 @@ mkKindCo :: Coercion -> Coercion mkSubCo :: HasDebugCallStack => Coercion -> Coercion mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion-mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion+mkAxiomCo :: CoAxiomRule -> [Coercion] -> Coercion  funRole :: Role -> FunSel -> Role @@ -42,16 +41,16 @@ isReflCo :: Coercion -> Bool isReflexiveCo :: Coercion -> Bool decomposePiCos :: HasDebugCallStack => Coercion -> Pair Type -> [Type] -> ([Coercion], Coercion)-coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind, Kind, Type, Type, Role)+coVarTypesRole :: HasDebugCallStack => CoVar -> (Type, Type, Role) coVarRole :: CoVar -> Role  mkCoercionType :: Role -> Type -> Type -> Type  seqCo :: Coercion -> () -coercionKind :: Coercion -> Pair Type-coercionLKind :: Coercion -> Type-coercionRKind :: Coercion -> Type+coercionKind  :: HasDebugCallStack => Coercion -> Pair Type+coercionLKind :: HasDebugCallStack => Coercion -> Type+coercionRKind :: HasDebugCallStack => Coercion -> Type coercionType :: Coercion -> Type  topNormaliseNewType_maybe :: Type -> Maybe (Coercion, Type)
compiler/GHC/Core/Coercion/Axiom.hs view
@@ -30,7 +30,9 @@         Role(..), fsFromRole, -       CoAxiomRule(..), TypeEqn,+       CoAxiomRule(..), BuiltInFamRewrite(..), BuiltInFamInjectivity(..), TypeEqn,+       coAxiomRuleArgRoles, coAxiomRuleRole,+       coAxiomRuleBranch_maybe, isNewtypeAxiomRule_maybe,        BuiltInSynFamily(..), trivialBuiltInFamily        ) where @@ -40,7 +42,7 @@  import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType, pprTyVar )-import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )+import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon, isNewTyCon ) import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Name@@ -79,12 +81,12 @@        ; forall (k :: *) (a :: k -> *) (b :: k). F (a b) ~ Char        } -The axiom is used with the AxiomInstCo constructor of Coercion. If we wish+The axiom is used with the AxiomCo constructor of Coercion. If we wish to have a coercion showing that F (Maybe Int) ~ Char, it will look like  axF[2] <*> <Maybe> <Int> :: F (Maybe Int) ~ Char -- or, written using concrete-ish syntax ---AxiomInstCo axF 2 [Refl *, Refl Maybe, Refl Int]+AxiomRuleCo axF 2 [Refl *, Refl Maybe, Refl Int]  Note that the index is 0-based. @@ -127,9 +129,22 @@ ************************************************************************ -} -type BranchIndex = Int  -- The index of the branch in the list of branches-                        -- Counting from zero+{- Note [BranchIndex]+~~~~~~~~~~~~~~~~~~~~+A CoAxiom has 1 or more branches. Each branch has contains a list+of the free type variables in that branch, the LHS type patterns,+and the RHS type for that branch. When we apply an axiom to a list+of coercions, we must choose which branch of the axiom we wish to+use, as the different branches may have different numbers of free+type variables. (The number of type patterns is always the same+among branches, but that doesn't quite concern us here.)+-} ++type BranchIndex = Int         -- Counting from zero+      -- The index of the branch in the list of branches+      -- See Note [BranchIndex]+ -- promoted data type data BranchFlag = Branched | Unbranched type Branched = 'Branched@@ -250,7 +265,7 @@        -- cab_tvs and cab_lhs may be eta-reduced; see        -- Note [Eta reduction for data families]     , cab_cvs      :: [CoVar]-       -- ^ Bound coercion variables+      -- ^ Bound coercion variables        -- Always empty, for now.        -- See Note [Constraints in patterns]        -- in GHC.Tc.TyCl@@ -268,20 +283,16 @@   deriving Data.Data  toBranchedAxiom :: CoAxiom br -> CoAxiom Branched-toBranchedAxiom (CoAxiom unique name role tc branches implicit)-  = CoAxiom unique name role tc (toBranched branches) implicit+toBranchedAxiom ax@(CoAxiom { co_ax_branches = branches })+  = ax { co_ax_branches = toBranched branches }  toUnbranchedAxiom :: CoAxiom br -> CoAxiom Unbranched-toUnbranchedAxiom (CoAxiom unique name role tc branches implicit)-  = CoAxiom unique name role tc (toUnbranched branches) implicit+toUnbranchedAxiom ax@(CoAxiom { co_ax_branches = branches })+  = ax { co_ax_branches = toUnbranched branches }  coAxiomNumPats :: CoAxiom br -> Int coAxiomNumPats = length . coAxBranchLHS . (flip coAxiomNthBranch 0) -coAxiomNthBranch :: CoAxiom br -> BranchIndex -> CoAxBranch-coAxiomNthBranch (CoAxiom { co_ax_branches = bs }) index-  = branchesNth bs index- coAxiomArity :: CoAxiom br -> BranchIndex -> Arity coAxiomArity ax index   = length tvs + length cvs@@ -296,6 +307,14 @@ coAxiomBranches :: CoAxiom br -> Branches br coAxiomBranches = co_ax_branches +coAxiomNthBranch :: CoAxiom br -> BranchIndex -> CoAxBranch+coAxiomNthBranch (CoAxiom { co_ax_branches = bs }) index+  = branchesNth bs index++coAxiomSingleBranch :: CoAxiom Unbranched -> CoAxBranch+coAxiomSingleBranch (CoAxiom { co_ax_branches = MkBranches arr })+  = arr ! 0+ coAxiomSingleBranch_maybe :: CoAxiom br -> Maybe CoAxBranch coAxiomSingleBranch_maybe (CoAxiom { co_ax_branches = MkBranches arr })   | snd (bounds arr) == 0@@ -303,10 +322,6 @@   | otherwise   = Nothing -coAxiomSingleBranch :: CoAxiom Unbranched -> CoAxBranch-coAxiomSingleBranch (CoAxiom { co_ax_branches = MkBranches arr })-  = arr ! 0- coAxiomTyCon :: CoAxiom br -> TyCon coAxiomTyCon = co_ax_tc @@ -552,76 +567,177 @@ *                                                                      * ************************************************************************ -Conditional axioms.  The general idea is that a `CoAxiomRule` looks like this:+Note [CoAxiomRule]+~~~~~~~~~~~~~~~~~~+A CoAxiomRule is a built-in axiom, one that we assume to be true:+CoAxiomRules come in four flavours: -    forall as. (r1 ~ r2, s1 ~ s2) => t1 ~ t2+* BuiltInFamRew: provides evidence for, say+      (ax1)    3+4 ----> 7+      (ax2)    s+0 ----> s+  The evidence looks like+      AxiomCo ax1 [3,4] :: 3+4 ~ 7+      AxiomCo ax2 [s]   :: s+0 ~ s+  The arguments in the AxiomCo are the /instantiating types/, or+  more generally coercions (see Note [Coercion axioms applied to coercions]+  in GHC.Core.TyCo.Rep). -My intention is to reuse these for both (~) and (~#).-The short-term plan is to use this datatype to represent the type-nat axioms.-In the longer run, it may be good to unify this and `CoAxiom`,-as `CoAxiom` is the special case when there are no assumptions.+* BuiltInFamInj: provides evidence for the injectivity of type families+  For example+      (ax3)   g1: a+b ~ 0        --->  a~0+      (ax4)   g2: a+b ~ 0        --->  b~0+      (ax5)   g3: a+b1 ~ a~b2    --->  b1~b2+  The argument to the AxiomCo is the full coercion (always just one).+  So then:+      AxiomCo ax3 [g1] :: a ~ 0+      AxiomCo ax4 [g2] :: b ~ 0+      AxiomCo ax5 [g3] :: b1 ~ b2++* BranchedAxiom: used for closed type families+      type family F a where+        F Int  = Bool+        F Bool = Char+        F a    = a -> Int+  We get one (CoAxiom Branched) for the entire family; when used in an+  AxiomCo we pair it with the BranchIndex to say which branch to pick.++* UnbranchedAxiom: used for several purposes;+    - Newtypes+    - Data family instances+    - Open type family instances++Note [Avoiding allocating lots of CoAxiomRules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+CoAxiomRule is a sum type of four alternatives, which is very nice. But+there is a danger of allocating lots of (BuiltInFamRew bif) objects, every+time we (say) need a type-family rewrite.++To avoid this allocation, we cache the appropraite CoAxiomRule inside each+   BuiltInFamRewrite, BuiltInFamInjectivity+making a little circular data structure.  See the `bifrw_axr` field of+BuiltInFamRewrite, and similarly the others.++It's simple to do this, and saves a percent or two of allocation in programs+that do a lot of type-family work. -} --- | A more explicit representation for `t1 ~ t2`.-type TypeEqn = Pair Type+-- | CoAxiomRule describes a built-in axiom, one that we assume to be true+-- See Note [CoAxiomRule]+data CoAxiomRule+  = BuiltInFamRew  BuiltInFamRewrite                   -- Built-in type-family rewrites+                                                       --    e.g.  3+5 ~ 7 --- | For now, we work only with nominal equality.-data CoAxiomRule = CoAxiomRule-  { coaxrName      :: FastString-  , coaxrAsmpRoles :: [Role]    -- roles of parameter equations-  , coaxrRole      :: Role      -- role of resulting equation-  , coaxrProves    :: [TypeEqn] -> Maybe TypeEqn-        -- ^ coaxrProves returns @Nothing@ when it doesn't like-        -- the supplied arguments.  When this happens in a coercion-        -- that means that the coercion is ill-formed, and Core Lint-        -- checks for that.-  }+  | BuiltInFamInj  BuiltInFamInjectivity               -- Built-in type-family deductions+                                                       --    e.g.  a+b~0 ==>  a~0+                                                       -- Always unary +  | BranchedAxiom      (CoAxiom Branched) BranchIndex  -- Closed type family++  | UnbranchedAxiom    (CoAxiom Unbranched)            -- Open type family instance,+                                                       --    data family instances+                                                       --    and newtypes++instance Eq CoAxiomRule where+  (BuiltInFamRew  bif1)  == (BuiltInFamRew  bif2)  = bifrw_name  bif1 == bifrw_name bif2+  (BuiltInFamInj bif1)   == (BuiltInFamInj bif2)   = bifinj_name bif1 == bifinj_name bif2+  (UnbranchedAxiom ax1)  == (UnbranchedAxiom ax2)  = getUnique ax1 == getUnique ax2+  (BranchedAxiom ax1 i1) == (BranchedAxiom ax2 i2) = getUnique ax1 == getUnique ax2 && i1 == i2+  _ == _ = False++coAxiomRuleRole :: CoAxiomRule -> Role+coAxiomRuleRole (BuiltInFamRew  {})  = Nominal+coAxiomRuleRole (BuiltInFamInj {})   = Nominal+coAxiomRuleRole (UnbranchedAxiom ax) = coAxiomRole ax+coAxiomRuleRole (BranchedAxiom ax _) = coAxiomRole ax++coAxiomRuleArgRoles :: CoAxiomRule -> [Role]+coAxiomRuleArgRoles (BuiltInFamRew  bif) = replicate (bifrw_arity bif) Nominal+coAxiomRuleArgRoles (BuiltInFamInj {})   = [Nominal]+coAxiomRuleArgRoles (UnbranchedAxiom ax) = coAxBranchRoles (coAxiomSingleBranch ax)+coAxiomRuleArgRoles (BranchedAxiom ax i) = coAxBranchRoles (coAxiomNthBranch ax i)++coAxiomRuleBranch_maybe :: CoAxiomRule -> Maybe (TyCon, Role, CoAxBranch)+coAxiomRuleBranch_maybe (UnbranchedAxiom ax) = Just (co_ax_tc ax, co_ax_role ax, coAxiomSingleBranch ax)+coAxiomRuleBranch_maybe (BranchedAxiom ax i) = Just (co_ax_tc ax, co_ax_role ax, coAxiomNthBranch ax i)+coAxiomRuleBranch_maybe _                    = Nothing++isNewtypeAxiomRule_maybe :: CoAxiomRule -> Maybe (TyCon, CoAxBranch)+isNewtypeAxiomRule_maybe (UnbranchedAxiom ax)+  | let tc = coAxiomTyCon ax, isNewTyCon tc = Just (tc, coAxiomSingleBranch ax)+isNewtypeAxiomRule_maybe _                  = Nothing+ instance Data.Data CoAxiomRule where   -- don't traverse?   toConstr _   = abstractConstr "CoAxiomRule"   gunfold _ _  = error "gunfold"   dataTypeOf _ = mkNoRepType "CoAxiomRule" -instance Uniquable CoAxiomRule where-  getUnique = getUnique . coaxrName+instance Outputable CoAxiomRule where+  ppr (BuiltInFamRew  bif) = ppr (bifrw_name bif)+  ppr (BuiltInFamInj bif)  = ppr (bifinj_name bif)+  ppr (UnbranchedAxiom ax) = ppr (coAxiomName ax)+  ppr (BranchedAxiom ax i) = ppr (coAxiomName ax) <> brackets (int i) -instance Eq CoAxiomRule where-  x == y = coaxrName x == coaxrName y+{- *********************************************************************+*                                                                      *+                    Built-in families+*                                                                      *+********************************************************************* -} -instance Ord CoAxiomRule where-  -- we compare lexically to avoid non-deterministic output when sets of rules-  -- are printed-  compare x y = lexicalCompareFS (coaxrName x) (coaxrName y) -instance Outputable CoAxiomRule where-  ppr = ppr . coaxrName-+-- | A more explicit representation for `t1 ~ t2`.+type TypeEqn = Pair Type  -- Type checking of built-in families data BuiltInSynFamily = BuiltInSynFamily-  { sfMatchFam      :: [Type] -> Maybe (CoAxiomRule, [Type], Type)-    -- Does this reduce on the given arguments?-    -- If it does, returns (CoAxiomRule, types to instantiate the rule at, rhs type)-    -- That is: mkAxiomRuleCo coax (zipWith mkReflCo (coaxrAsmpRoles coax) ts)-    --              :: F tys ~r rhs,-    -- where the r in the output is coaxrRole of the rule. It is up to the-    -- caller to ensure that this role is appropriate.--  , sfInteractTop   :: [Type] -> Type -> [TypeEqn]+  { sfMatchFam :: [BuiltInFamRewrite]+  , sfInteract :: [BuiltInFamInjectivity]     -- If given these type arguments and RHS, returns the equalities that-    -- are guaranteed to hold.--  , sfInteractInert :: [Type] -> Type ->-                       [Type] -> Type -> [TypeEqn]-    -- If given one set of arguments and result, and another set of arguments-    -- and result, returns the equalities that are guaranteed to hold.+    -- are guaranteed to hold.  That is, if+    --     (ar, Pair s1 s2)  is an element of  (sfInteract tys ty)+    -- then  AxiomRule ar [co :: F tys ~ ty]  ::  s1~s2   } +data BuiltInFamInjectivity  -- Argument and result role are always Nominal+  = BIF_Interact+      { bifinj_name :: FastString+      , bifinj_axr  :: CoAxiomRule -- Cached copy of (BuiltInFamINj this-bif)+                                   -- See Note [Avoiding allocating lots of CoAxiomRules]++      , bifinj_proves :: TypeEqn -> Maybe TypeEqn+            -- ^ Always unary: just one TypeEqn argument+            -- Returns @Nothing@ when it doesn't like the supplied argument.+            -- When this happens in a coercion that means that the coercion is+            -- ill-formed, and Core Lint checks for that.+      }++data BuiltInFamRewrite  -- Argument roles and result role are always Nominal+  = BIF_Rewrite+      { bifrw_name   :: FastString+      , bifrw_axr    :: CoAxiomRule -- Cached copy of (BuiltInFamRew this-bif)+                                    -- See Note [Avoiding allocating lots of CoAxiomRules]++      , bifrw_fam_tc :: TyCon       -- Needed for tyConsOfType++      , bifrw_arity  :: Arity       -- Number of type arguments needed+                                    -- to instantiate this axiom++      , bifrw_match :: [Type] -> Maybe ([Type], Type)+           -- coaxrMatch: does this reduce on the given arguments?+           -- If it does, returns (types to instantiate the rule at, rhs type)+           -- That is: mkAxiomCo ax (zipWith mkReflCo coAxiomRuleArgRoles ts)+           --              :: F tys ~N rhs,++      , bifrw_proves :: [TypeEqn] -> Maybe TypeEqn }+           -- length(inst_tys) = bifrw_arity++      -- INVARIANT: bifrw_match and bifrw_proves are related as follows:+      -- If    Just (inst_tys, res_ty) = bifrw_match ax arg_tys+      -- then  * length arg_tys = tyConArity fam_tc+      --       * length inst_tys = bifrw_arity+       --      * bifrw_proves (map (return @Pair) inst_tys) = Just (return @Pair res_ty)++ -- Provides default implementations that do nothing. trivialBuiltInFamily :: BuiltInSynFamily-trivialBuiltInFamily = BuiltInSynFamily-  { sfMatchFam      = \_ -> Nothing-  , sfInteractTop   = \_ _ -> []-  , sfInteractInert = \_ _ _ _ -> []-  }+trivialBuiltInFamily = BuiltInSynFamily { sfMatchFam = [], sfInteract = [] }
compiler/GHC/Core/Coercion/Opt.hs view
@@ -21,13 +21,12 @@ import GHC.Core.Coercion.Axiom import GHC.Core.Unify +import GHC.Types.Basic( SwapFlag(..), flipSwap, isSwapped, pickSwap, notSwapped ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env-import GHC.Types.Unique.Set  import GHC.Data.Pair-import GHC.Data.List.SetOps ( getNth )  import GHC.Utils.Outputable import GHC.Utils.Constants (debugIsOn)@@ -68,33 +67,56 @@  Note [Optimising InstCo] ~~~~~~~~~~~~~~~~~~~~~~~~-(1) tv is a type variable-When we have (InstCo (ForAllCo tv h g) g2), we want to optimise.+Optimising InstCo is pretty subtle: #15725, #25387. -Let's look at the typing rules.+(1) tv is a type variable. We want to optimise -h : k1 ~ k2-tv:k1 |- g : t1 ~ t2-------------------------------ForAllCo tv h g : (all tv:k1.t1) ~ (all tv:k2.t2[tv |-> tv |> sym h])+  InstCo (ForAllCo tv kco g) g2  -->   S(g) -g1 : (all tv:k1.t1') ~ (all tv:k2.t2')-g2 : s1 ~ s2----------------------InstCo g1 g2 : t1'[tv |-> s1] ~ t2'[tv |-> s2]+where S is some substitution. Let's look at the typing rules. -We thus want some coercion proving this:+    kco : k1 ~ k2+    tv:k1 |- g : t1 ~ t2+    -----------------------------+    ForAllCo tv kco g : (all tv:k1.t1) ~ (all tv:k2.t2[tv |-> tv |> sym kco]) -  (t1[tv |-> s1]) ~ (t2[tv |-> s2 |> sym h])+    g1 : (all tv:k1.t1') ~ (all tv:k2.t2')+    g2 : (s1:k1) ~ (s2:k2)+    --------------------+    InstCo g1 g2 : t1'[tv |-> s1] ~ t2'[tv |-> s2] -If we substitute the *type* tv for the *coercion*-(g2 ; t2 ~ t2 |> sym h) in g, we'll get this result exactly.-This is bizarre,-though, because we're substituting a type variable with a coercion. However,-this operation already exists: it's called *lifting*, and defined in GHC.Core.Coercion.-We just need to enhance the lifting operation to be able to deal with-an ambient substitution, which is why a LiftingContext stores a TCvSubst.+Putting these two together +    kco : k1 ~ k2+    tv:k1 |- g : t1 ~ t2+    g2 : (s1:k1) ~ (s2:k2)+    --------------------+    InstCo (ForAllCo tv kco g) g2 : t1[tv |-> s1] ~ t2[tv |-> s2 |> sym kco]++We thus want S(g) to have kind++  S(g) :: (t1[tv |-> s1]) ~ (t2[tv |-> s2 |> sym kco])++All we need do is to substitute the coercion tv_co for tv:+  S = [tv :-> tv_co]+where+  tv_co : s1 ~ (s2 |> sym kco)+This looks bizarre, because we're substituting a /type variable/ with a+/coercion/. However, this operation already exists: it's called *lifting*, and+defined in GHC.Core.Coercion.  We just need to enhance the lifting operation to+be able to deal with an ambient substitution, which is why a LiftingContext+stores a TCvSubst.++In general if+  S = [tv :-> tv_co]+  tv_co : r1 ~ r2+  g     : t1 ~ t2+then+  S(g) : t1[tv :-> r1] ~ t2[tv :-> r2]++The substitution S is embodied in the LiftingContext argument of `opt_co4`;+See Note [The LiftingContext in optCoercion]+ (2) cv is a coercion variable Now consider we have (InstCo (ForAllCo cv h g) g2), we want to optimise. @@ -119,6 +141,27 @@  So we substitute the coercion variable c for the coercion (h1 ~N (n1; h2; sym n2)) in g.++Note [The LiftingContext in optCoercion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To suppport Note [Optimising InstCo] the coercion optimiser carries a+GHC.Core.Coercion.LiftingContext, which comprises+  * An ordinary Subst+  * The `lc_env`: a mapping from /type variables/ to /coercions/++We don't actually have a separate function+   liftCoSubstCo :: LiftingContext -> Coercion -> Coercion+The substitution of a type variable by a coercion is done by the calls to+`liftCoSubst` (on a type) in the Refl and GRefl cases of `opt_co4`.++We use the following invariants:+ (LC1) The coercions in the range of `lc_env` have already had all substitutions+       applied; they are "OutCoercions".  If you re-optimise these coercions, you+       must zap the LiftingContext first.++ (LC2) However they have /not/ had the "ambient sym" (the second argument of+       `opt_co4`) applied.  The ambient sym applies to the entire coercion not+       to the little bits being substituted. -}  -- | Coercion optimisation options@@ -132,45 +175,50 @@ optCoercion opts env co   | optCoercionEnabled opts   = optCoercion' env co+ {--  = pprTrace "optCoercion {" (text "Co:" <+> ppr co) $+  = pprTrace "optCoercion {" (text "Co:" <> ppr (coercionSize co)) $     let result = optCoercion' env co in-    pprTrace "optCoercion }" (vcat [ text "Co:" <+> ppr co-                                   , text "Optco:" <+> ppr result ]) $+    pprTrace "optCoercion }"+       (vcat [ text "Co:"    <+> ppr (coercionSize co)+             , text "Optco:" <+> ppWhen (isReflCo result) (text "(refl)")+                             <+> ppr (coercionSize result) ]) $     result -}    | otherwise   = substCo env co - optCoercion' :: Subst -> Coercion -> NormalCo optCoercion' env co   | debugIsOn-  = let out_co = opt_co1 lc False co+  = let out_co = opt_co1 lc NotSwapped co         (Pair in_ty1  in_ty2,  in_role)  = coercionKindRole co         (Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co++        details = vcat [ text "in_co:" <+> ppr co+                       , text "in_ty1:" <+> ppr in_ty1+                       , text "in_ty2:" <+> ppr in_ty2+                       , text "out_co:" <+> ppr out_co+                       , text "out_ty1:" <+> ppr out_ty1+                       , text "out_ty2:" <+> ppr out_ty2+                       , text "in_role:" <+> ppr in_role+                       , text "out_role:" <+> ppr out_role+                       ]     in-    assertPpr (substTyUnchecked env in_ty1 `eqType` out_ty1 &&-               substTyUnchecked env in_ty2 `eqType` out_ty2 &&-               in_role == out_role)-              (hang (text "optCoercion changed types!")-                  2 (vcat [ text "in_co:" <+> ppr co-                          , text "in_ty1:" <+> ppr in_ty1-                          , text "in_ty2:" <+> ppr in_ty2-                          , text "out_co:" <+> ppr out_co-                          , text "out_ty1:" <+> ppr out_ty1-                          , text "out_ty2:" <+> ppr out_ty2-                          , text "in_role:" <+> ppr in_role-                          , text "out_role:" <+> ppr out_role-                          , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co-                          , text "subst:" <+> ppr env ]))-               out_co+    warnPprTrace (not (isReflCo out_co) && isReflexiveCo out_co)+                 "optCoercion: reflexive but not refl" details $+--    assertPpr (substTyUnchecked env in_ty1 `eqType` out_ty1 &&+--               substTyUnchecked env in_ty2 `eqType` out_ty2 &&+--               in_role == out_role)+--              (hang (text "optCoercion changed types!") 2 details) $+    out_co -  | otherwise         = opt_co1 lc False co+  | otherwise+  = opt_co1 lc NotSwapped co   where     lc = mkSubstLiftingContext env-    ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv)+--    ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv)   type NormalCo    = Coercion@@ -181,92 +229,110 @@  type NormalNonIdCo = NormalCo  -- Extra invariant: not the identity --- | Do we apply a @sym@ to the result?-type SymFlag = Bool- -- | Do we force the result to be representational? type ReprFlag = Bool  -- | Optimize a coercion, making no assumptions. All coercions in -- the lifting context are already optimized (and sym'd if nec'y) opt_co1 :: LiftingContext-        -> SymFlag+        -> SwapFlag   -- IsSwapped => apply Sym to the result         -> Coercion -> NormalCo opt_co1 env sym co = opt_co2 env sym (coercionRole co) co  -- See Note [Optimising coercion optimisation] -- | Optimize a coercion, knowing the coercion's role. No other assumptions. opt_co2 :: LiftingContext-        -> SymFlag-        -> Role   -- ^ The role of the input coercion+        -> SwapFlag   -- ^IsSwapped => apply Sym to the result+        -> Role       -- ^ The role of the input coercion         -> Coercion -> NormalCo opt_co2 env sym Phantom co = opt_phantom env sym co-opt_co2 env sym r       co = opt_co3 env sym Nothing r co+opt_co2 env sym r       co = opt_co4 env sym False r co  -- See Note [Optimising coercion optimisation]--- | Optimize a coercion, knowing the coercion's non-Phantom role.-opt_co3 :: LiftingContext -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo+-- | Optimize a coercion, knowing the coercion's non-Phantom role,+--   and with an optional downgrade+opt_co3 :: LiftingContext -> SwapFlag -> Maybe Role -> Role -> Coercion -> NormalCo opt_co3 env sym (Just Phantom)          _ co = opt_phantom env sym co-opt_co3 env sym (Just Representational) r co = opt_co4_wrap env sym True  r co+opt_co3 env sym (Just Representational) r co = opt_co4 env sym True  r co   -- if mrole is Just Nominal, that can't be a downgrade, so we can ignore-opt_co3 env sym _                       r co = opt_co4_wrap env sym False r co+opt_co3 env sym _                       r co = opt_co4 env sym False r co  -- See Note [Optimising coercion optimisation] -- | Optimize a non-phantom coercion.-opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag-                      -> Role -> Coercion -> NormalCo--- Precondition: In every call (opt_co4 lc sym rep role co)---               we should have role = coercionRole co-opt_co4_wrap = opt_co4+opt_co4, opt_co4' :: LiftingContext -> SwapFlag -> ReprFlag+                  -> Role -> Coercion -> NormalCo+-- Precondition:  In every call (opt_co4 lc sym rep role co)+--                we should have role = coercionRole co+-- Precondition:  role is not Phantom+-- Postcondition: The resulting coercion is equivalant to+--                     wrapsub (wrapsym (mksub co)+--                 where wrapsym is SymCo if sym=True+--                       wrapsub is SubCo if rep=True +-- opt_co4 is there just to support tracing, when debugging+-- Usually it just goes straight to opt_co4'+opt_co4 = opt_co4'+ {--opt_co4_wrap env sym rep r co-  = pprTrace "opt_co4_wrap {"-    ( vcat [ text "Sym:" <+> ppr sym-           , text "Rep:" <+> ppr rep-           , text "Role:" <+> ppr r-           , text "Co:" <+> ppr co ]) $-    assert (r == coercionRole co )    $-    let result = opt_co4 env sym rep r co in-    pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $-    result--}+opt_co4 env sym rep r co+  = pprTrace "opt_co4 {"+   ( vcat [ text "Sym:" <+> ppr sym+          , text "Rep:" <+> ppr rep+          , text "Role:" <+> ppr r+          , text "Co:" <+> ppr co ]) $+   assert (r == coercionRole co )    $+   let result = opt_co4' env sym rep r co in+   pprTrace "opt_co4 }" (ppr co $$ text "---" $$ ppr result) $+   assertPpr (res_role == coercionRole result)+             (vcat [ text "Role:" <+> ppr r+                   , text "Result: " <+>  ppr result+                   , text "Result type:" <+> ppr (coercionType result) ]) $+   result +  where+    res_role | rep       = Representational+             | otherwise = r+-} -opt_co4 env _   rep r (Refl ty)+opt_co4' env sym rep r (Refl ty)   = assertPpr (r == Nominal)               (text "Expected role:" <+> ppr r    $$                text "Found role:" <+> ppr Nominal $$                text "Type:" <+> ppr ty) $-    liftCoSubst (chooseRole rep r) env ty+    wrapSym sym $ liftCoSubst (chooseRole rep r) env ty+        -- wrapSym: see (LC2) of Note [The LiftingContext in optCoercion] -opt_co4 env _   rep r (GRefl _r ty MRefl)+opt_co4' env sym rep r (GRefl _r ty MRefl)   = assertPpr (r == _r)               (text "Expected role:" <+> ppr r $$                text "Found role:" <+> ppr _r   $$                text "Type:" <+> ppr ty) $-    liftCoSubst (chooseRole rep r) env ty+    wrapSym sym $ liftCoSubst (chooseRole rep r) env ty+        -- wrapSym: see (LC2) of Note [The LiftingContext in optCoercion] -opt_co4 env sym  rep r (GRefl _r ty (MCo co))+opt_co4' env sym  rep r (GRefl _r ty (MCo kco))   = assertPpr (r == _r)               (text "Expected role:" <+> ppr r $$                text "Found role:" <+> ppr _r   $$                text "Type:" <+> ppr ty) $-    if isGReflCo co || isGReflCo co'-    then liftCoSubst r' env ty-    else wrapSym sym $ mkCoherenceRightCo r' ty' co' (liftCoSubst r' env ty)+    if isGReflCo kco || isGReflCo kco'+    then wrapSym sym ty_co+    else wrapSym sym $ mk_coherence_right_co r' (coercionRKind ty_co) kco' ty_co+            -- ty :: k1+            -- kco :: k1 ~ k2+            -- Desired result coercion:   ty ~ ty |> co   where-    r'  = chooseRole rep r-    ty' = substTy (lcSubstLeft env) ty-    co' = opt_co4 env False False Nominal co+    r'    = chooseRole rep r+    ty_co = liftCoSubst r' env ty+    kco'  = opt_co4 env NotSwapped False Nominal kco -opt_co4 env sym rep r (SymCo co)  = opt_co4_wrap env (not sym) rep r co+opt_co4' env sym rep r (SymCo co)  = opt_co4 env (flipSwap sym) rep r co   -- surprisingly, we don't have to do anything to the env here. This is   -- because any "lifting" substitutions in the env are tied to ForAllCos,   -- which treat their left and right sides differently. We don't want to   -- exchange them. -opt_co4 env sym rep r g@(TyConAppCo _r tc cos)+opt_co4' env sym rep r g@(TyConAppCo _r tc cos)   = assert (r == _r) $     case (rep, r) of       (True, Nominal) ->@@ -276,7 +342,7 @@                                (repeat Nominal)                                cos)       (False, Nominal) ->-        mkTyConAppCo Nominal tc (map (opt_co4_wrap env sym False Nominal) cos)+        mkTyConAppCo Nominal tc (map (opt_co4 env sym False Nominal) cos)       (_, Representational) ->                       -- must use opt_co2 here, because some roles may be P                       -- See Note [Optimising coercion optimisation]@@ -285,34 +351,35 @@                                    cos)       (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g) -opt_co4 env sym rep r (AppCo co1 co2)-  = mkAppCo (opt_co4_wrap env sym rep r co1)-            (opt_co4_wrap env sym False Nominal co2)+opt_co4' env sym rep r (AppCo co1 co2)+  = mkAppCo (opt_co4 env sym rep r co1)+            (opt_co4 env sym False Nominal co2) -opt_co4 env sym rep r (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR+opt_co4' env sym rep r (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR                                 , fco_kind = k_co, fco_body = co })   = case optForAllCoBndr env sym tv k_co of       (env', tv', k_co') -> mkForAllCo tv' visL' visR' k_co' $-                            opt_co4_wrap env' sym rep r co+                            opt_co4 env' sym rep r co      -- Use the "mk" functions to check for nested Refls   where     !(visL', visR') = swapSym sym (visL, visR) -opt_co4 env sym rep r (FunCo _r afl afr cow co1 co2)+opt_co4' env sym rep r (FunCo _r afl afr cow co1 co2)   = assert (r == _r) $     mkFunCo2 r' afl' afr' cow' co1' co2'   where-    co1' = opt_co4_wrap env sym rep r co1-    co2' = opt_co4_wrap env sym rep r co2+    co1' = opt_co4 env sym rep r co1+    co2' = opt_co4 env sym rep r co2     cow' = opt_co1 env sym cow     !r' | rep       = Representational         | otherwise = r     !(afl', afr') = swapSym sym (afl, afr) -opt_co4 env sym rep r (CoVarCo cv)+opt_co4' env sym rep r (CoVarCo cv)   | Just co <- lcLookupCoVar env cv   -- see Note [Forall over coercion] for why                                       -- this is the right thing here-  = opt_co4_wrap (zapLiftingContext env) sym rep r co+  = -- pprTrace "CoVarCo" (ppr cv $$ ppr co) $+    opt_co4 (zapLiftingContext env) sym rep r co    | ty1 `eqType` ty2   -- See Note [Optimise CoVarCo to Refl]   = mkReflCo (chooseRole rep r) ty1@@ -333,84 +400,60 @@                           cv           -- cv1 might have a substituted kind! -opt_co4 _ _ _ _ (HoleCo h)+opt_co4' _ _ _ _ (HoleCo h)   = pprPanic "opt_univ fell into a hole" (ppr h) -opt_co4 env sym rep r (AxiomInstCo con ind cos)+opt_co4' env sym rep r (AxiomCo con cos)     -- Do *not* push sym inside top-level axioms     -- e.g. if g is a top-level axiom     --   g a : f a ~ a     -- then (sym (g ty)) /= g (sym ty) !!-  = assert (r == coAxiomRole con )-    wrapRole rep (coAxiomRole con) $+  = assert (r == coAxiomRuleRole con )+    wrapRole rep (coAxiomRuleRole con) $     wrapSym sym $                        -- some sub-cos might be P: use opt_co2                        -- See Note [Optimising coercion optimisation]-    AxiomInstCo con ind (zipWith (opt_co2 env False)-                                 (coAxBranchRoles (coAxiomNthBranch con ind))-                                 cos)+    AxiomCo con (zipWith (opt_co2 env NotSwapped)+                         (coAxiomRuleArgRoles con)+                         cos)       -- Note that the_co does *not* have sym pushed into it -opt_co4 env sym rep r (UnivCo prov _r t1 t2)-  = assert (r == _r )-    opt_univ env sym prov (chooseRole rep r) t1 t2+opt_co4' env sym rep r (UnivCo { uco_prov = prov, uco_lty = t1+                              , uco_rty = t2, uco_deps = deps })+  = opt_univ env sym prov deps (chooseRole rep r) t1 t2 -opt_co4 env sym rep r (TransCo co1 co2)-                      -- sym (g `o` h) = sym h `o` sym g-  | sym       = opt_trans in_scope co2' co1'-  | otherwise = opt_trans in_scope co1' co2'+opt_co4' env sym rep r (TransCo co1 co2)+  -- sym (g `o` h) = sym h `o` sym g+  | isSwapped sym = opt_trans in_scope co2' co1'+  | otherwise     = opt_trans in_scope co1' co2'   where-    co1' = opt_co4_wrap env sym rep r co1-    co2' = opt_co4_wrap env sym rep r co2+    co1' = opt_co4 env sym rep r co1+    co2' = opt_co4 env sym rep r co2     in_scope = lcInScopeSet env -opt_co4 env _sym rep r (SelCo n co)-  | Just (ty, _co_role) <- isReflCo_maybe co-  = liftCoSubst (chooseRole rep r) env (getNthFromType n ty)-    -- NB: it is /not/ true that r = _co_role-    --     Rather, r = coercionRole (SelCo n co)--opt_co4 env sym rep r (SelCo (SelTyCon n r1) (TyConAppCo _ _ cos))-  = assert (r == r1 )-    opt_co4_wrap env sym rep r (cos `getNth` n)---- see the definition of GHC.Builtin.Types.Prim.funTyCon-opt_co4 env sym rep r (SelCo (SelFun fs) (FunCo _r2 _afl _afr w co1 co2))-  = opt_co4_wrap env sym rep r (getNthFun fs w co1 co2)--opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo { fco_kind = eta }))-      -- works for both tyvar and covar-  = opt_co4_wrap env sym rep Nominal eta--opt_co4 env sym rep r (SelCo n co)-  | Just nth_co <- case (co', n) of-      (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n)-      (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2)-      (ForAllCo { fco_kind = eta }, SelForAll) -> Just eta-      _                  -> Nothing-  = if rep && (r == Nominal)-      -- keep propagating the SubCo-    then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co-    else nth_co+opt_co4' env sym rep r (SelCo cs co)+  -- Historical note 1: we used to check `co` for Refl, TyConAppCo etc+  -- before optimising `co`; but actually the SelCo will have been built+  -- with mkSelCo, so these tests always fail. -  | otherwise-  = wrapRole rep r $ SelCo n co'-  where-    co' = opt_co1 env sym co+  -- Historical note 2: if rep=True and r=Nominal, we used to recursively+  -- call opt_co4 to re-optimse the result. But (a) that is inefficient+  -- and (b) wrapRole uses mkSubCo which does much the same job+  = wrapRole rep r $ mkSelCo cs $ opt_co1 env sym co -opt_co4 env sym rep r (LRCo lr co)+opt_co4' env sym rep r (LRCo lr co)   | Just pr_co <- splitAppCo_maybe co   = assert (r == Nominal )-    opt_co4_wrap env sym rep Nominal (pick_lr lr pr_co)+    opt_co4 env sym rep Nominal (pick_lr lr pr_co)   | Just pr_co <- splitAppCo_maybe co'   = assert (r == Nominal) $     if rep-    then opt_co4_wrap (zapLiftingContext env) False True Nominal (pick_lr lr pr_co)+    then opt_co4 (zapLiftingContext env) NotSwapped True Nominal (pick_lr lr pr_co)     else pick_lr lr pr_co   | otherwise   = wrapRole rep Nominal $ LRCo lr co'   where-    co' = opt_co4_wrap env sym False Nominal co+    co' = opt_co4 env sym False Nominal co      pick_lr CLeft  (l, _) = l     pick_lr CRight (_, r) = r@@ -450,73 +493,68 @@ -}  -- See Note [Optimising InstCo]-opt_co4 env sym rep r (InstCo co1 arg)+opt_co4' env sym rep r (InstCo fun_co arg_co)     -- forall over type...-  | Just (tv, _visL, _visR, kind_co, co_body) <- splitForAllCo_ty_maybe co1-  = opt_co4_wrap (extendLiftingContext env tv-                    (mkCoherenceRightCo Nominal t2 (mkSymCo kind_co) sym_arg))-                   -- mkSymCo kind_co :: k1 ~ k2-                   -- sym_arg :: (t1 :: k1) ~ (t2 :: k2)-                   -- tv |-> (t1 :: k1) ~ (((t2 :: k2) |> (sym kind_co)) :: k1)-                 sym rep r co_body+  | Just (tv, _visL, _visR, k_co, body_co) <- splitForAllCo_ty_maybe fun_co+    -- tv      :: k1+    -- k_co    :: k1 ~ k2+    -- body_co :: t1 ~ t2+    -- arg_co  :: (s1:k1) ~ (s2:k2)+  , let arg_co'  = opt_co4 env NotSwapped False Nominal arg_co+                  -- Do /not/ push Sym into the arg_co, hence sym=False+                  -- see (LC2) of Note [The LiftingContext in optCoercion]+        k_co' = opt_co4 env NotSwapped False Nominal k_co+        s2'   = coercionRKind arg_co'+        tv_co = mk_coherence_right_co Nominal s2' (mkSymCo k_co') arg_co'+                   -- mkSymCo kind_co :: k2 ~ k1+                   -- tv_co   :: (s1 :: k1) ~ (((s2 :: k2) |> (sym kind_co)) :: k1)+  = opt_co4 (extendLiftingContext env tv tv_co) sym rep r body_co      -- See Note [Forall over coercion]-  | Just (cv, _visL, _visR, _kind_co, co_body) <- splitForAllCo_co_maybe co1-  , CoercionTy h1 <- t1-  = opt_co4_wrap (extendLiftingContextCvSubst env cv h1) sym rep r co_body+  | Just (cv, _visL, _visR, _kind_co, body_co) <- splitForAllCo_co_maybe fun_co+  , CoercionTy h1 <- coercionLKind arg_co+  , let h1' = opt_co4 env NotSwapped False Nominal h1+  = opt_co4 (extendLiftingContextCvSubst env cv h1') sym rep r body_co -    -- See if it is a forall after optimization-    -- If so, do an inefficient one-variable substitution, then re-optimize+  -- OK so those cases didn't work.  See if it is a forall /after/ optimization+  -- If so, do an inefficient one-variable substitution, then re-optimize      -- forall over type...-  | Just (tv', _visL, _visR, kind_co', co_body') <- splitForAllCo_ty_maybe co1'-  = opt_co4_wrap (extendLiftingContext (zapLiftingContext env) tv'-                    (mkCoherenceRightCo Nominal t2' (mkSymCo kind_co') arg'))-            False False r' co_body'+  | Just (tv', _visL, _visR, k_co', body_co') <- splitForAllCo_ty_maybe fun_co'+  , let s2'   = coercionRKind arg_co'+        tv_co = mk_coherence_right_co Nominal s2' (mkSymCo k_co') arg_co'+        env'  = extendLiftingContext (zapLiftingContext env) tv' tv_co+  = opt_co4 env' NotSwapped False r' body_co'      -- See Note [Forall over coercion]-  | Just (cv', _visL, _visR, _kind_co', co_body') <- splitForAllCo_co_maybe co1'-  , CoercionTy h1' <- t1'-  = opt_co4_wrap (extendLiftingContextCvSubst (zapLiftingContext env) cv' h1')-                    False False r' co_body'+  | Just (cv', _visL, _visR, _kind_co', body_co') <- splitForAllCo_co_maybe fun_co'+  , CoercionTy h1' <- coercionLKind arg_co'+  , let env' = extendLiftingContextCvSubst (zapLiftingContext env) cv' h1'+  = opt_co4 env' NotSwapped False r' body_co' -  | otherwise = InstCo co1' arg'-  where-    co1'    = opt_co4_wrap env sym rep r co1-    r'      = chooseRole rep r-    arg'    = opt_co4_wrap env sym False Nominal arg-    sym_arg = wrapSym sym arg'+  -- Those cases didn't work either, so rebuild the InstCo+  -- Push Sym into /both/ function /and/ arg_coument+  | otherwise = InstCo fun_co' arg_co' -    -- Performance note: don't be alarmed by the two calls to coercionKind-    -- here, as only one call to coercionKind is actually demanded per guard.-    -- t1/t2 are used when checking if co1 is a forall, and t1'/t2' are used-    -- when checking if co1' (i.e., co1 post-optimization) is a forall.-    ---    -- t1/t2 must come from sym_arg, not arg', since it's possible that arg'-    -- might have an extra Sym at the front (after being optimized) that co1-    -- lacks, so we need to use sym_arg to balance the number of Syms. (#15725)-    Pair t1  t2  = coercionKind sym_arg-    Pair t1' t2' = coercionKind arg'+  where+    -- fun_co' arg_co' are both optimised, /and/ we have pushed `sym` into both+    -- So no more sym'ing on th results of fun_co' arg_co'+    fun_co' = opt_co4 env sym rep r fun_co+    arg_co' = opt_co4 env sym False Nominal arg_co+    r'   = chooseRole rep r -opt_co4 env sym _rep r (KindCo co)+opt_co4' env sym _rep r (KindCo co)   = assert (r == Nominal) $     let kco' = promoteCoercion co in     case kco' of       KindCo co' -> promoteCoercion (opt_co1 env sym co')-      _          -> opt_co4_wrap env sym False Nominal kco'+      _          -> opt_co4 env sym False Nominal kco'   -- This might be able to be optimized more to do the promotion   -- and substitution/optimization at the same time -opt_co4 env sym _ r (SubCo co)+opt_co4' env sym _ r (SubCo co)   = assert (r == Representational) $-    opt_co4_wrap env sym True Nominal co---- This could perhaps be optimized more.-opt_co4 env sym rep r (AxiomRuleCo co cs)-  = assert (r == coaxrRole co) $-    wrapRole rep r $-    wrapSym sym $-    AxiomRuleCo co (zipWith (opt_co2 env False) (coaxrAsmpRoles co) cs)+    opt_co4 env sym True Nominal co  {- Note [Optimise CoVarCo to Refl] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -530,9 +568,13 @@ ------------- -- | Optimize a phantom coercion. The input coercion may not necessarily -- be a phantom, but the output sure will be.-opt_phantom :: LiftingContext -> SymFlag -> Coercion -> NormalCo+opt_phantom :: LiftingContext -> SwapFlag -> Coercion -> NormalCo+opt_phantom env sym (UnivCo { uco_prov = prov, uco_lty = t1+                            , uco_rty = t2, uco_deps = deps })+  = opt_univ env sym prov deps Phantom t1 t2+ opt_phantom env sym co-  = opt_univ env sym (PhantomProv (mkKindCo co)) Phantom ty1 ty2+  = opt_univ env sym PhantomProv [mkKindCo co] Phantom ty1 ty2   where     Pair ty1 ty2 = coercionKind co @@ -567,17 +609,25 @@   -} -opt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role-         -> Type -> Type -> Coercion-opt_univ env sym (PhantomProv h) _r ty1 ty2-  | sym       = mkPhantomCo h' ty2' ty1'-  | otherwise = mkPhantomCo h' ty1' ty2'+opt_univ :: LiftingContext -> SwapFlag -> UnivCoProvenance+         -> [Coercion]+         -> Role -> Type -> Type -> Coercion+opt_univ env sym prov deps role ty1 ty2+  = let ty1'  = substTyUnchecked (lcSubstLeft  env) ty1+        ty2'  = substTyUnchecked (lcSubstRight env) ty2+        deps' = map (opt_co1 env sym) deps+        (ty1'', ty2'') = swapSym sym (ty1', ty2')+    in+    mkUnivCo prov deps' role ty1'' ty2''++{-+opt_univ env PhantomProv cvs _r ty1 ty2+  = mkUnivCo PhantomProv cvs Phantom ty1' ty2'   where-    h' = opt_co4 env sym False Nominal h     ty1' = substTy (lcSubstLeft  env) ty1     ty2' = substTy (lcSubstRight env) ty2 -opt_univ env sym prov role oty1 oty2+opt_univ1 env prov cvs' role oty1 oty2   | Just (tc1, tys1) <- splitTyConApp_maybe oty1   , Just (tc2, tys2) <- splitTyConApp_maybe oty2   , tc1 == tc2@@ -586,8 +636,8 @@       -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom);       -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps   = let roles    = tyConRoleListX role tc1-        arg_cos  = zipWith3 (mkUnivCo prov') roles tys1 tys2-        arg_cos' = zipWith (opt_co4 env sym False) roles arg_cos+        arg_cos  = zipWith3 (mkUnivCo prov cvs') roles tys1 tys2+        arg_cos' = zipWith (opt_co4 env False False) roles arg_cos     in     mkTyConAppCo role tc1 arg_cos' @@ -600,14 +650,13 @@       -- NB: prov isn't interesting here either   = let k1   = tyVarKind tv1         k2   = tyVarKind tv2-        eta  = mkUnivCo prov' Nominal k1 k2+        eta  = mkUnivCo prov cvs' Nominal k1 k2           -- eta gets opt'ed soon, but not yet.         ty2' = substTyWith [tv2] [TyVarTy tv1 `mkCastTy` eta] ty2 -        (env', tv1', eta') = optForAllCoBndr env sym tv1 eta-        !(vis1', vis2') = swapSym sym (vis1, vis2)+        (env', tv1', eta') = optForAllCoBndr env False tv1 eta     in-    mkForAllCo tv1' vis1' vis2' eta' (opt_univ env' sym prov' role ty1 ty2')+    mkForAllCo tv1' vis1 vis2 eta' (opt_univ1 env' prov cvs' role ty1 ty2')    | Just (Bndr cv1 vis1, ty1) <- splitForAllForAllTyBinder_maybe oty1   , isCoVar cv1@@ -617,7 +666,7 @@   = let k1    = varType cv1         k2    = varType cv2         r'    = coVarRole cv1-        eta   = mkUnivCo prov' Nominal k1 k2+        eta   = mkUnivCo prov cvs' Nominal k1 k2         eta_d = downgradeRole r' Nominal eta           -- eta gets opt'ed soon, but not yet.         n_co  = (mkSymCo $ mkSelCo (SelTyCon 2 r') eta_d) `mkTransCo`@@ -625,43 +674,62 @@                 (mkSelCo (SelTyCon 3 r') eta_d)         ty2'  = substTyWithCoVars [cv2] [n_co] ty2 -        (env', cv1', eta') = optForAllCoBndr env sym cv1 eta-        !(vis1', vis2') = swapSym sym (vis1, vis2)+        (env', cv1', eta') = optForAllCoBndr env False cv1 eta     in-    mkForAllCo cv1' vis1' vis2' eta' (opt_univ env' sym prov' role ty1 ty2')+    mkForAllCo cv1' vis1 vis2 eta' (opt_univ1 env' prov cvs' role ty1 ty2')    | otherwise   = let ty1 = substTyUnchecked (lcSubstLeft  env) oty1         ty2 = substTyUnchecked (lcSubstRight env) oty2-        (a, b) | sym       = (ty2, ty1)-               | otherwise = (ty1, ty2)     in-    mkUnivCo prov' role a b--  where-    prov' = case prov of-      ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco-      PluginProv _       -> prov+    mkUnivCo prov cvs' role ty1 ty2+-}  ------------- opt_transList :: HasDebugCallStack => InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] opt_transList is = zipWithEqual "opt_transList" (opt_trans is)   -- The input lists must have identical length. -opt_trans :: InScopeSet -> NormalCo -> NormalCo -> NormalCo+opt_trans :: HasDebugCallStack => InScopeSet -> NormalCo -> NormalCo -> NormalCo++-- opt_trans just allows us to add some debug tracing+-- Usually it just goes to opt_trans' opt_trans is co1 co2+  = -- (if coercionRKind co1 `eqType` coercionLKind co2+    --  then (\x -> x) else+    --  pprTrace "opt_trans" (vcat [ text "co1" <+> ppr co1+    --                             , text "co2" <+> ppr co2+    --                             , text "co1 kind" <+> ppr (coercionKind co1)+    --                             , text "co2 kind" <+> ppr (coercionKind co2)+    --                             , callStackDoc ])) $+    opt_trans' is co1 co2++{-+opt_trans is co1 co2+  = assertPpr (r1==r2) (vcat [ ppr r1 <+> ppr co1, ppr r2 <+> ppr co2]) $+    assertPpr (rres == r1) (vcat [ ppr r1 <+> ppr co1, ppr r2 <+> ppr co2, text "res" <+> ppr rres <+> ppr res ]) $+    res+  where+    res = opt_trans' is co1 co2+    rres = coercionRole res+    r1 = coercionRole co1+    r2 = coercionRole co1+-}++opt_trans' :: HasDebugCallStack => InScopeSet -> NormalCo -> NormalCo -> NormalCo+opt_trans' is co1 co2   | isReflCo co1 = co2     -- optimize when co1 is a Refl Co   | otherwise    = opt_trans1 is co1 co2 -opt_trans1 :: InScopeSet -> NormalNonIdCo -> NormalCo -> NormalCo+opt_trans1 :: HasDebugCallStack => InScopeSet -> NormalNonIdCo -> NormalCo -> NormalCo -- First arg is not the identity opt_trans1 is co1 co2   | isReflCo co2 = co1     -- optimize when co2 is a Refl Co   | otherwise    = opt_trans2 is co1 co2 -opt_trans2 :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> NormalCo+opt_trans2 :: HasDebugCallStack => InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> NormalCo -- Neither arg is the identity opt_trans2 is (TransCo co1a co1b) co2     -- Don't know whether the sub-coercions are the identity@@ -678,16 +746,27 @@     else opt_trans1 is co1_2a co2b  opt_trans2 _ co1 co2-  = mkTransCo co1 co2+  = mk_trans_co co1 co2 + ------ -- Optimize coercions with a top-level use of transitivity.-opt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo+opt_trans_rule :: HasDebugCallStack => InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo -opt_trans_rule is in_co1@(GRefl r1 t1 (MCo co1)) in_co2@(GRefl r2 _ (MCo co2))+opt_trans_rule _ in_co1 in_co2+  | assertPpr (coercionRKind in_co1 `eqType` coercionLKind in_co2)+              (vcat [ text "in_co1" <+> ppr in_co1+                   , text "in_co2" <+> ppr in_co2+                   , text "in_co1 kind" <+> ppr (coercionKind in_co1)+                   , text "in_co2 kind" <+> ppr (coercionKind in_co2)+                   , callStackDoc ]) $+    False+  = panic "opt_trans_rule"  -- This entire equation is purely assertion checking++opt_trans_rule is in_co1@(GRefl r1 t1 (MCo co1)) in_co2@(GRefl r2 _t2 (MCo co2))   = assert (r1 == r2) $     fireTransRule "GRefl" in_co1 in_co2 $-    mkGReflRightCo r1 t1 (opt_trans is co1 co2)+    mk_grefl_right_co r1 t1 (opt_trans is co1 co2)  -- Push transitivity through matching destructors opt_trans_rule is in_co1@(SelCo d1 co1) in_co2@(SelCo d2 co2)@@ -710,20 +789,13 @@   = fireTransRule "TrPushInst" in_co1 in_co2 $     mkInstCo (opt_trans is co1 co2) ty1 -opt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1)-                  in_co2@(UnivCo p2 r2 _tyl2 tyr2)-  | Just prov' <- opt_trans_prov p1 p2+opt_trans_rule _+    in_co1@(UnivCo { uco_prov = p1, uco_role = r1, uco_lty = tyl1, uco_deps = deps1 })+    in_co2@(UnivCo { uco_prov = p2, uco_role = r2, uco_rty = tyr2, uco_deps = deps2 })+  | p1 == p2    -- If the provenances are different, opt'ing will be very confusing   = assert (r1 == r2) $     fireTransRule "UnivCo" in_co1 in_co2 $-    mkUnivCo prov' r1 tyl1 tyr2-  where-    -- if the provenances are different, opt'ing will be very confusing-    opt_trans_prov (PhantomProv kco1)    (PhantomProv kco2)-      = Just $ PhantomProv $ opt_trans is kco1 kco2-    opt_trans_prov (ProofIrrelProv kco1) (ProofIrrelProv kco2)-      = Just $ ProofIrrelProv $ opt_trans is kco1 kco2-    opt_trans_prov (PluginProv str1)     (PluginProv str2)     | str1 == str2 = Just p1-    opt_trans_prov _ _ = Nothing+    mkUnivCo p1 (deps1 ++ deps2) r1 tyl1 tyr2  -- Push transitivity down through matching top-level constructors. opt_trans_rule is in_co1@(TyConAppCo r1 tc1 cos1) in_co2@(TyConAppCo r2 tc2 cos2)@@ -816,69 +888,68 @@       eta1' = downgradeRole role Nominal eta1       n1   = mkSelCo (SelTyCon 2 role) eta1'       n2   = mkSelCo (SelTyCon 3 role) eta1'-      r2'  = substCo (zipCvSubst [cv2] [(mkSymCo n1) `mkTransCo`-                                        (mkCoVarCo cv1) `mkTransCo` n2])+      r2'  = substCo (zipCvSubst [cv2] [(mkSymCo n1) `mk_trans_co`+                                        (mkCoVarCo cv1) `mk_trans_co` n2])                     r2  -- Push transitivity inside axioms opt_trans_rule is co1 co2 +  -- TrPushAxSym/TrPushSymAx+  -- Put this first!  Otherwise (#23619) we get+  --    newtype N a = MkN a+  --    axN :: forall a. N a ~ a+  -- Now consider (axN ty ; sym (axN ty))+  -- If we put TrPushSymAxR first, we'll get+  --    (axN ty ; sym (axN ty)) :: N ty ~ N ty -- Obviously Refl+  --    --> axN (sym (axN ty))  :: N ty ~ N ty -- Very stupid+  | Just (sym1, axr1, cos1) <- isAxiomCo_maybe co1+  , Just (sym2, axr2, cos2) <- isAxiomCo_maybe co2+  , axr1 == axr2+  , sym1 == flipSwap sym2+  , Just (tc, role, branch) <- coAxiomRuleBranch_maybe axr1+  , let qtvs   = coAxBranchTyVars branch ++ coAxBranchCoVars branch+        lhs    = mkTyConApp tc (coAxBranchLHS branch)+        rhs    = coAxBranchRHS branch+        pivot_tvs = exactTyCoVarsOfType (pickSwap sym2 lhs rhs)+  , all (`elemVarSet` pivot_tvs) qtvs+  = fireTransRule "TrPushAxSym" co1 co2 $+    if isSwapped sym2+       -- TrPushAxSym+    then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs+       -- TrPushSymAx+    else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs+   -- See Note [Push transitivity inside axioms] and   -- Note [Push transitivity inside newtype axioms only]   -- TrPushSymAxR-  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe-  , isNewTyCon (coAxiomTyCon con)-  , True <- sym-  , Just cos2 <- matchAxiom sym con ind co2-  , let newAxInst = AxiomInstCo con ind (opt_transList is (map mkSymCo cos2) cos1)+  | Just (sym, axr, cos1) <- isAxiomCo_maybe co1+  , isSwapped sym+  , Just cos2 <- matchNewtypeBranch sym axr co2+  , let newAxInst = AxiomCo axr (opt_transList is (map mkSymCo cos2) cos1)   = fireTransRule "TrPushSymAxR" co1 co2 $ SymCo newAxInst    -- TrPushAxR-  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe-  , isNewTyCon (coAxiomTyCon con)-  , False <- sym-  , Just cos2 <- matchAxiom sym con ind co2-  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)+  | Just (sym, axr, cos1) <- isAxiomCo_maybe co1+  , notSwapped sym+  , Just cos2 <- matchNewtypeBranch sym axr co2+  , let newAxInst = AxiomCo axr (opt_transList is cos1 cos2)   = fireTransRule "TrPushAxR" co1 co2 newAxInst    -- TrPushSymAxL-  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe-  , isNewTyCon (coAxiomTyCon con)-  , True <- sym-  , Just cos1 <- matchAxiom (not sym) con ind co1-  , let newAxInst = AxiomInstCo con ind (opt_transList is cos2 (map mkSymCo cos1))+  | Just (sym, axr, cos2) <- isAxiomCo_maybe co2+  , isSwapped sym+  , Just cos1 <- matchNewtypeBranch (flipSwap sym) axr co1+  , let newAxInst = AxiomCo axr (opt_transList is cos2 (map mkSymCo cos1))   = fireTransRule "TrPushSymAxL" co1 co2 $ SymCo newAxInst    -- TrPushAxL-  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe-  , isNewTyCon (coAxiomTyCon con)-  , False <- sym-  , Just cos1 <- matchAxiom (not sym) con ind co1-  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)+  | Just (sym, axr, cos2) <- isAxiomCo_maybe co2+  , notSwapped sym+  , Just cos1 <- matchNewtypeBranch (flipSwap sym) axr co1+  , let newAxInst = AxiomCo axr (opt_transList is cos1 cos2)   = fireTransRule "TrPushAxL" co1 co2 newAxInst -  -- TrPushAxSym/TrPushSymAx-  | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe-  , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe-  , con1 == con2-  , ind1 == ind2-  , sym1 == not sym2-  , let branch = coAxiomNthBranch con1 ind1-        qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch-        lhs  = coAxNthLHS con1 ind1-        rhs  = coAxBranchRHS branch-        pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs)-  , all (`elemVarSet` pivot_tvs) qtvs-  = fireTransRule "TrPushAxSym" co1 co2 $-    if sym2-       -- TrPushAxSym-    then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs-       -- TrPushSymAx-    else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs-  where-    co1_is_axiom_maybe = isAxiom_maybe co1-    co2_is_axiom_maybe = isAxiom_maybe co2-    role = coercionRole co1 -- should be the same as coercionRole co2!  opt_trans_rule _ co1 co2        -- Identity rule   | let ty1 = coercionLKind co1@@ -925,7 +996,7 @@          co2a'   = mkCoherenceLeftCo rt2a lt2a kcoa co2a         co2bs'  = zipWith3 mkGReflLeftCo rt2bs lt2bs kcobs-        co2bs'' = zipWith mkTransCo co2bs' co2bs+        co2bs'' = zipWith mk_trans_co co2bs' co2bs     in     mkAppCos (opt_trans is co1a co2a')              (zipWith (opt_trans is) co1bs co2bs'')@@ -1107,13 +1178,13 @@ -}  ------------swapSym :: SymFlag -> (a,a) -> (a,a)-swapSym sym (x,y) | sym       = (y,x)-                  | otherwise = (x,y)+swapSym :: SwapFlag -> (a,a) -> (a,a)+swapSym IsSwapped  (x,y) = (y,x)+swapSym NotSwapped (x,y) = (x,y) -wrapSym :: SymFlag -> Coercion -> Coercion-wrapSym sym co | sym       = mkSymCo co-               | otherwise = co+wrapSym :: SwapFlag -> Coercion -> Coercion+wrapSym IsSwapped  co = mkSymCo co+wrapSym NotSwapped co = co  -- | Conditionally set a role to be representational wrapRole :: ReprFlag@@ -1131,24 +1202,26 @@ chooseRole _    r = r  ------------isAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])-isAxiom_maybe (SymCo co)-  | Just (sym, con, ind, cos) <- isAxiom_maybe co-  = Just (not sym, con, ind, cos)-isAxiom_maybe (AxiomInstCo con ind cos)-  = Just (False, con, ind, cos)-isAxiom_maybe _ = Nothing+isAxiomCo_maybe :: Coercion -> Maybe (SwapFlag, CoAxiomRule, [Coercion])+-- We don't expect to see nested SymCo; and that lets us write a simple,+-- non-recursive function. (If we see a nested SymCo we'll just fail,+-- which is ok.)+isAxiomCo_maybe (SymCo (AxiomCo ax cos)) = Just (IsSwapped,  ax, cos)+isAxiomCo_maybe (AxiomCo ax cos)         = Just (NotSwapped, ax, cos)+isAxiomCo_maybe _                        = Nothing -matchAxiom :: Bool -- True = match LHS, False = match RHS-           -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]-matchAxiom sym ax@(CoAxiom { co_ax_tc = tc }) ind co-  | CoAxBranch { cab_tvs = qtvs+matchNewtypeBranch :: SwapFlag -- IsSwapped = match LHS, NotSwapped = match RHS+                   -> CoAxiomRule+                   -> Coercion -> Maybe [Coercion]+matchNewtypeBranch sym axr co+  | Just (tc,branch) <- isNewtypeAxiomRule_maybe axr+  , CoAxBranch { cab_tvs = qtvs                , cab_cvs = []   -- can't infer these, so fail if there are any                , cab_roles = roles                , cab_lhs = lhs-               , cab_rhs = rhs } <- coAxiomNthBranch ax ind+               , cab_rhs = rhs } <- branch   , Just subst <- liftCoMatch (mkVarSet qtvs)-                              (if sym then (mkTyConApp tc lhs) else rhs)+                              (pickSwap sym rhs (mkTyConApp tc lhs))                               co   , all (`isMappedByLC` subst) qtvs   = zipWithM (liftCoSubstTyVar subst) roles qtvs@@ -1225,7 +1298,7 @@   , (role /= Nominal) || (vis1 `eqForAllVis` vis2)   , let kind_co = mkSelCo SelForAll co   = Just ( tv1, vis1, vis2, kind_co-         , mkInstCo co (mkGReflRightCo Nominal (TyVarTy tv1) kind_co))+         , mkInstCo co (mk_grefl_right_co Nominal (TyVarTy tv1) kind_co))    | otherwise   = Nothing@@ -1248,8 +1321,8 @@         l_co     = mkCoVarCo cv1         kind_co' = downgradeRole r Nominal kind_co         r_co     = mkSymCo (mkSelCo (SelTyCon 2 r) kind_co')-                   `mkTransCo` l_co-                   `mkTransCo` mkSelCo (SelTyCon 3 r) kind_co'+                   `mk_trans_co` l_co+                   `mk_trans_co` mkSelCo (SelTyCon 3 r) kind_co'     in Just ( cv1, vis1, vis2, kind_co             , mkInstCo co (mkProofIrrelCo Nominal kind_co l_co r_co)) @@ -1326,7 +1399,55 @@  -} -optForAllCoBndr :: LiftingContext -> Bool+optForAllCoBndr :: LiftingContext -> SwapFlag                 -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion) optForAllCoBndr env sym-  = substForAllCoBndrUsingLC sym (opt_co4_wrap env sym False Nominal) env+  = substForAllCoBndrUsingLC sym (opt_co4 env sym False Nominal) env+++{- **********************************************************************+%*                                                                      *+       Assertion-checking versions of functions in Coercion.hs+%*                                                                      *+%********************************************************************* -}++-- We can't check the assertions in the "main" functions of these+-- functions, because the assertions don't hold during zonking.+-- But they are fantastically helpful in finding bugs in the coercion+-- optimiser itself, so I have copied them here with assertions.++mk_trans_co :: HasDebugCallStack => Coercion -> Coercion -> Coercion+-- Do assertion checking in mk_trans_co+mk_trans_co co1 co2+  = assertPpr (coercionRKind co1 `eqType` coercionLKind co2)+              (vcat [ text "co1" <+> ppr co1+                    , text "co2" <+> ppr co2+                    , text "co1 kind" <+> ppr (coercionKind co1)+                    , text "co2 kind" <+> ppr (coercionKind co2)+                    , callStackDoc ]) $+    mkTransCo co1 co2++mk_coherence_right_co :: HasDebugCallStack => Role -> Type -> CoercionN -> Coercion -> Coercion+mk_coherence_right_co r ty co co2+  = assertGRefl ty co $+    mkCoherenceRightCo r ty co co2++assertGRefl :: HasDebugCallStack => Type -> Coercion -> r -> r+assertGRefl ty co res+  = assertPpr (typeKind ty `eqType` coercionLKind co)+              (vcat [ pp_ty "ty" ty+                    , pp_co "co" co+                    , callStackDoc ]) $+    res++mk_grefl_right_co :: Role -> Type -> CoercionN -> Coercion+mk_grefl_right_co r ty co+  = assertGRefl ty co $+    mkGReflRightCo r ty co++pp_co :: String -> Coercion -> SDoc+pp_co s co = text s <+> hang (ppr co) 2 (dcolon <+> ppr (coercionKind co))++pp_ty :: String -> Type -> SDoc+pp_ty s ty = text s <+> hang (ppr ty) 2 (dcolon <+> ppr (typeKind ty))+
compiler/GHC/Core/ConLike.hs view
@@ -34,6 +34,7 @@ import GHC.Core.Multiplicity import GHC.Core.PatSyn import GHC.Core.TyCo.Rep (Type, ThetaType)+import GHC.Core.TyCon (tyConDataCons) import GHC.Core.Type(mkTyConApp) import GHC.Types.Unique import GHC.Types.Name@@ -126,7 +127,14 @@ -- | The 'ConInfo' (arity and field labels) associated to a 'ConLike'. conLikeConInfo :: ConLike -> ConInfo conLikeConInfo con =-  mkConInfo (conLikeArity con) (conLikeFieldLabels con)+  mkConInfo (conLikeConLikeInfo con) (conLikeArity con) (conLikeFieldLabels con)++-- | Compute a 'ConLikeInfo' from a 'ConLike'.+conLikeConLikeInfo :: ConLike -> ConLikeInfo+conLikeConLikeInfo (RealDataCon con)+  = ConIsData { conLikeDataCons = getName <$> tyConDataCons (dataConTyCon con) }+conLikeConLikeInfo (PatSynCon {})+  = ConIsPatSyn  -- | Returns just the instantiated /value/ argument types of a 'ConLike', -- (excluding dictionary args)
compiler/GHC/Core/DataCon.hs view
@@ -12,7 +12,7 @@         -- * Main data types         DataCon, DataConRep(..),         SrcStrictness(..), SrcUnpackedness(..),-        HsSrcBang(..), HsImplBang(..),+        HsSrcBang(..), HsBang(..), HsImplBang(..),         StrictnessMark(..),         ConTag,         DataConEnv,@@ -25,7 +25,7 @@         FieldLabel(..), flLabel, FieldLabelString,          -- ** Type construction-        mkDataCon, fIRST_TAG,+        mkHsSrcBang, mkDataCon, fIRST_TAG,          -- ** Type deconstruction         dataConRepType, dataConInstSig, dataConFullSig,@@ -379,11 +379,6 @@ -}  -- | A data constructor------ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',---             'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnComma'---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data DataCon   = MkData {         dcName    :: Name,      -- This is the name of the *source data con*@@ -456,7 +451,7 @@         -- 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]@@ -841,19 +836,18 @@  -- | Haskell Source Bang ----- Bangs on data constructor arguments as the user wrote them in the--- source code.+-- Bangs on data constructor arguments as written by the user, including the+-- source code for exact-printing. ----- @(HsSrcBang _ SrcUnpack SrcLazy)@ and--- @(HsSrcBang _ SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we--- emit a warning (in checkValidDataCon) and treat it like--- @(HsSrcBang _ NoSrcUnpack SrcLazy)@-data HsSrcBang =-  HsSrcBang SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"-            SrcUnpackedness-            SrcStrictness-  deriving Data.Data+-- In the AST, the SourceText is deconstructed and hidden inside+-- 'Language.Haskell.Syntax.Extension.XBangTy' extension point.+data HsSrcBang+  = HsSrcBang SourceText HsBang -- See Note [Pragma source text] in "GHC.Types.SourceText" +-- | Make a 'HsSrcBang' from all parts+mkHsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang+mkHsSrcBang stext u s = HsSrcBang stext (HsBang u s)+ -- | Haskell Implementation Bang -- -- Bangs of data constructor arguments as generated by the compiler@@ -1039,8 +1033,8 @@     gunfold _ _  = error "gunfold"     dataTypeOf _ = mkNoRepType "DataCon" -instance Outputable HsSrcBang where-    ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark+instance Outputable HsBang where+    ppr (HsBang prag mark) = ppr prag <+> ppr mark  instance Outputable HsImplBang where     ppr HsLazy                  = text "Lazy"@@ -1248,12 +1242,12 @@     , let uniq = mkAlphaTyVarUnique n           occ = mkTyVarOccFS (mkFastString ('x' : show n)) -    , not (uniq `elementOfUniqSet` avoid_uniqs)+    , not (uniq `memberUniqueSet` avoid_uniqs)     , not (occ `elemOccSet` avoid_occs) ]    where-    avoid_uniqs :: UniqSet Unique-    avoid_uniqs = mkUniqSet (map getUnique avoids)+    avoid_uniqs :: UniqueSet+    avoid_uniqs = fromListUniqueSet (map getUnique avoids)      avoid_occs :: OccSet     avoid_occs = mkOccSet (map getOccName avoids)@@ -1309,7 +1303,7 @@ -- 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 @@ -1338,7 +1332,7 @@   = [ EqSpec tv ty     | cv <- ex_tcvs     , isCoVar cv-    , let (_, _, ty1, ty, _) = coVarKindsTypesRole cv+    , let (ty1, ty, _) = coVarTypesRole cv           tv = getTyVar ty1     ]
compiler/GHC/Core/FVs.hs view
@@ -39,9 +39,8 @@         exprFVs,          -- * Orphan names-        orphNamesOfType, orphNamesOfTypes,-        orphNamesOfCo,  orphNamesOfCoCon, orphNamesOfAxiomLHS,-        exprsOrphNames,+        orphNamesOfType, orphNamesOfTypes, orphNamesOfAxiomLHS,+        orphNamesOfExprs,          -- * Core syntax tree annotation with free variables         FVAnn,                  -- annotation, abstract@@ -291,53 +290,35 @@ tickish_fvs (Breakpoint _ _ ids _) = FV.mkFVs ids tickish_fvs _ = emptyFV -{--************************************************************************-*                                                                      *-\section{Free names}-*                                                                      *-************************************************************************--}---- | Finds the free /external/ names of an expression, notably--- including the names of type constructors (which of course do not show--- up in 'exprFreeVars').-exprOrphNames :: CoreExpr -> NameSet--- There's no need to delete local binders, because they will all--- be /internal/ names.-exprOrphNames e-  = go e-  where-    go (Var v)-      | isExternalName n    = unitNameSet n-      | otherwise           = emptyNameSet-      where n = idName v-    go (Lit _)              = emptyNameSet-    go (Type ty)            = orphNamesOfType ty        -- Don't need free tyvars-    go (Coercion co)        = orphNamesOfCo co-    go (App e1 e2)          = go e1 `unionNameSet` go e2-    go (Lam v e)            = go e `delFromNameSet` idName v-    go (Tick _ e)           = go e-    go (Cast e co)          = go e `unionNameSet` orphNamesOfCo co-    go (Let (NonRec _ r) e) = go e `unionNameSet` go r-    go (Let (Rec prs) e)    = exprsOrphNames (map snd prs) `unionNameSet` go e-    go (Case e _ ty as)     = go e `unionNameSet` orphNamesOfType ty-                              `unionNameSet` unionNameSets (map go_alt as)--    go_alt (Alt _ _ r)      = go r---- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details-exprsOrphNames :: [CoreExpr] -> NameSet-exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es-- {- ********************************************************************** %*                                                                      *-                    orphNamesXXX-+                    Orphan names %*                                                                      * %********************************************************************* -} +{- Note [Finding orphan names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The functions here (orphNamesOfType, orphNamesOfExpr etc) traverse a template:+  * the head of an class instance decl+  * the LHS of a type-family instance+  * the arguments of a RULE+to find TyCons or (in the case of a RULE) Ids, that will be matched against when+matching the template. If none of these orphNames are locally defined, the instance+or RULE is an orphan: see Note [Orphans] in GHC.Core++Wrinkles:+ (ON1) We do not need to look inside coercions, because we never match against+       them.  Indeed, it'd be wrong to do so, because it could make an instance+       into a non-orphan, when it really is an orphan.++ (ON2) These orphNames functions are also (rather separately) used by GHCi, to+       implement :info.  When you say ":info Foo", we show all the instances that+       involve `Foo`; that is, all the instances whose oprhNames include `Foo`.++       To support `:info (->)` we need to ensure that (->) is treated as an orphName+       of FunTy, which is a bit messy since the "real" TyCon is `FUN`+-}+ orphNamesOfTyCon :: TyCon -> NameSet orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSet` case tyConClass_maybe tycon of     Nothing  -> emptyNameSet@@ -350,6 +331,8 @@ orphNamesOfType (LitTy {})           = emptyNameSet orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)                                        `unionNameSet` orphNamesOfType res+orphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSet` orphNamesOfType arg+ orphNamesOfType (TyConApp tycon tys) = func                                        `unionNameSet` orphNamesOfTyCon tycon                                        `unionNameSet` orphNamesOfTypes tys@@ -367,9 +350,9 @@                fun_tc = tyConName (funTyFlagTyCon af) -orphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSet` orphNamesOfType arg-orphNamesOfType (CastTy ty co)       = orphNamesOfType ty `unionNameSet` orphNamesOfCo co-orphNamesOfType (CoercionTy co)      = orphNamesOfCo co+-- Coercions: see wrinkle (ON1) of Note [Finding orphan names]+orphNamesOfType (CastTy ty _co)  = orphNamesOfType ty+orphNamesOfType (CoercionTy _co) = emptyNameSet  orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet orphNamesOfThings f = foldr (unionNameSet . f) emptyNameSet@@ -377,56 +360,6 @@ orphNamesOfTypes :: [Type] -> NameSet orphNamesOfTypes = orphNamesOfThings orphNamesOfType -orphNamesOfMCo :: MCoercion -> NameSet-orphNamesOfMCo MRefl    = emptyNameSet-orphNamesOfMCo (MCo co) = orphNamesOfCo co--orphNamesOfCo :: Coercion -> NameSet-orphNamesOfCo (Refl ty)             = orphNamesOfType ty-orphNamesOfCo (GRefl _ ty mco)      = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco-orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos-orphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2-orphNamesOfCo (ForAllCo { fco_kind = kind_co, fco_body = co })-                                    = orphNamesOfCo kind_co-                                      `unionNameSet` orphNamesOfCo co-orphNamesOfCo (FunCo { fco_mult = co_mult, fco_arg = co1, fco_res = co2 })-                                    = orphNamesOfCo co_mult-                                      `unionNameSet` orphNamesOfCo co1-                                      `unionNameSet` orphNamesOfCo co2-orphNamesOfCo (CoVarCo _)           = emptyNameSet-orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSet` orphNamesOfCos cos-orphNamesOfCo (UnivCo p _ t1 t2)    = orphNamesOfProv p `unionNameSet` orphNamesOfType t1-                                      `unionNameSet` orphNamesOfType t2-orphNamesOfCo (SymCo co)            = orphNamesOfCo co-orphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2-orphNamesOfCo (SelCo _ co)          = orphNamesOfCo co-orphNamesOfCo (LRCo  _ co)          = orphNamesOfCo co-orphNamesOfCo (InstCo co arg)       = orphNamesOfCo co `unionNameSet` orphNamesOfCo arg-orphNamesOfCo (KindCo co)           = orphNamesOfCo co-orphNamesOfCo (SubCo co)            = orphNamesOfCo co-orphNamesOfCo (AxiomRuleCo _ cs)    = orphNamesOfCos cs-orphNamesOfCo (HoleCo _)            = emptyNameSet--orphNamesOfProv :: UnivCoProvenance -> NameSet-orphNamesOfProv (PhantomProv co)    = orphNamesOfCo co-orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co-orphNamesOfProv (PluginProv _)      = emptyNameSet--orphNamesOfCos :: [Coercion] -> NameSet-orphNamesOfCos = orphNamesOfThings orphNamesOfCo--orphNamesOfCoCon :: CoAxiom br -> NameSet-orphNamesOfCoCon (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })-  = orphNamesOfTyCon tc `unionNameSet` orphNamesOfCoAxBranches branches--orphNamesOfCoAxBranches :: Branches br -> NameSet-orphNamesOfCoAxBranches-  = foldr (unionNameSet . orphNamesOfCoAxBranch) emptyNameSet . fromBranches--orphNamesOfCoAxBranch :: CoAxBranch -> NameSet-orphNamesOfCoAxBranch (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })-  = orphNamesOfTypes lhs `unionNameSet` orphNamesOfType rhs- -- | `orphNamesOfAxiomLHS` collects the names of the concrete types and -- type constructors that make up the LHS of a type family instance, -- including the family name itself.@@ -441,11 +374,44 @@   = (orphNamesOfTypes $ concatMap coAxBranchLHS $ fromBranches $ coAxiomBranches axiom)     `extendNameSet` getName (coAxiomTyCon axiom) --- Detect FUN 'Many as an application of (->), so that :i (->) works as expected+-- Detect (FUN 'Many) as an application of (->), so that :i (->) works as expected -- (see #8535) Issue #16475 describes a more robust solution+-- See wrinkle (ON2) of Note [Finding orphan names] orph_names_of_fun_ty_con :: Mult -> NameSet orph_names_of_fun_ty_con ManyTy = unitNameSet unrestrictedFunTyConName orph_names_of_fun_ty_con _      = emptyNameSet++-- | Finds the free /external/ names of an expression, notably+-- including the names of type constructors (which of course do not show+-- up in 'exprFreeVars').+orphNamesOfExpr :: CoreExpr -> NameSet+-- There's no need to delete local binders, because they will all+-- be /internal/ names.+orphNamesOfExpr e+  = go e+  where+    go (Var v)+      | isExternalName n    = unitNameSet n+      | otherwise           = emptyNameSet+      where n = idName v+    go (Lit _)              = emptyNameSet+    go (Type ty)            = orphNamesOfType ty        -- Don't need free tyvars+    go (Coercion _co)       = emptyNameSet -- See wrinkle (ON1) of Note [Finding orphan names]+    go (App e1 e2)          = go e1 `unionNameSet` go e2+    go (Lam v e)            = go e `delFromNameSet` idName v+    go (Tick _ e)           = go e+    go (Cast e _co)         = go e  -- See wrinkle (ON1) of Note [Finding orphan names]+    go (Let (NonRec _ r) e) = go e `unionNameSet` go r+    go (Let (Rec prs) e)    = orphNamesOfExprs (map snd prs) `unionNameSet` go e+    go (Case e _ ty as)     = go e `unionNameSet` orphNamesOfType ty+                              `unionNameSet` unionNameSets (map go_alt as)++    go_alt (Alt _ _ r)      = go r++-- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details+orphNamesOfExprs :: [CoreExpr] -> NameSet+orphNamesOfExprs es = foldr (unionNameSet . orphNamesOfExpr) emptyNameSet es+  {- ************************************************************************
compiler/GHC/Core/FamInstEnv.hs view
@@ -49,26 +49,30 @@ import GHC.Core.Reduction import GHC.Core.RoughMap import GHC.Core.FVs( orphNamesOfAxiomLHS )++import GHC.Builtin.Types.Literals( tryMatchFam )+ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Name-import GHC.Data.FastString-import GHC.Data.Maybe import GHC.Types.Var import GHC.Types.SrcLoc-import Control.Monad-import Data.List( mapAccumL )-import Data.Array( Array, assocs )+import GHC.Types.Name.Set  import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Types.Name.Set+import GHC.Data.FastString+import GHC.Data.Maybe import GHC.Data.Bag import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf +import Control.Monad+import Data.List( mapAccumL )+import Data.Array( Array, assocs )+ {- ************************************************************************ *                                                                      *@@ -1189,13 +1193,12 @@    | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe tc   , Just (ind, inst_tys, inst_cos) <- chooseBranch ax tys-  = let co = mkAxInstCo role ax ind inst_tys inst_cos+  = let co = mkAxInstCo role (BranchedAxiom ax ind) inst_tys inst_cos     in Just $ coercionRedn co -  | Just ax           <- isBuiltInSynFamTyCon_maybe tc-  , Just (coax,ts,ty) <- sfMatchFam ax tys-  , role == coaxrRole coax-  = let co = mkAxiomRuleCo coax (zipWith mkReflCo (coaxrAsmpRoles coax) ts)+  | Just builtin_fam  <- isBuiltInSynFamTyCon_maybe tc+  , Just (rewrite,ts,ty) <- tryMatchFam builtin_fam tys+  = let co = mkAxiomCo rewrite (map mkNomReflCo ts)     in Just $ mkReduction co ty    | otherwise
compiler/GHC/Core/InstEnv.hs view
@@ -11,7 +11,7 @@  module GHC.Core.InstEnv (         DFunId, InstMatch, ClsInstLookupResult,-        Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers,+        CanonicalEvidence(..), PotentialUnifiers(..), getCoherentUnifiers, nullUnifiers,         OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,         ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprDFunId, pprInstances,         instanceWarning, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst,@@ -602,18 +602,22 @@ http://www.haskell.org/ghc/docs/latest/html/users_guide/glasgow_exts.html#instance-overlap  The willingness to be overlapped or incoherent is a property of the-instance declaration itself, controlled as follows:+instance declaration itself, controlled by its `OverlapMode`, as follows - * An instance is "incoherent"+ * An instance is "incoherent" (OverlapMode = `Incoherent` or `NonCanonical`)    if it has an `INCOHERENT` pragma, or    if it appears in a module compiled with `-XIncoherentInstances`.+   In those cases:+      -fspecialise-incoherents on  => Incoherent+      -fspecialise-incoherents off => NonCanonical+   NB: it is on by default - * An instance is "overlappable"+ * An instance is "overlappable" (OverlapMode = `Overlappable` or `Overlaps`)    if it has an `OVERLAPPABLE` or `OVERLAPS` pragma, or    if it appears in a module compiled with `-XOverlappingInstances`, or    if the instance is incoherent. - * An instance is "overlapping"+ * An instance is "overlapping" (OverlapMode = `Overlapping` or `Overlaps`)    if it has an `OVERLAPPING` or `OVERLAPS` pragma, or    if it appears in a module compiled with `-XOverlappingInstances`, or    if the instance is incoherent.@@ -640,20 +644,30 @@         "either/or" design, rather than a "both/and" design, allow a         client to deliberately override an instance from a library,         without requiring a change to the library.)+      This is done by `pruneOverlappingMatches`  (IL4) If all the remaining candidates are *incoherent*, the search succeeds,       returning an arbitrary surviving candidate. +      If any coherent or non-canonical incoherent unifiers were discarded,+      return NoUnifiers EvNonCanonical; if only canonical incoherent unifiers+      were discarded, return NoUnifiers EvCanonical+ (IL5) If more than one non-*incoherent* candidate remains, the search       fails.  Otherwise there is exactly one non-*incoherent*       candidate; call it the "prime candidate".  (IL6) Now find all instances that unify with the target constraint,       but do not match it. Such non-candidate instances might match-      when the target constraint is further instantiated. If all of-      them are *incoherent* top-level instances, the search succeeds,-      returning the prime candidate. Otherwise the search fails.+      when the target constraint is further instantiated. +      If any are *coherent* (not incoherent) return them+      as PotentialUnifiers.++      If all are *incoherent* (OverlapFlag = Incoherent or NonCanonical)+      return (NoUnifiers nc), where nc is EvNonCanonical if any of the discarded+      unifiers are NonCanonical.+ Notice that these rules are not influenced by flag settings in the client module, where the instances are *used*. These rules make it possible for a library author to design a library that relies on@@ -787,8 +801,11 @@       d1 :: C tys       d2 :: C tys then the dictionary d1 can be used in place of d2 and vice versa; it is as if-(C tys) is a singleton type.  How do we guarantee this?  Let's use this-example+(C tys) is a singleton type.  If d1 and d2 are interchangeable, we say that+they constitute /canonical evidence/ for (C tys).  We have a special data type,+`CanonoicalEvidence`, for recording whether evidence is canonical.++Let's use this example   class C a where { op :: a -> Int }   instance                     C [a]         where {...}   -- (I1)   instance {-# OVERLAPPING #-} C [Int]       where {...}   -- (I2)@@ -807,7 +824,7 @@   programmer can contrive, with some effort), all bets are off; we really   can't make any guarantees at all. -* But what about [W] C [b], which might arise from+* But what about [W] C [b]? This might arise from      risky :: b -> Int      risky x = op [x]   We can't pick (I2) because `b` is not Int. But if we pick (I1), and later@@ -863,20 +880,22 @@ and sometimes we don't.  It would be best to have a per-instance pragma, but for now we have a global flag: -* If an instance has an `{-# INCOHERENT #-}` pragma, we use its `OverlapFlag` to-  label it as either-  * `Incoherent`: meaning incoherent but still specialisable, or-  * `NonCanonical`: meaning incoherent and not specialisable.+* If an instance has an `{-# INCOHERENT #-}` pragma, we the  `OverlapFlag` of the+  `ClsInst` to label it as either+    * `Incoherent`: meaning incoherent but still specialisable, or+    * `NonCanonical`: meaning incoherent and not specialisable.+  The module-wide `-fspecialise-incoherents` flag (on by default) determines+  which choice is made. -The module-wide `-fspecialise-incoherents` flag determines which-choice is made.  The rest of this note describes what happens for-`NonCanonical` instances, i.e. with `-fno-specialise-incoherents`.+  See GHC.Tc.Utils.Instantiate.getOverlapFlag. +The rest of this note describes what happens for `NonCanonical`+instances, i.e. with `-fno-specialise-incoherents`.+ To avoid this incoherence breaking the specialiser, -* We label as "non-canonical" the dictionary constructed by a-  (potentially) incoherent use of an instance declaration whose-  `OverlapFlag` is `NonCanonical`.+* We label as "non-canonical" the dictionary constructed by a (potentially)+  incoherent use of an ClsInst whose `OverlapFlag` is `NonCanonical`.  * We do not specialise a function if there is a non-canonical   dictionary in the /transistive dependencies/ of its dictionary@@ -1016,22 +1035,42 @@   LookupInstErrNotFound   deriving (Generic) -type Canonical = Bool+-- | `CanonicalEvidence` says whether a piece of evidence has a singleton type;+-- For example, given (d1 :: C Int), will any other (d2 :: C Int) do equally well?+-- See Note [Coherence and specialisation: overview] above, and+-- Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds+data CanonicalEvidence+  = EvCanonical+  | EvNonCanonical +andCanEv :: CanonicalEvidence -> CanonicalEvidence -> CanonicalEvidence+-- Only canonical if both are+andCanEv EvCanonical EvCanonical = EvCanonical+andCanEv _           _           = EvNonCanonical+ -- See Note [Recording coherence information in `PotentialUnifiers`]-data PotentialUnifiers = NoUnifiers Canonical-                       -- NoUnifiers True: We have a unique solution modulo canonicity-                       -- NoUnifiers False: The solutions is not canonical, and thus-                       --   we shouldn't specialise on it.-                       | OneOrMoreUnifiers (NonEmpty ClsInst)-                       -- This list is lazy as we only look at all the unifiers when-                       -- printing an error message. It can be expensive to compute all-                       -- the unifiers because if you are matching something like C a[sk] then-                       -- all instances will unify.+data PotentialUnifiers+  = NoUnifiers CanonicalEvidence+       -- Either there were no unifiers, or all were incoherent+       --+       -- NoUnifiers EvNonCanonical:+       --    We discarded (via INCOHERENT) some instances that unify,+       --    and that are marked NonCanonical; so the matching instance+       --    should be traeated as EvNonCanonical+       -- NoUnifiers EvCanonical:+       --    We discarded no NonCanonical incoherent unifying instances,+       --    so the matching instance can be treated as EvCanonical +  | OneOrMoreUnifiers (NonEmpty ClsInst)+       -- There are some /coherent/ unifiers; here they are+       --+       -- This list is lazy as we only look at all the unifiers when+       -- printing an error message. It can be expensive to compute all+       -- the unifiers because if you are matching something like C a[sk] then+       -- all instances will unify.+ {- Note [Recording coherence information in `PotentialUnifiers`] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- When we find a matching instance, there might be other instances that could potentially unify with the goal. For `INCOHERENT` instances, we don't care (see steps IL4 and IL6 in Note [Rules for instance@@ -1047,18 +1086,23 @@ `Canonical`. -} +instance Outputable CanonicalEvidence where+  ppr EvCanonical    = text "canonical"+  ppr EvNonCanonical = text "non-canonical"+ instance Outputable PotentialUnifiers where-  ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical"-  ppr xs = ppr (getPotentialUnifiers xs)+  ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c+  ppr xs = ppr (getCoherentUnifiers xs)  instance Semigroup PotentialUnifiers where-  NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2)+  NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 `andCanEv` c2)   NoUnifiers _ <> u = u-  OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u))+  OneOrMoreUnifiers (unifier :| unifiers) <> u+    = OneOrMoreUnifiers (unifier :| (unifiers <> getCoherentUnifiers u)) -getPotentialUnifiers :: PotentialUnifiers -> [ClsInst]-getPotentialUnifiers NoUnifiers{} = []-getPotentialUnifiers (OneOrMoreUnifiers cls) = NE.toList cls+getCoherentUnifiers :: PotentialUnifiers -> [ClsInst]+getCoherentUnifiers NoUnifiers{} = []+getCoherentUnifiers (OneOrMoreUnifiers cls) = NE.toList cls  nullUnifiers :: PotentialUnifiers -> Bool nullUnifiers NoUnifiers{} = True@@ -1081,7 +1125,7 @@ -- giving a suitable error message  lookupInstEnv' (InstEnv rm) vis_mods cls tys-  = (foldr check_match [] rough_matches, check_unifier rough_unifiers)+  = (foldr check_match [] rough_matches, check_unifiers rough_unifiers)   where     (rough_matches, rough_unifiers) = lookupRM' rough_tcs rm     rough_tcs  = RML_KnownTc (className cls) : roughMatchTcsLookup tys@@ -1094,29 +1138,23 @@        | Just subst <- tcMatchTys tpl_tys tys       = ((item, map (lookupTyVar subst) tpl_tvs) : acc)+       | otherwise       = acc --    noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers-    noncanonically_matched (NoUnifiers _) = NoUnifiers False-    noncanonically_matched u = u+    check_unifiers :: [ClsInst] -> PotentialUnifiers+    check_unifiers [] = NoUnifiers EvCanonical+    check_unifiers (item@ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) -    check_unifier :: [ClsInst] -> PotentialUnifiers-    check_unifier [] = NoUnifiers True-    check_unifier (item@ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items)       | not (instIsVisible vis_mods item)-      = check_unifier items  -- See Note [Instance lookup and orphan instances]-      | Just {} <- tcMatchTys tpl_tys tys = check_unifier items-        -- Does not match, so next check whether the things unify-        -- See Note [Overlapping instances]-        -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview]-      | isNonCanonical item-      = noncanonically_matched $ check_unifier items-        -- Ignore ones that are incoherent: Note [Incoherent instances]-      | isIncoherent item-      = check_unifier items+      = check_unifiers items  -- See Note [Instance lookup and orphan instances] +      -- If it matches, check_match has gotten it, so skip over it here+      | Just {} <- tcMatchTys tpl_tys tys+      = check_unifiers items++      -- Does not match, so next check whether the things unify+      -- See Note [Overlapping instances]       | otherwise       = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set)                   ((ppr cls <+> ppr tys) $$@@ -1128,16 +1166,30 @@           -- We consider MaybeApart to be a case where the instance might           -- apply in the future. This covers an instance like C Int and           -- a target like [W] C (F a), where F is a type family.-            SurelyApart              -> check_unifier items+            SurelyApart              -> check_unifiers items               -- See Note [Infinitary substitution in lookup]-            MaybeApart MARInfinite _ -> check_unifier items-            _                        ->-              OneOrMoreUnifiers (item :| getPotentialUnifiers (check_unifier items))+            MaybeApart MARInfinite _ -> check_unifiers items+            _                        -> add_unifier item (check_unifiers items)        where         tpl_tv_set = mkVarSet tpl_tvs         tys_tv_set = tyCoVarsOfTypes tys +    add_unifier :: ClsInst -> PotentialUnifiers -> PotentialUnifiers+        -- Record that we encountered non-canonical instances:+        -- Note [Coherence and specialisation: overview]+    add_unifier item other_unifiers+      | not (isIncoherent item)+      = OneOrMoreUnifiers (item :| getCoherentUnifiers other_unifiers)++      -- So `item` is incoherent; see Note [Incoherent instances]+      | otherwise+      = case other_unifiers of+          OneOrMoreUnifiers{}                -> other_unifiers+          NoUnifiers{} | isNonCanonical item -> NoUnifiers EvNonCanonical+                       | otherwise           -> other_unifiers++ --------------- -- This is the common way to call this function. lookupInstEnv :: Bool              -- Check Safe Haskell overlap restrictions@@ -1171,9 +1223,16 @@            _       -> []      -- If the selected match is incoherent, discard all unifiers+    -- See (IL4) of Note [Rules for instance lookup]     final_unifs = case final_matches of-                    (m:_) | isIncoherent (fst m) -> NoUnifiers True-                    _                            -> all_unifs+                    (m:ms) | isIncoherent (fst m)+                           -- Incoherent match, so discard all unifiers, but+                           -- keep track of dropping coherent or non-canonical ones+                           -> assertPpr (null ms) (ppr final_matches) $+                              case all_unifs of+                                OneOrMoreUnifiers{} -> NoUnifiers EvNonCanonical+                                NoUnifiers{}        -> all_unifs+                    _      -> all_unifs      -- Note [Safe Haskell isSafeOverlap]     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1350,7 +1409,10 @@ pruneOverlappedMatches :: [InstMatch] -> [InstMatch] -- ^ Remove from the argument list any InstMatches for which another -- element of the list is more specific, and overlaps it, using the--- rules of Note [Rules for instance lookup]+-- rules of Note [Rules for instance lookup], esp (IL3)+--+-- Incoherent instances are discarded, unless all are incoherent,+-- in which case exactly one is kept. pruneOverlappedMatches all_matches =   instMatches $ foldr insert_overlapping noMatches all_matches @@ -1484,8 +1546,8 @@ Example:         class C a b c where foo :: (a,b,c)         instance C [a] b Int-        instance [incoherent] [Int] b c-        instance [incoherent] C a Int c+        instance {-# INCOHERENT #-} C [Int] b c+        instance {-# INCOHERENT #-} C a Int c Thanks to the incoherent flags,         [Wanted]  C [a] b Int works: Only instance one matches, the others just unify, but are marked
compiler/GHC/Core/Lint.hs view
@@ -49,10 +49,11 @@ 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-import GHC.Core.TyCo.Compare ( eqType, eqForAllVis )+import GHC.Core.TyCo.Compare ( eqType, eqTypes, eqTypeIgnoringMultiplicity, eqForAllVis ) import GHC.Core.TyCo.Subst import GHC.Core.TyCo.FVs import GHC.Core.TyCo.Ppr@@ -634,11 +635,16 @@        --     in GHC.Core.Opt.DmdAnal        ; case splitDmdSig (idDmdSig binder) of            (demands, result_info) | isDeadEndDiv result_info ->-             checkL (demands `lengthAtLeast` idArity binder)-               (text "idArity" <+> ppr (idArity binder) <+>-               text "exceeds arity imposed by the strictness signature" <+>-               ppr (idDmdSig binder) <> colon <+>-               ppr binder)+              if (demands `lengthAtLeast` idArity binder)+              then return ()+              else pprTrace "Hack alert: lintLetBind #24623"+                       (ppr (idArity binder) $$ ppr (idDmdSig binder)) $+                   return ()+--             checkL (demands `lengthAtLeast` idArity binder)+--               (text "idArity" <+> ppr (idArity binder) <+>+--               text "exceeds arity imposed by the strictness signature" <+>+--               ppr (idDmdSig binder) <> colon <+>+--               ppr binder)             _ -> return () @@ -1300,7 +1306,7 @@ -- | 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@@ -1932,6 +1938,13 @@   = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc)  -------------------+checkTyCoVarInScope :: Subst -> TyCoVar -> LintM ()+checkTyCoVarInScope subst tcv+  = checkL (tcv `isInScope` subst) $+    hang (text "The type or coercion variable" <+> pprBndr LetBind tcv)+       2 (text "is out of scope")++------------------- lintType :: Type -> LintM LintedType  -- If you edit this function, you may need to update the GHC formalism@@ -1948,12 +1961,8 @@            -- In GHCi we may lint an expression with a free            -- type variable.  Then it won't be in the            -- substitution, but it should be in scope-           Nothing | tv `isInScope` subst-                   -> return (TyVarTy tv)-                   | otherwise-                   -> failWithL $-                      hang (text "The type variable" <+> pprBndr LetBind tv)-                         2 (text "is out of scope")+           Nothing -> do { checkTyCoVarInScope subst tv+                         ; return (TyVarTy tv) }      }  lintType ty@(AppTy t1 t2)@@ -2325,15 +2334,8 @@   = do { subst <- getSubst        ; case lookupCoVar subst cv of            Just linted_co -> return linted_co ;-           Nothing-              | cv `isInScope` subst-                   -> return (CoVarCo cv)-              | otherwise-                   ->-                      -- lintCoBndr always extends the substitution-                      failWithL $-                      hang (text "The coercion variable" <+> pprBndr LetBind cv)-                         2 (text "is out of scope")+           Nothing        -> do { checkTyCoVarInScope subst cv+                                ; return (CoVarCo cv) }      }  @@ -2465,18 +2467,27 @@                               , text "res_co:" <+> ppr co2 ])  -- See Note [Bad unsafe coercion]-lintCoercion co@(UnivCo prov r ty1 ty2)-  = do { ty1' <- lintType ty1+lintCoercion co@(UnivCo { uco_role = r, uco_prov = prov+                        , uco_lty = ty1, uco_rty = ty2, uco_deps = deps })+  = do { -- Check the role.  PhantomProv must have Phantom role, otherwise any role is fine+         case prov of+            PhantomProv -> lintRole co Phantom r+            _           -> return ()++       -- Check the to and from types+       ; ty1' <- lintType ty1        ; ty2' <- lintType ty2+        ; let k1 = typeKind ty1'              k2 = typeKind ty2'-       ; prov' <- lint_prov k1 k2 prov-        ; when (r /= Phantom && isTYPEorCONSTRAINT k1                             && isTYPEorCONSTRAINT k2)               (checkTypes ty1 ty2) -       ; return (UnivCo prov' r ty1' ty2') }+       -- Check the coercions on which this UnivCo depends+       ; deps' <- mapM lintCoercion deps++       ; return (co { uco_lty = ty1', uco_rty = ty2', uco_deps = deps' }) }    where      report s = hang (text $ "Unsafe coercion: " ++ s)                      2 (vcat [ text "From:" <+> ppr ty1@@ -2519,27 +2530,6 @@                 _          -> return ()             } -     lint_prov k1 k2 (PhantomProv kco)-       = do { kco' <- lintStarCoercion kco-            ; lintRole co Phantom r-            ; check_kinds kco' k1 k2-            ; return (PhantomProv kco') }--     lint_prov k1 k2 (ProofIrrelProv kco)-       = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co)-            ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co)-            ; kco' <- lintStarCoercion kco-            ; check_kinds kco k1 k2-            ; return (ProofIrrelProv kco') }--     lint_prov _ _ prov@(PluginProv _) = return prov--     check_kinds kco k1 k2-       = do { let Pair k1' k2' = coercionKind kco-            ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft  co)-            ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) }-- lintCoercion (SymCo co)   = do { co' <- lintCoercion co        ; return (SymCo co') }@@ -2629,43 +2619,51 @@           ; _ -> failWithL (text "Bad argument of inst") }}} -lintCoercion co@(AxiomInstCo con ind cos)-  = do { unless (0 <= ind && ind < numBranches (coAxiomBranches con))-                (bad_ax (text "index out of range"))-       ; let CoAxBranch { cab_tvs   = ktvs-                        , cab_cvs   = cvs-                        , cab_roles = roles } = coAxiomNthBranch con ind-       ; unless (cos `equalLength` (ktvs ++ cvs)) $-           bad_ax (text "lengths")-       ; cos' <- mapM lintCoercion cos-       ; subst <- getSubst-       ; let empty_subst = zapSubst subst-       ; _ <- foldlM check_ki (empty_subst, empty_subst)-                              (zip3 (ktvs ++ cvs) roles cos')-       ; let fam_tc = coAxiomTyCon con-       ; case checkAxInstCo co of-           Just bad_branch -> bad_ax $ text "inconsistent with" <+>-                                       pprCoAxBranch fam_tc bad_branch-           Nothing -> return ()-       ; return (AxiomInstCo con ind cos') }+lintCoercion this_co@(AxiomCo ax cos)+  = do { cos' <- mapM lintCoercion cos+       ; let arg_kinds :: [Pair Type] = map coercionKind cos'+       ; lint_roles 0 (coAxiomRuleArgRoles ax) cos'+       ; lint_ax ax arg_kinds+       ; return (AxiomCo ax cos') }   where-    bad_ax what = addErrL (hang (text  "Bad axiom application" <+> parens what)-                        2 (ppr co))+    lint_ax :: CoAxiomRule -> [Pair Type] -> LintM ()+    lint_ax (BuiltInFamRew  bif) prs+      = checkL (isJust (bifrw_proves bif prs))  bad_bif+    lint_ax (BuiltInFamInj bif) prs+      = checkL (case prs of+                  [pr] -> isJust (bifinj_proves bif pr)+                  _    -> False)+               bad_bif+    lint_ax (UnbranchedAxiom ax) prs+      = lintBranch this_co (coAxiomTyCon ax) (coAxiomSingleBranch ax) prs+    lint_ax (BranchedAxiom ax ind) prs+      = do { checkL (0 <= ind && ind < numBranches (coAxiomBranches ax))+                    (bad_ax this_co (text "index out of range"))+           ; lintBranch this_co (coAxiomTyCon ax) (coAxiomNthBranch ax ind) prs } -    check_ki (subst_l, subst_r) (ktv, role, arg')-      = do { let Pair s' t' = coercionKind arg'-                 sk' = typeKind s'-                 tk' = typeKind t'-           ; lintRole arg' role (coercionRole arg')-           ; let ktv_kind_l = substTy subst_l (tyVarKind ktv)-                 ktv_kind_r = substTy subst_r (tyVarKind ktv)-           ; unless (sk' `eqType` ktv_kind_l)-                    (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] ))-           ; unless (tk' `eqType` ktv_kind_r)-                    (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] ))-           ; return (extendTCvSubst subst_l ktv s',-                     extendTCvSubst subst_r ktv t') }+    bad_bif = bad_ax this_co (text "Proves returns Nothing") +    err :: forall a. String -> [SDoc] -> LintM a+    err m xs  = failWithL $+                hang (text m) 2 $ vcat (text "Rule:" <+> ppr ax : xs)++    lint_roles n (e : es) (co : cos)+      | e == coercionRole co+      = lint_roles (n+1) es cos+      | otherwise = err "Argument roles mismatch"+                        [ text "In argument:" <+> int (n+1)+                        , text "Expected:" <+> ppr e+                        , text "Found:" <+> ppr (coercionRole co) ]+    lint_roles _ [] []  = return ()+    lint_roles n [] rs  = err "Too many coercion arguments"+                            [ text "Expected:" <+> int n+                            , text "Provided:" <+> int (n + length rs) ]++    lint_roles n es []  = err "Not enough coercion arguments"+                            [ text "Expected:" <+> int (n + length es)+                            , text "Provided:" <+> int n ]++ lintCoercion (KindCo co)   = do { co' <- lintCoercion co        ; return (KindCo co') }@@ -2675,40 +2673,14 @@        ; lintRole co' Nominal (coercionRole co')        ; return (SubCo co') } -lintCoercion this@(AxiomRuleCo ax cos)-  = do { cos' <- mapM lintCoercion cos-       ; lint_roles 0 (coaxrAsmpRoles ax) cos'-       ; case coaxrProves ax (map coercionKind cos') of-           Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ]-           Just _  -> return (AxiomRuleCo ax cos') }-  where-  err :: forall a. String -> [SDoc] -> LintM a-  err m xs  = failWithL $-              hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs)--  lint_roles n (e : es) (co : cos)-    | e == coercionRole co = lint_roles (n+1) es cos-    | otherwise = err "Argument roles mismatch"-                      [ text "In argument:" <+> int (n+1)-                      , text "Expected:" <+> ppr e-                      , text "Found:" <+> ppr (coercionRole co) ]-  lint_roles _ [] []  = return ()-  lint_roles n [] rs  = err "Too many coercion arguments"-                          [ text "Expected:" <+> int n-                          , text "Provided:" <+> int (n + length rs) ]--  lint_roles n es []  = err "Not enough coercion arguments"-                          [ text "Expected:" <+> int (n + length es)-                          , text "Provided:" <+> int n ]- lintCoercion (HoleCo h)   = do { addErrL $ text "Unfilled coercion hole:" <+> ppr h        ; lintCoercion (CoVarCo (coHoleCoVar h)) }   {--Note [Conflict checking with AxiomInstCo]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Conflict checking for axiom applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following type family and axiom:  type family Equal (a :: k) (b :: k) :: Bool@@ -2736,28 +2708,53 @@ Co_AxiomInstCo rule in the section "Coercion typing". -} --- | Check to make sure that an AxInstCo is internally consistent.+-- | Check to make sure that an axiom application is internally consistent. -- Returns the conflicting branch, if it exists--- See Note [Conflict checking with AxiomInstCo]-checkAxInstCo :: Coercion -> Maybe CoAxBranch+-- Note [Conflict checking for axiom applications]+lintBranch :: Coercion -> TyCon-> CoAxBranch -> [Pair Type] -> LintM () -- defined here to avoid dependencies in GHC.Core.Coercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint-checkAxInstCo (AxiomInstCo ax ind cos)-  = let branch       = coAxiomNthBranch ax ind-        tvs          = coAxBranchTyVars branch-        cvs          = coAxBranchCoVars branch-        incomps      = coAxBranchIncomps branch-        (tys, cotys) = splitAtList tvs (map coercionLKind cos)-        co_args      = map stripCoercionTy cotys-        subst        = zipTvSubst tvs tys `composeTCvSubst`-                       zipCvSubst cvs co_args-        target   = Type.substTys subst (coAxBranchLHS branch)-        in_scope = mkInScopeSet $-                   unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps)-        flattened_target = flattenTys in_scope target in-    check_no_conflict flattened_target incomps+lintBranch this_co fam_tc branch arg_kinds+  | CoAxBranch { cab_tvs = ktvs, cab_cvs = cvs } <- branch+  = do { checkL (arg_kinds `equalLength` (ktvs ++ cvs)) $+                (bad_ax this_co (text "lengths"))++       ; subst <- getSubst+       ; let empty_subst = zapSubst subst+       ; _ <- foldlM check_ki (empty_subst, empty_subst)+                              (zip (ktvs ++ cvs) arg_kinds)++       ; case check_no_conflict flattened_target incomps of+            Nothing -> return ()+            Just bad_branch -> failWithL $ bad_ax this_co $+                               text "inconsistent with" <+>+                                 pprCoAxBranch fam_tc bad_branch }   where+    check_ki (subst_l, subst_r) (ktv, Pair s' t')+      = do { let sk' = typeKind s'+                 tk' = typeKind t'+           ; let ktv_kind_l = substTy subst_l (tyVarKind ktv)+                 ktv_kind_r = substTy subst_r (tyVarKind ktv)+           ; checkL (sk' `eqType` ktv_kind_l)+                    (bad_ax this_co (text "check_ki1" <+> vcat [ ppr this_co, ppr sk', ppr ktv, ppr ktv_kind_l ] ))+           ; checkL (tk' `eqType` ktv_kind_r)+                    (bad_ax this_co (text "check_ki2" <+> vcat [ ppr this_co, ppr tk', ppr ktv, ppr ktv_kind_r ] ))+           ; return (extendTCvSubst subst_l ktv s',+                     extendTCvSubst subst_r ktv t') }++    tvs          = coAxBranchTyVars branch+    cvs          = coAxBranchCoVars branch+    incomps      = coAxBranchIncomps branch+    (tys, cotys) = splitAtList tvs (map pFst arg_kinds)+    co_args      = map stripCoercionTy cotys+    subst        = zipTvSubst tvs tys `composeTCvSubst`+                   zipCvSubst cvs co_args+    target   = Type.substTys subst (coAxBranchLHS branch)+    in_scope = mkInScopeSet $+               unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps)+    flattened_target = flattenTys in_scope target+     check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch     check_no_conflict _    [] = Nothing     check_no_conflict flat (b@CoAxBranch { cab_lhs = lhs_incomp } : rest)@@ -2766,9 +2763,12 @@       = check_no_conflict flat rest       | otherwise       = Just b-checkAxInstCo _ = Nothing +bad_ax :: Coercion -> SDoc -> SDoc+bad_ax this_co what+    = hang (text "Bad axiom application" <+> parens what) 2 (ppr this_co) + {- ************************************************************************ *                                                                      *@@ -2800,7 +2800,7 @@      extra_checks       | isNewTyCon tc-      = do { CoAxBranch { cab_tvs     = tvs+      = do { CoAxBranch { cab_tvs     = ax_tvs                         , cab_eta_tvs = eta_tvs                         , cab_cvs     = cvs                         , cab_roles   = roles@@ -2808,14 +2808,10 @@               <- case branch_list of                [branch] -> return branch                _        -> failWithL (text "multi-branch axiom with newtype")-           ; let ax_lhs = mkInfForAllTys tvs $-                          mkTyConApp tc lhs_tys-                 nt_tvs = takeList tvs (tyConTyVars tc)-                    -- axiom may be eta-reduced: Note [Newtype eta] in GHC.Core.TyCon-                 nt_lhs = mkInfForAllTys nt_tvs $-                          mkTyConApp tc (mkTyVarTys nt_tvs)-                 -- See Note [Newtype eta] in GHC.Core.TyCon-           ; lintL (ax_lhs `eqType` nt_lhs)++           -- The LHS of the axiom is (N lhs_tys)+           -- We expect it to be      (N ax_tvs)+           ; lintL (mkTyVarTys ax_tvs `eqTypes` lhs_tys)                    (text "Newtype axiom LHS does not match newtype definition")            ; lintL (null cvs)                    (text "Newtype axiom binds coercion variables")@@ -2824,7 +2820,7 @@                    (text "Newtype axiom has eta-tvs")            ; lintL (ax_role == Representational)                    (text "Newtype axiom role not representational")-           ; lintL (roles `equalLength` tvs)+           ; lintL (roles `equalLength` ax_tvs)                    (text "Newtype axiom roles list is the wrong length." $$                     text "roles:" <+> sep (map ppr roles))            ; lintL (roles == takeList roles (tyConRoles tc))@@ -3091,84 +3087,106 @@  Note [Linting linearity] ~~~~~~~~~~~~~~~~~~~~~~~~-Core understands linear types: linearity is checked with the flag-`-dlinear-core-lint`. Why not make `-dcore-lint` check linearity?  Because-optimisation passes are not (yet) guaranteed to maintain linearity.  They should-do so semantically (GHC is careful not to duplicate computation) but it is much-harder to ensure that the statically-checkable constraints of Linear Core are-maintained. The current Linear Core is described in the wiki at:+Lint ignores linearity unless `-dlinear-core-lint` is set.  For why, see below.++But first, "ignore linearity" specifically means two things. When ignoring linearity:+* In `ensureEqTypes`, use `eqTypeIgnoringMultiplicity`+* In `ensureSubMult`, do nothing++But why make `-dcore-lint` ignore linearity?  Because optimisation passes are+not (yet) guaranteed to maintain linearity.  They should do so semantically (GHC+is careful not to duplicate computation) but it is much harder to ensure that+the statically-checkable constraints of Linear Core are maintained. The current+Linear Core is described in the wiki at: https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation. -Why don't the optimisation passes maintain the static types of Linear Core?-Because doing so would cripple some important optimisations.  Here is an-example:+Here are some examples of how the optimiser can break linearity checking.  Other+examples are documented in the linear-type implementation wiki page+[https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation#core-to-core-passes] -  data T = MkT {-# UNPACK #-} !Int+* EXAMPLE 1: the binder swap transformation+    Consider -The wrapper for MkT is+      data T = MkT {-# UNPACK #-} !Int -  $wMkT :: Int %1 -> T-  $wMkT n = case %1 n of-    I# n' -> MkT n'+    The wrapper for MkT is -This introduces, in particular, a `case %1` (this is not actual Haskell or Core-syntax), where the `%1` means that the `case` expression consumes its scrutinee-linearly.+      $wMkT :: Int %1 -> T+      $wMkT n = case %1 n of+        I# n' -> MkT n' -Now, `case %1` interacts with the binder swap optimisation in a non-trivial-way. Take a slightly modified version of the code for $wMkT:+    This introduces, in particular, a `case %1` (this is not actual Haskell or+    Core syntax), where the `%1` means that the `case` expression consumes its+    scrutinee linearly. -  case %1 x of z {-    I# n' -> (x, n')-  }+    Now, `case %1` interacts with the binder swap optimisation in a non-trivial+    way. Take a slightly modified version of the code for $wMkT: -Binder-swap wants to change this to+      case %1 x of z {+        I# n' -> (x, n')+      } -  case %1 x of z {-    I# n' -> let x = z in (x, n')-  }+    Binder-swap changes this to -Now, this is not something that a linear type checker usually considers-well-typed. It is not something that `-dlinear-core-lint` considers to be-well-typed either. But it's only because `-dlinear-core-lint` is not good-enough. However, making `-dlinear-core-lint` recognise this expression as valid-is not obvious. There are many such interactions between a linear type system-and GHC optimisations documented in the linear-type implementation wiki page-[https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation#core-to-core-passes].+      case %1 x of z {+        I# n' -> let x = z in (x, n')+      } -PRINCIPLE: The type system bends to the optimisation, not the other way around.+    This is rejected by `-dlinear-core-lint` because 1/ n' must be used linearly+    2/ `-dlinear-core-lint` recognises a use of `z` as a use of `n'`. So it sees+    two uses of n' where there should be a single one. -In the original linear-types implementation, we had tried to make every-optimisation pass produce code that passes `-dlinear-core-lint`. It had proved-very difficult. And we kept finding corner case after corner case.  Plus, we-used to restrict transformations when `-dlinear-core-lint` couldn't typecheck-the result. There are still occurrences of such restrictions in the code. But-our current stance is that such restrictions can be removed.+* EXAMPLE 2: letrec+    Some optimisations can create a letrec which uses a variable+    linearly, e.g. -For instance, some optimisations can create a letrec which uses a variable-linearly, e.g.+      letrec f True = f False+             f False = x+      in f True -  letrec f True = f False-         f False = x-  in f True+    uses 'x' linearly, but this is not seen by the linter, which considers,+    conservatively, that a letrec always has multiplicity Many (in particular+    that every captured free variable must have multiplicity Many). This issue+    is discussed in ticket #18694. -uses 'x' linearly, but this is not seen by the linter. This issue is discussed-in  ticket #18694.+* EXAMPLE 3: rewrite rules+    Ignoring linearity means in particular that `a -> b` and `a %1 -> b` must be+    treated the same by rewrite rules (see also Note [Rewrite rules ignore+    multiplicities in FunTy] in GHC.Core.Unify). Consider -Plus in many cases, in order to make a transformation compatible with linear-linting, we ended up restricting to avoid producing patterns that were not-recognised as linear by the linter. This violates the above principle.+      m :: Bool -> A+      m' :: (Bool -> Bool) -> A+      {- RULES "ex" forall f. m (f True) = m' f -} +      f :: Bool %1 -> A+      x = m (f True)++    The rule "ex" must match . So the linter must accept `m' f`.++* EXAMPLE 4: eta-reduction+   Eta-expansion can change linear functions into unrestricted functions++     f :: A %1 -> B++     g :: A %Many -> B+     g = \x -> f x++   Eta-reduction undoes this and produces:++     g :: A %Many -> B+     g = f++Historical note: In the original linear-types implementation, we had tried to+make every optimisation pass produce code that passes `-dlinear-core-lint`. It+had proved very difficult. We kept finding corner case after corner+case. Furthermore, to attempt to achieve that goal we ended up restricting+transformations when `-dlinear-core-lint` couldn't typecheck the result.+ In the future, we may be able to lint the linearity of the output of-Core-to-Core passes (#19165). But right now, we can't. Therefore, in virtue of-the principle above, after the desguarer, the optimiser should take no special-pains to preserve linearity (in the type system sense).+Core-to-Core passes (#19165). But this shouldn't be done at the expense of+producing efficient code. Therefore we lay the following principle. -In general the optimiser tries hard not to lose sharing, so it probably doesn't-actually make linear things non-linear. We postulate that any program-transformation which breaks linearity would negatively impact performance, and-therefore wouldn't be suitable for an optimiser. An alternative to linting-linearity after each pass is to prove this statement.+PRINCIPLE: The type system bends to the optimisation, not the other way around.  There is a useful discussion at https://gitlab.haskell.org/ghc/ghc/-/issues/22123 @@ -3476,8 +3494,26 @@ -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied-ensureEqTys ty1 ty2 msg = lintL (ty1 `eqType` ty2) msg+{-# INLINE ensureEqTys #-} -- See Note [INLINE ensureEqTys]+ensureEqTys ty1 ty2 msg+  = do { flags <- getLintFlags+       ; lintL (eq_type flags ty1 ty2) msg } +eq_type :: LintFlags -> Type -> Type -> Bool+-- When `-dlinear-core-lint` is off, then consider `a -> b` and `a %1 -> b` to+-- be equal. See Note [Linting linearity].+eq_type flags ty1 ty2 | lf_check_linearity flags = eqType                     ty1 ty2+                      | otherwise                = eqTypeIgnoringMultiplicity ty1 ty2++{- Note [INLINE ensureEqTys]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To make Lint fast, we want to avoid allocating a thunk for <msg> in+      ensureEqTypes ty1 ty2 <msg>+because the test almost always succeeds, and <msg> isn't needed.+So we INLINE `ensureEqTys`.  This actually make a difference of+1-2% when compiling programs with -dcore-lint.+-}+ ensureSubUsage :: Usage -> Mult -> SDoc -> LintM () ensureSubUsage Bottom     _              _ = return () ensureSubUsage Zero       described_mult err_msg = ensureSubMult ManyTy described_mult err_msg@@ -3757,17 +3793,6 @@     from_msg     = text "From-" <> co_msg     enclosed_msg = text "enclosed" <+> text thing_str -mkBadUnivCoMsg :: LeftOrRight -> Coercion -> SDoc-mkBadUnivCoMsg lr co-  = text "Kind mismatch on the" <+> pprLeftOrRight lr <+>-    text "side of a UnivCo:" <+> ppr co--mkBadProofIrrelMsg :: Type -> Coercion -> SDoc-mkBadProofIrrelMsg ty co-  = hang (text "Found a non-coercion in a proof-irrelevance UnivCo:")-       2 (vcat [ text "type:" <+> ppr ty-               , text "co:" <+> ppr co ])- mkBadTyVarMsg :: Var -> SDoc mkBadTyVarMsg tv   = text "Non-tyvar used in TyVarTy:"@@ -3831,10 +3856,6 @@          , text "Var:" <+> ppr bndr          , text "Join arity:" <+> ppr join_arity          , text "Rule:" <+> ppr rule ]--pprLeftOrRight :: LeftOrRight -> SDoc-pprLeftOrRight CLeft  = text "left"-pprLeftOrRight CRight = text "right"  dupVars :: [NonEmpty Var] -> SDoc dupVars vars
compiler/GHC/Core/Make.hs view
@@ -67,9 +67,10 @@ 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/Map/Expr.hs view
@@ -40,6 +40,7 @@ import qualified Data.Map    as Map import GHC.Types.Name.Env import Control.Monad( (>=>) )+import GHC.Types.Literal (Literal)  {- This module implements TrieMaps over Core related data structures@@ -127,6 +128,8 @@ -- but it is strictly internal to this module.  If you are including a 'CoreMap' -- inside another 'TrieMap', this is the type you want. type CoreMapG = GenMap CoreMapX++type LiteralMap  a = Map.Map Literal a  -- | @CoreMapX a@ is the base map from @DeBruijn CoreExpr@ to @a@, but without -- the 'GenMap' optimization.
compiler/GHC/Core/Map/Type.hs view
@@ -38,6 +38,7 @@ import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Rep+import GHC.Core.TyCon( isForgetfulSynTyCon ) import GHC.Core.TyCo.Compare( eqForAllVis ) import GHC.Data.TrieMap @@ -228,10 +229,11 @@     andEq TEQX e = hasCast e     andEq TEQ  e = e -    -- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare-    go (D _ (TyConApp tc1 [])) (D _ (TyConApp tc2 []))-      | tc1 == tc2-      = TEQ+    -- See Note [Comparing type synonyms] in GHC.Core.TyCo.Compare+    go (D env1 (TyConApp tc1 tys1)) (D env2 (TyConApp tc2 tys2))+      | tc1 == tc2, not (isForgetfulSynTyCon tc1)+      = gos env1 env2 tys1 tys2+     go env_t@(D env t) env_t'@(D env' t')       | Just new_t  <- coreView t  = go (D env new_t) env_t'       | Just new_t' <- coreView t' = go env_t (D env' new_t')
compiler/GHC/Core/Multiplicity.hs view
@@ -30,7 +30,9 @@   , IsSubmult(..)   , submult   , mapScaledType-  , pprArrowWithMultiplicity ) where+  , pprArrowWithMultiplicity+  , MultiplicityFlag(..)+  ) where  import GHC.Prelude @@ -395,3 +397,8 @@   | otherwise   = ppr (funTyFlagTyCon af) +-- | In Core, without `-dlinear-core-lint`, some function must ignore+-- multiplicities. See Note [Linting linearity] in GHC.Core.Lint.+data MultiplicityFlag+  = RespectMultiplicities+  | IgnoreMultiplicities
compiler/GHC/Core/Opt/Arity.hs view
@@ -54,7 +54,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon     ( tyConArity ) import GHC.Core.TyCon.RecWalk     ( initRecTc, checkRecTc )-import GHC.Core.Predicate ( isDictTy, isEvVar, isCallStackPredTy )+import GHC.Core.Predicate ( isDictTy, isEvVar, isCallStackPredTy, isCallStackTy ) import GHC.Core.Multiplicity  -- We have two sorts of substitution:@@ -1420,6 +1420,16 @@ We really want to eta-expand this!  #20103 is quite convincing! We do this regardless of -fdicts-cheap; it's not really a dictionary. +We also want to check both for (IP blah CallStack) and for CallStack itself.+We might have either+   d :: IP blah CallStack    -- Or HasCallStack+   d = (cs-expr :: CallStack) |> (nt-ax :: CallStack ~ IP blah CallStack)+or just+   cs :: CallStack+   cs = cs-expr++Test T20103 is an example of the latter.+ Note [Eta expanding through dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the experimental -fdicts-cheap flag is on, we eta-expand through@@ -1519,7 +1529,7 @@     cheap_dict = case mb_ty of                      Nothing -> False                      Just ty -> (ao_dicts_cheap opts && isDictTy ty)-                                || isCallStackPredTy ty+                                || isCallStackPredTy ty || isCallStackTy ty         -- See Note [Eta expanding through dictionaries]         -- See Note [Eta expanding through CallStacks] @@ -2497,14 +2507,6 @@ And here are a few more technical criteria for when it is *not* sound to eta-reduce that are specific to Core and GHC: -(L) With linear types, eta-reduction can break type-checking:-      f :: A ⊸ B-      g :: A -> B-      g = \x. f x-    The above is correct, but eta-reducing g would yield g=f, the linter will-    complain that g and f don't have the same type. NB: Not unsound in the-    dynamic semantics, but unsound according to the static semantics of Core.- (J) We may not undersaturate join points.     See Note [Invariants on join points] in GHC.Core, and #20599. @@ -2764,7 +2766,7 @@       | fun `elemUnVarSet` rec_ids          -- Criterion (R)       = False -- Don't eta-reduce in fun in its own recursive RHSs -      | cantEtaReduceFun fun                -- Criteria (L), (J), (W), (B)+      | cantEtaReduceFun fun                -- Criteria (J), (W), (B)       = False -- Function can't be eta reduced to arity 0               -- without violating invariants of Core and GHC @@ -2834,7 +2836,7 @@     ok_arg _ _ _ _ = Nothing  -- | Can we eta-reduce the given function--- See Note [Eta reduction soundness], criteria (B), (J), (W) and (L).+-- See Note [Eta reduction soundness], criteria (B), (J), and (W). cantEtaReduceFun :: Id -> Bool cantEtaReduceFun fun   =    hasNoBinding fun -- (B)@@ -2848,12 +2850,7 @@        -- Don't undersaturate StrictWorkerIds.        -- See Note [CBV Function Ids] in GHC.Types.Id.Info. -    ||  isLinearType (idType fun) -- (L)-       -- Don't perform eta reduction on linear types.-       -- If `f :: A %1-> B` and `g :: A -> B`,-       -- then `g x = f x` is OK but `g = f` is not. - {- ********************************************************************* *                                                                      *               The "push rules"@@ -3023,7 +3020,7 @@     | otherwise     = Nothing -pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion+pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion               -> Maybe (DataCon                        , [Type]      -- Universal type args                        , [CoreExpr]) -- All other args incl existentials@@ -3033,11 +3030,21 @@ -- where co :: (T t1 .. tn) ~ to_ty -- The left-hand one must be a T, because exprIsConApp returned True -- but the right-hand one might not be.  (Though it usually will.)-pushCoDataCon dc dc_args co-  | isReflCo co || from_ty `eqType` to_ty  -- try cheap test first-  , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args-  = Just (dc, map exprToType univ_ty_args, rest_args)+pushCoDataCon dc dc_args MRefl    = Just $! (push_dc_refl dc dc_args)+pushCoDataCon dc dc_args (MCo co) = push_dc_gen  dc dc_args co (coercionKind co) +push_dc_refl :: DataCon -> [CoreExpr] -> (DataCon, [Type], [CoreExpr])+push_dc_refl dc dc_args+  = (dc, map exprToType univ_ty_args, rest_args)+  where+    !(univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args++push_dc_gen :: DataCon -> [CoreExpr] -> Coercion -> Pair Type+            -> Maybe (DataCon, [Type], [CoreExpr])+push_dc_gen dc dc_args co (Pair from_ty to_ty)+  | from_ty `eqType` to_ty  -- try cheap test first+  = Just $! (push_dc_refl dc dc_args)+   | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty   , to_tc == dataConTyCon dc         -- These two tests can fail; we might see@@ -3082,8 +3089,6 @@   | otherwise   = Nothing -  where-    Pair from_ty to_ty = coercionKind co  collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible
compiler/GHC/Core/Opt/CallerCC/Types.hs view
@@ -61,14 +61,14 @@ type Parser = P.ReadP  parseNamePattern :: Parser NamePattern-parseNamePattern = pattern+parseNamePattern = namePattern   where-    pattern = star P.<++ wildcard P.<++ char P.<++ end-    star = PChar '*' <$ P.string "\\*" <*> pattern+    namePattern = star P.<++ wildcard P.<++ char P.<++ end+    star = PChar '*' <$ P.string "\\*" <*> namePattern     wildcard = do       void $ P.char '*'-      PWildcard <$> pattern-    char = PChar <$> P.get <*> pattern+      PWildcard <$> namePattern+    char = PChar <$> P.get <*> namePattern     end = PEnd <$ P.eof  data CallerCcFilter
compiler/GHC/Core/Opt/ConstantFold.hs view
@@ -855,7 +855,6 @@     AddrAddOp  -> mkPrimOpRule nm 2 [ rightIdentityPlatform zeroi ] -   SeqOp      -> mkPrimOpRule nm 4 [ seqRule ]    SparkOp    -> mkPrimOpRule nm 4 [ sparkRule ]     _          -> Nothing@@ -2068,75 +2067,18 @@  {- ********************************************************************* *                                                                      *-             Rules for seq# and spark#+             Rules for spark# *                                                                      * ********************************************************************* -} -{- Note [seq# magic]-~~~~~~~~~~~~~~~~~~~~-The primop-   seq# :: forall a s . a -> State# s -> (# State# s, a #)--is /not/ the same as the Prelude function seq :: a -> b -> b-as you can see from its type.  In fact, seq# is the implementation-mechanism for 'evaluate'--   evaluate :: a -> IO a-   evaluate a = IO $ \s -> seq# a s--The semantics of seq# is-  * evaluate its first argument-  * and return it--Things to note--* Why do we need a primop at all?  That is, instead of-      case seq# x s of (# x, s #) -> blah-  why not instead say this?-      case x of { DEFAULT -> blah }--  Reason (see #5129): if we saw-    catch# (\s -> case x of { DEFAULT -> raiseIO# exn s }) handler--  then we'd drop the 'case x' because the body of the case is bottom-  anyway. But we don't want to do that; the whole /point/ of-  seq#/evaluate is to evaluate 'x' first in the IO monad.--  In short, we /always/ evaluate the first argument and never-  just discard it.--* Why return the value?  So that we can control sharing of seq'd-  values: in-     let x = e in x `seq` ... x ...-  We don't want to inline x, so better to represent it as-       let x = e in case seq# x RW of (# _, x' #) -> ... x' ...-  also it matches the type of rseq in the Eval monad.--Implementing seq#.  The compiler has magic for SeqOp in--- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# <whnf> s)--- GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq#--- Simplify.addEvals records evaluated-ness for the result; see-  Note [Adding evaluatedness info to pattern-bound variables]-  in GHC.Core.Opt.Simplify.Iteration--- Likewise, GHC.Stg.InferTags.inferTagExpr knows that seq# returns a-  properly-tagged pointer inside of its unboxed-tuple result.--}--seqRule :: RuleM CoreExpr-seqRule = do+-- spark# :: forall a s . a -> State# s -> (# State# s, a #)+sparkRule :: RuleM CoreExpr+sparkRule = do -- reduce on HNF   [Type _ty_a, Type _ty_s, a, s] <- getArgs   guard $ exprIsHNF a   return $ mkCoreUnboxedTuple [s, a]---- spark# :: forall a s . a -> State# s -> (# State# s, a #)-sparkRule :: RuleM CoreExpr-sparkRule = seqRule -- reduce on HNF, just the same-  -- XXX perhaps we shouldn't do this, because a spark eliminated by-  -- this rule won't be counted as a dud at runtime?+    -- XXX perhaps we shouldn't do this, because a spark eliminated by+    -- this rule won't be counted as a dud at runtime?  {- ************************************************************************@@ -3114,6 +3056,11 @@     -- (l1 or x) and (l2 or y) ==> (l1 and l2) or (x and l2) or (l1 and y) or (x and y)     -- increase operation numbers +    -- x and (y or ... or x or ... or z) ==> x+    (x, is_or_list num_ops -> Just xs)+      | any (cheapEqExpr x) xs+      -> Just x+     _ -> Nothing     where       mkL = Lit . mkNumLiteral platform num_ops@@ -3137,6 +3084,11 @@     -- (l1 and x) or (l2 and y) ==> (l1 and l2) or (x and l2) or (l1 and y) or (x and y)     -- increase operation numbers +    -- x or (y and ... and x and ... and z) ==> x+    (x, is_and_list num_ops -> Just xs)+      | any (cheapEqExpr x) xs+      -> Just x+     _ -> Nothing     where       mkL = Lit . mkNumLiteral platform num_ops@@ -3175,7 +3127,7 @@  App (OpVal op') x | op == op' -> Just x  _                             -> Nothing -is_add, is_sub, is_mul, is_and, is_or, is_div :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)+is_add, is_sub, is_mul, is_and, is_or, is_div :: NumOps -> CoreExpr -> Maybe (CoreArg, CoreArg) is_add num_ops e = is_binop (numAdd num_ops) e is_sub num_ops e = is_binop (numSub num_ops) e is_mul num_ops e = is_binop (numMul num_ops) e@@ -3185,6 +3137,25 @@  is_neg :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr) is_neg num_ops e = numNeg num_ops >>= \op -> is_op op e++-- Return a list of operands for a given operation.+-- E.e. is_and_list (a and ... and z) => [a,...,z] for any nesting of the and+-- operation+is_list :: (CoreExpr -> Maybe (CoreArg,CoreArg)) -> CoreExpr -> Maybe [CoreArg]+is_list f e_org = case f e_org of -- do we have the operator at all?+  Just (a,b) -> Just (go [a,b])+  Nothing    -> Nothing+  where+    go = \case+      []     -> []+      (e:es) -> case f e of+        -- we can't split any more: add to the result list+        Nothing    -> e : go es+        Just (a,b) -> go (a:b:es)++is_and_list, is_or_list :: NumOps -> CoreExpr -> Maybe [CoreArg]+is_and_list ops = is_list (is_and ops)+is_or_list  ops = is_list (is_or  ops)  -- match operation with a literal (handles commutativity) is_lit_add, is_lit_mul, is_lit_and, is_lit_or :: NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr)
compiler/GHC/Core/Opt/Monad.hs view
@@ -73,23 +73,27 @@ import Control.Monad import Control.Applicative ( Alternative(..) ) -data FloatOutSwitches = FloatOutSwitches {-  floatOutLambdas   :: Maybe Int,  -- ^ Just n <=> float lambdas to top level, if-                                   -- doing so will abstract over n or fewer-                                   -- value variables-                                   -- Nothing <=> float all lambdas to top level,-                                   --             regardless of how many free variables-                                   -- Just 0 is the vanilla case: float a lambda-                                   --    iff it has no free vars+data FloatOutSwitches = FloatOutSwitches+  { floatOutLambdas   :: Maybe Int  -- ^ Just n <=> float lambdas to top level, if+                                    -- doing so will abstract over n or fewer+                                    -- value variables+                                    -- Nothing <=> float all lambdas to top level,+                                    --             regardless of how many free variables+                                    -- Just 0 is the vanilla case: float a lambda+                                    --    iff it has no free vars -  floatOutConstants :: Bool,       -- ^ True <=> float constants to top level,-                                   --            even if they do not escape a lambda-  floatOutOverSatApps :: Bool,-                             -- ^ True <=> float out over-saturated applications-                             --            based on arity information.-                             -- See Note [Floating over-saturated applications]-                             -- in GHC.Core.Opt.SetLevels-  floatToTopLevelOnly :: Bool      -- ^ Allow floating to the top level only.+  , floatOutConstants :: Bool       -- ^ True <=> float constants to top level,+                                    --            even if they do not escape a lambda++  , floatOutOverSatApps :: Bool     -- ^ True <=> float out over-saturated applications+                                    --            based on arity information.+                                    -- See Note [Floating over-saturated applications]+                                    -- in GHC.Core.Opt.SetLevels+  , floatToTopLevelOnly :: Bool     -- ^ Allow floating to the top level only.++  , floatJoinsToTop :: Bool         -- ^ Float join points to top level if possible+                                    -- See Note [Floating join point bindings]+                                    --     in GHC.Core.Opt.SetLevels   } instance Outputable FloatOutSwitches where     ppr = pprFloatOutSwitches@@ -100,6 +104,7 @@      sep $ punctuate comma $      [ text "Lam ="    <+> ppr (floatOutLambdas sw)      , text "Consts =" <+> ppr (floatOutConstants sw)+     , text "JoinsToTop =" <+> ppr (floatJoinsToTop sw)      , text "OverSatApps ="   <+> ppr (floatOutOverSatApps sw) ])  {-
compiler/GHC/Core/Opt/OccurAnal.hs view
@@ -26,7 +26,7 @@ module GHC.Core.Opt.OccurAnal (     occurAnalysePgm,     occurAnalyseExpr,-    zapLambdaBndrs, scrutBinderSwap_maybe+    zapLambdaBndrs, BinderSwapDecision(..), scrutOkForBinderSwap   ) where  import GHC.Prelude hiding ( head, init, last, tail )@@ -55,7 +55,7 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Var-import GHC.Types.Demand ( argOneShots, argsOneShots )+import GHC.Types.Demand ( argOneShots, argsOneShots, isDeadEndSig )  import GHC.Utils.Outputable import GHC.Utils.Panic@@ -983,7 +983,7 @@   | mb_join@(JoinPoint {}) <- idJoinPointHood bndr   = -- Analyse the RHS and /then/ the body     let -- Analyse the rhs first, generating rhs_uds-        !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs+        !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs         rhs_uds = foldr1 orUDs rhs_uds_s   -- NB: orUDs.  See (W4) of                                            -- Note [Occurrence analysis for join points] @@ -1009,7 +1009,7 @@         -- => join arity O of Note [Join arity prediction based on joinRhsArity]         (tagged_bndr, mb_join) = tagNonRecBinder lvl occ bndr -        !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs+        !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env lvl ire mb_join tagged_bndr rhs     in WUD (foldr andUDs body_uds rhs_uds_s)      -- Note `andUDs`            (combine [NonRec final_bndr rhs'] body) @@ -1024,10 +1024,10 @@     in WUD inner_uds (occ, res)  ------------------occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> JoinPointHood-                 -> Id -> CoreExpr+occAnalNonRecRhs :: OccEnv -> TopLevelFlag -> ImpRuleEdges+                -> JoinPointHood -> Id -> CoreExpr                  -> ([UsageDetails], Id, CoreExpr)-occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs+occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs   | null rules, null imp_rule_infos   =  -- Fast path for common case of no rules. This is only worth      -- 0.1% perf on average, but it's also only a line or two of code@@ -1043,7 +1043,7 @@     -- That's that OccRhs would do; but there's no point because     -- j will never be scrutinised.     rhs_env  = mkRhsOccEnv env NonRecursive rhs_ctxt mb_join bndr rhs-    rhs_ctxt = mkNonRecRhsCtxt bndr unf+    rhs_ctxt = mkNonRecRhsCtxt lvl bndr unf      -- See Note [Join arity prediction based on joinRhsArity]     -- Match join arity O from mb_join_arity with manifest join arity M as@@ -1086,9 +1086,9 @@                    [ l `andUDs` adjustTailArity mb_join r                    | (_,l,r) <- rules_w_uds ] -mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl+mkNonRecRhsCtxt :: TopLevelFlag -> Id -> Unfolding -> OccEncl -- Precondition: Id is not a join point-mkNonRecRhsCtxt bndr unf+mkNonRecRhsCtxt lvl bndr unf   | certainly_inline = OccVanilla -- See Note [Cascading inlines]   | otherwise        = OccRhs   where@@ -1097,11 +1097,12 @@         -- has set the OccInfo for this binder before calling occAnalNonRecRhs         case idOccInfo bndr of           OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 }-            -> active && not_stable+            -> active && not stable_unf && not top_bottoming           _ -> False      active     = isAlwaysActive (idInlineActivation bndr)-    not_stable = not (isStableUnfolding unf)+    stable_unf = isStableUnfolding unf+    top_bottoming = isTopLevel lvl && isDeadEndId bndr  ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)]@@ -2405,7 +2406,7 @@  This is worse than the slow cascade, so we only want to say "certainly_inline" if it really is certain.  Look at the note with preInlineUnconditionally-for the various clauses.+for the various clauses.  See #24582 for an example of the two getting out of sync.   ************************************************************************@@ -2574,8 +2575,13 @@ occAnalArgs !env fun args !one_shots   = go emptyDetails fun args one_shots   where-    env_args = setNonTailCtxt OccVanilla env+    env_args = setNonTailCtxt encl env +    -- Make bottoming functions interesting+    -- See Note [Bottoming function calls]+    encl | Var f <- fun, isDeadEndSig (idDmdSig f) = OccScrut+         | otherwise                               = OccVanilla+     go uds fun [] _ = WUD uds fun     go uds fun (arg:args) one_shots       = go (uds `andUDs` arg_uds) (fun `App` arg') args one_shots'@@ -2593,6 +2599,22 @@ Applications are dealt with specially because we want the "build hack" to work. +Note [Bottoming function calls]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   let x = (a,b) in+   case p of+      A -> ...(error x)..+      B -> ...(ertor x)...++postInlineUnconditionally may duplicate x's binding, but sometimes it+does so only if the use site IsInteresting.  Pushing allocation into error+branches is good, so we try to make bottoming calls look interesting, by+setting occ_encl = OccScrut for such calls.++The slightly-artificial test T21128 is a good example.  It's probably+not a huge deal.+ Note [Arguments of let-bound constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider@@ -3318,7 +3340,7 @@  Note [Care with binder-swap on dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-This Note explains why we need isDictId in scrutBinderSwap_maybe.+This Note explains why we need isDictId in scrutOkForBinderSwap. Consider this tricky example (#21229, #21470):    class Sing (b :: Bool) where sing :: Bool@@ -3362,7 +3384,7 @@   for a /dictionary variable/ do not perform   the clever cast version of the binder-swap -Hence the subtle isDictId in scrutBinderSwap_maybe.+Hence the subtle isDictId in scrutOkForBinderSwap.  Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -3384,7 +3406,7 @@ -- See Note [The binder-swap substitution] addBndrSwap scrut case_bndr             env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars })-  | Just (scrut_var, mco) <- scrutBinderSwap_maybe scrut+  | DoBinderSwap scrut_var mco <- scrutOkForBinderSwap scrut   , scrut_var /= case_bndr       -- Consider: case x of x { ... }       -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop@@ -3398,25 +3420,30 @@     case_bndr' = zapIdOccInfo case_bndr                  -- See Note [Zap case binders in proxy bindings] -scrutBinderSwap_maybe :: OutExpr -> Maybe (OutVar, MCoercion)--- If (scrutBinderSwap_maybe e = Just (v, mco), then+-- | See bBinderSwaOk.+data BinderSwapDecision+  = NoBinderSwap+  | DoBinderSwap OutVar MCoercion++scrutOkForBinderSwap :: OutExpr -> BinderSwapDecision+-- If (scrutOkForBinderSwap e = DoBinderSwap v mco, then --    v = e |> mco -- See Note [Case of cast] -- See Note [Care with binder-swap on dictionaries] -- -- We use this same function in SpecConstr, and Simplify.Iteration, -- when something binder-swap-like is happening-scrutBinderSwap_maybe (Var v)    = Just (v, MRefl)-scrutBinderSwap_maybe (Cast (Var v) co)-  | not (isDictId v)             = Just (v, MCo (mkSymCo co))+scrutOkForBinderSwap (Var v)    = DoBinderSwap v MRefl+scrutOkForBinderSwap (Cast (Var v) co)+  | not (isDictId v)             = DoBinderSwap v (MCo (mkSymCo co))         -- Cast: see Note [Case of cast]         -- isDictId: see Note [Care with binder-swap on dictionaries]         -- The isDictId rejects a Constraint/Constraint binder-swap, perhaps         -- over-conservatively. But I have never seen one, so I'm leaving         -- the code as simple as possible. Losing the binder-swap in a         -- rare case probably has very low impact.-scrutBinderSwap_maybe (Tick _ e) = scrutBinderSwap_maybe e  -- Drop ticks-scrutBinderSwap_maybe _          = Nothing+scrutOkForBinderSwap (Tick _ e) = scrutOkForBinderSwap e  -- Drop ticks+scrutOkForBinderSwap _          = NoBinderSwap  lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) -- See Note [The binder-swap substitution]
compiler/GHC/Core/Opt/Simplify.hs view
@@ -17,7 +17,8 @@ import GHC.Core.Utils   ( mkTicks, stripTicksTop ) import GHC.Core.Lint    ( LintPassResultConfig, dumpPassResult, lintPassResult ) import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules )-import GHC.Core.Opt.Simplify.Utils ( activeRule, activeUnfolding )+import GHC.Core.Opt.Simplify.Utils  ( activeRule )+import GHC.Core.Opt.Simplify.Inline ( activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Stats ( simplCountN )@@ -198,7 +199,7 @@                  -- 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/Opt/Simplify/Env.hs view
@@ -17,12 +17,13 @@         seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames,         seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline,         seRuleOpts, seRules, seUnfoldingOpts,-        mkSimplEnv, extendIdSubst,+        mkSimplEnv, extendIdSubst, extendCvIdSubst,         extendTvSubst, extendCvSubst,         zapSubstEnv, setSubstEnv, bumpCaseDepth,         getInScope, setInScopeFromE, setInScopeFromF,         setInScopeSet, modifyInScope, addNewInScopeIds,         getSimplRules, enterRecGroupRHSs,+        reSimplifying,          -- * Substitution results         SimplSR(..), mkContEx, substId, lookupRecBndr,@@ -154,6 +155,17 @@     | Set by user                | SimplMode    | TopEnvConfig    |     | Computed on initialization | SimplEnv     | SimplTopEnv     | +Note [Inline depth]+~~~~~~~~~~~~~~~~~~~+When we inline an /already-simplified/ unfolding, we+* Zap the substitution environment; the inlined thing is an OutExpr+* Bump the seInlineDepth in the SimplEnv+Both these tasks are done in zapSubstEnv.++The seInlineDepth tells us how deep in inlining we are.  Currently,+seInlineDepth is used for just one purpose: when we encounter a+coercion we don't apply optCoercion to it if seInlineDepth>0.+Reason: it has already been optimised once, no point in doing so again. -}  data SimplEnv@@ -183,7 +195,11 @@         -- They are all OutVars, and all bound in this module       , seInScope   :: !InScopeSet       -- OutVars only -      , seCaseDepth :: !Int  -- Depth of multi-branch case alternatives+      , seCaseDepth   :: !Int  -- Depth of multi-branch case alternatives++      , seInlineDepth :: !Int  -- 0 initially, 1 when we inline an already-simplified+                               -- unfolding, and simplify again; and so on+                               -- See Note [Inline depth]     }  seArityOpts :: SimplEnv -> ArityOpts@@ -491,14 +507,15 @@  mkSimplEnv :: SimplMode -> (FamInstEnv, FamInstEnv) -> SimplEnv mkSimplEnv mode fam_envs-  = SimplEnv { seMode      = mode-             , seFamEnvs   = fam_envs-             , seInScope   = init_in_scope-             , seTvSubst   = emptyVarEnv-             , seCvSubst   = emptyVarEnv-             , seIdSubst   = emptyVarEnv-             , seRecIds    = emptyUnVarSet-             , seCaseDepth = 0 }+  = SimplEnv { seMode        = mode+             , seFamEnvs     = fam_envs+             , seInScope     = init_in_scope+             , seTvSubst     = emptyVarEnv+             , seCvSubst     = emptyVarEnv+             , seIdSubst     = emptyVarEnv+             , seRecIds      = emptyUnVarSet+             , seCaseDepth   = 0+             , seInlineDepth = 0 }         -- The top level "enclosing CC" is "SUBSUMED".  init_in_scope :: InScopeSet@@ -534,6 +551,9 @@ bumpCaseDepth :: SimplEnv -> SimplEnv bumpCaseDepth env = env { seCaseDepth = seCaseDepth env + 1 } +reSimplifying :: SimplEnv -> Bool+reSimplifying (SimplEnv { seInlineDepth = n }) = n>0+ --------------------- extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res@@ -550,6 +570,10 @@   = assert (isCoVar var) $     env {seCvSubst = extendVarEnv csubst var co} +extendCvIdSubst :: SimplEnv -> Id -> OutExpr -> SimplEnv+extendCvIdSubst env bndr (Coercion co) = extendCvSubst env bndr co+extendCvIdSubst env bndr rhs           = extendIdSubst env bndr (DoneEx rhs NotJoinPoint)+ --------------------- getInScope :: SimplEnv -> InScopeSet getInScope env = seInScope env@@ -619,7 +643,12 @@  --------------------- zapSubstEnv :: SimplEnv -> SimplEnv-zapSubstEnv env = env {seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}+-- See Note [Inline depth]+-- We call zapSubstEnv precisely when we are about to+-- simplify an already-simplified term+zapSubstEnv env@(SimplEnv { seInlineDepth = n })+  = env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv+        , seInlineDepth = n+1 }  setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }
compiler/GHC/Core/Opt/Simplify/Inline.hs view
@@ -10,7 +10,7 @@ module GHC.Core.Opt.Simplify.Inline (         -- * Cheap and cheerful inlining checks.         couldBeSmallEnoughToInline,-        smallEnoughToInline,+        smallEnoughToInline, activeUnfolding,          -- * The smart inlining decisions are made by callSiteInline         callSiteInline, CallCtxt(..),@@ -20,10 +20,16 @@  import GHC.Driver.Flags +import GHC.Core.Opt.Simplify.Env+ import GHC.Core import GHC.Core.Unfold+import GHC.Core.FVs( exprFreeIds )+ import GHC.Types.Id-import GHC.Types.Basic  ( Arity, RecFlag(..) )+import GHC.Types.Var.Env( InScopeSet, lookupInScope )+import GHC.Types.Var.Set+import GHC.Types.Basic  ( Arity, RecFlag(..), isActive ) import GHC.Utils.Logger import GHC.Utils.Misc import GHC.Utils.Outputable@@ -86,16 +92,14 @@ StrictAnal.addStrictnessInfoToTopId -} -callSiteInline :: Logger-               -> UnfoldingOpts-               -> Int                   -- Case depth+callSiteInline :: SimplEnv+               -> Logger                -> Id                    -- The Id-               -> Bool                  -- True <=> unfolding is active                -> Bool                  -- True if there are no arguments at all (incl type args)                -> [ArgSummary]          -- One for each value arg; True if it is interesting                -> CallCtxt              -- True <=> continuation is interesting                -> Maybe CoreExpr        -- Unfolding, if any-callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_infos cont_info+callSiteInline env logger id lone_variable arg_infos cont_info   = case idUnfolding id of       -- idUnfolding checks for loop-breakers, returning NoUnfolding       -- Things with an INLINE pragma may have an unfolding *and*@@ -103,15 +107,31 @@         CoreUnfolding { uf_tmpl = unf_template                       , uf_cache = unf_cache                       , uf_guidance = guidance }-          | active_unfolding -> tryUnfolding logger opts case_depth id lone_variable+          | active_unf -> tryUnfolding env logger id lone_variable                                     arg_infos cont_info unf_template                                     unf_cache guidance-          | otherwise -> traceInline logger opts id "Inactive unfolding:" (ppr id) Nothing+          | otherwise -> traceInline logger uf_opts id "Inactive unfolding:" (ppr id) Nothing         NoUnfolding      -> Nothing         BootUnfolding    -> Nothing         OtherCon {}      -> Nothing         DFunUnfolding {} -> Nothing     -- Never unfold a DFun+  where+    uf_opts    = seUnfoldingOpts env+    active_unf = activeUnfolding (seMode env) id +activeUnfolding :: SimplMode -> Id -> Bool+activeUnfolding mode id+  | isCompulsoryUnfolding (realIdUnfolding id)+  = True   -- Even sm_inline can't override compulsory unfoldings+  | otherwise+  = isActive (sm_phase mode) (idInlineActivation id)+  && sm_inline mode+      -- `or` isStableUnfolding (realIdUnfolding id)+      -- Inline things when+      --  (a) they are active+      --  (b) sm_inline says so, except that for stable unfoldings+      --                         (ie pragmas) we inline anyway+ -- | Report the inlining of an identifier's RHS to the user, if requested. traceInline :: Logger -> UnfoldingOpts -> Id -> String -> SDoc -> a -> a traceInline logger opts inline_id str doc result@@ -132,8 +152,9 @@  {- Note [Avoid inlining into deeply nested cases]    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Also called "exponential inlining". -Consider a function f like this:+Consider a function f like this: (#18730)    f arg1 arg2 =     case ...@@ -144,46 +165,44 @@ However sometimes this doesn't quite work out like that. Consider this code: -f1 arg1 arg2 ... = ...-    case _foo of-      alt1 -> ... f2 arg1 ...-      alt2 -> ... f2 arg2 ...+    f1 arg1 arg2 ... = ...+        case _foo of+          alt1 -> ... f2 arg1 ...+          alt2 -> ... f2 arg2 ... -f2 arg1 arg2 ... = ...-    case _foo of-      alt1 -> ... f3 arg1 ...-      alt2 -> ... f3 arg2 ...+    f2 arg1 arg2 ... = ...+        case _foo of+          alt1 -> ... f3 arg1 ...+          alt2 -> ... f3 arg2 ... -f3 arg1 arg2 ... = ...+    f3 arg1 arg2 ... = ... -... repeats up to n times. And then f1 is-applied to some arguments:+    ... repeats up to n times. And then f1 is+    applied to some arguments: -foo = ... f1 <interestingArgs> ...+    foo = ... f1 <interestingArgs> ... -Initially f2..fn are not interesting to inline so we don't.-However we see that f1 is applied to interesting args.-So it's an obvious choice to inline those:+Initially f2..fn are not interesting to inline so we don't.  However we see+that f1 is applied to interesting args.  So it's an obvious choice to inline+those: -foo =-    ...-      case _foo of-        alt1 -> ... f2 <interestingArg> ...-        alt2 -> ... f2 <interestingArg> ...+    foo = ...+          case _foo of+            alt1 -> ... f2 <interestingArg> ...+            alt2 -> ... f2 <interestingArg> ... -As a result we go and inline f2 both mentions of f2 in turn are now applied to interesting-arguments and f2 is small:+As a result we go and inline f2 both mentions of f2 in turn are now applied to+interesting arguments and f2 is small: -foo =-    ...-      case _foo of-        alt1 -> ... case _foo of-            alt1 -> ... f3 <interestingArg> ...-            alt2 -> ... f3 <interestingArg> ...+    foo = ...+          case _foo of+            alt1 -> ... case _foo of+                alt1 -> ... f3 <interestingArg> ...+                alt2 -> ... f3 <interestingArg> ... -        alt2 -> ... case _foo of-            alt1 -> ... f3 <interestingArg> ...-            alt2 -> ... f3 <interestingArg> ...+            alt2 -> ... case _foo of+                alt1 -> ... f3 <interestingArg> ...+                alt2 -> ... f3 <interestingArg> ...  The same thing happens for each binding up to f_n, duplicating the amount of inlining done in each step. Until at some point we are either done or run out of simplifier@@ -200,19 +219,73 @@  * We can ignore the first n levels of case nestings for inlining decisions using   -funfolding-case-threshold.-* The penalty grows linear with the depth. It's computed as size*(depth-threshold)/scaling.++* The penalty grows linear with the depth. It's computed as+     size*(depth-threshold)/scaling.   Scaling can be set with -funfolding-case-scaling. +Reflections and wrinkles++* See also Note [Do not add unfoldings to join points at birth] in+  GHC.Core.Opt.Simplify.Iteration++* The total case depth is really the wrong thing; it will inhibit inlining of a+  local function, just because there is some giant case nest further out.  What we+  want is the /difference/ in case-depth between the binding site and the call site.+  That could be done quite easily by adding the case-depth to the Unfolding of the+  function.++* What matters more than /depth/ is total /width/; that is how many alternatives+  are in the tree.  We could perhaps multiply depth by width at each case expression.++* There might be a case nest with many alternatives, but the function is called in+  only a handful of them.  So maybe we should ignore case-depth, and instead penalise+  funtions that are called many times -- after all, inlining them bloats code.++  But in the scenario above, we are simplifying an inlined fuction, without doing a+  global occurrence analysis each time.  So if we based the penalty on multiple+  occurences, we should /also/ add a penalty when simplifying an already-simplified+  expression.  We do track this (seInlineDepth) but currently we barely use it.++  An advantage of using occurrences+inline depth is that it'll work when no+  case expressions are involved.  See #15488.++* Test T18730 did not involve join points.  But join points are very prone to+  the same kind of thing.  For exampe in #13253, and several related tickets,+  we got an exponential blowup in code size from a program that looks like+  this.++  let j1a x = case f y     of { True -> p;   False -> q }+      j1b x = case f y     of { True -> q;   False -> p }+      j2a x = case f (y+1) of { True -> j1a x; False -> j1b x}+      j2b x = case f (y+1) of { True -> j1b x; False -> j1a x}+      ...+  in case f (y+10) of { True -> j10a 7; False -> j10b 8 }++  The first danger is this: in Simplifier iteration 1 postInlineUnconditionally+  inlines the last functions, j10a and j10b (they are both small).  Now we have+  two calls to j9a and two to j9b.  In the next Simplifer iteration,+  postInlineUnconditionally inlines all four of these calls, leaving four calls+  to j8a and j8b. Etc.++  Happily, this probably /won't/ happen because the Simplifier works top down, so it'll+  inline j1a/j1b into j2a/j2b, which will make the latter bigger; so the process+  will stop.  But we still need to stop the inline cascade described at the head+  of this Note.+ Some guidance on setting these defaults:  * A low threshold (<= 2) is needed to prevent exponential cases from spiraling out of   control. We picked 2 for no particular reason.+ * Scaling the penalty by any more than 30 means the reproducer from   T18730 won't compile even with reasonably small values of n. Instead   it will run out of runs/ticks. This means to positively affect the reproducer   a scaling <= 30 is required.+ * A scaling of >= 15 still causes a few very large regressions on some nofib benchmarks.   (+80% for gc/fulsom, +90% for real/ben-raytrace, +20% for spectral/fibheaps)+ * A scaling of >= 25 showed no regressions on nofib. However it showed a number of   (small) regression for compiler perf benchmarks. @@ -221,15 +294,15 @@ will still avoid this pattern sometimes. This is a "safe" default, where we err on the side of compiler blowup instead of risking runtime regressions. -For cases where the default falls short the flag can be changed to allow more/less inlining as-needed on a per-module basis.+For cases where the default falls short the flag can be changed to allow+more/less inlining as needed on a per-module basis.  -} -tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt+tryUnfolding :: SimplEnv -> Logger -> Id -> Bool -> [ArgSummary] -> CallCtxt              -> CoreExpr -> UnfoldingCache -> UnfoldingGuidance              -> Maybe CoreExpr-tryUnfolding logger opts !case_depth id lone_variable arg_infos+tryUnfolding env logger id lone_variable arg_infos              cont_info unf_template unf_cache guidance  = case guidance of      UnfNever -> traceInline logger opts id str (text "UnfNever") Nothing@@ -241,31 +314,53 @@         | otherwise         -> traceInline logger opts id str (mk_doc some_benefit empty False) Nothing         where-          some_benefit = calc_some_benefit uf_arity+          some_benefit = calc_some_benefit uf_arity True           enough_args  = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)       UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }-        | unfoldingVeryAggressive opts-        -> traceInline logger opts id str (mk_doc some_benefit extra_doc True) (Just unf_template)-        | is_wf && some_benefit && small_enough-        -> traceInline logger opts id str (mk_doc some_benefit extra_doc True) (Just unf_template)-        | otherwise-        -> traceInline logger opts id str (mk_doc some_benefit extra_doc False) Nothing+        | isJoinId id, small_enough         -> inline_join_point+        | unfoldingVeryAggressive opts      -> yes+        | is_wf, some_benefit, small_enough -> yes+        | otherwise                         -> no         where-          some_benefit = calc_some_benefit (length arg_discounts)-          -- See Note [Avoid inlining into deeply nested cases]-          depth_treshold = unfoldingCaseThreshold opts-          depth_scaling = unfoldingCaseScaling opts-          depth_penalty | case_depth <= depth_treshold = 0-                        | otherwise       = (size * (case_depth - depth_treshold)) `div` depth_scaling+          yes = traceInline logger opts id str (mk_doc some_benefit extra_doc True)  (Just unf_template)+          no  = traceInline logger opts id str (mk_doc some_benefit extra_doc False) Nothing++          some_benefit = calc_some_benefit (length arg_discounts) False++          -- depth_penalty: see Note [Avoid inlining into deeply nested cases]+          depth_threshold = unfoldingCaseThreshold opts+          depth_scaling   = unfoldingCaseScaling opts+          depth_penalty | case_depth <= depth_threshold = 0+                        | otherwise = (size * (case_depth - depth_threshold)) `div` depth_scaling+           adjusted_size = size + depth_penalty - discount           small_enough = adjusted_size <= unfoldingUseThreshold opts           discount = computeDiscount arg_discounts res_discount arg_infos cont_info -          extra_doc = vcat [ text "case depth =" <+> int case_depth+          extra_doc = vcat [ ppWhen (isJoinId id) $+                             text "join" <+> fsep [ ppr (v, hasCoreUnfolding (idUnfolding v)+                                                        , fmap (isEvaldUnfolding . idUnfolding) (lookupInScope in_scope v)+                                                        , is_more_evald in_scope v)+                                                  | v <- vselems (exprFreeIds unf_template) ]                            , text "depth based penalty =" <+> int depth_penalty-                           , text "discounted size =" <+> int adjusted_size ]+                           , text "adjusted size =" <+> int adjusted_size ]++          inline_join_point  -- See Note [Inlining join points]+            | or (zipWith scrut_arg arg_discounts arg_infos) = yes+            | anyVarSet (is_more_evald in_scope) $+              exprFreeIds unf_template                       = yes+            | otherwise                                      = no+          -- scrut_arg is True if the function body has a discount and the arg is a value+          scrut_arg disc ValueArg = disc > 0+          scrut_arg _    _        = False+   where+    opts         = seUnfoldingOpts env+    case_depth   = seCaseDepth env+    inline_depth = seInlineDepth env+    in_scope     = seInScope env+     -- Unpack the UnfoldingCache lazily because it may not be needed, and all     -- its fields are strict; so evaluating unf_cache at all forces all the     -- isWorkFree etc computations to take place.  That risks wasting effort for@@ -280,6 +375,8 @@              , text "is exp:" <+> ppr is_exp              , text "is work-free:" <+> ppr is_wf              , text "guidance" <+> ppr guidance+             , text "case depth =" <+> int case_depth+             , text "inline depth =" <+> int inline_depth              , extra_doc              , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"] @@ -292,9 +389,9 @@            -- arguments (ie n_val_args >= arity). But there must            -- be *something* interesting about some argument, or the            -- result context, to make it worth inlining-    calc_some_benefit :: Arity -> Bool   -- The Arity is the number of args+    calc_some_benefit :: Arity -> Bool -> Bool   -- The Arity is the number of args                                          -- expected by the unfolding-    calc_some_benefit uf_arity+    calc_some_benefit uf_arity is_inline        | not saturated = interesting_args       -- Under-saturated                                         -- Note [Unsaturated applications]        | otherwise = interesting_args   -- Saturated or over-saturated@@ -316,11 +413,23 @@               ValAppCtxt -> True                           -- Note [Cast then apply]               RuleArgCtxt -> uf_arity > 0  -- See Note [RHS of lets]               DiscArgCtxt -> uf_arity > 0  -- Note [Inlining in ArgCtxt]-              RhsCtxt NonRecursive+              RhsCtxt NonRecursive | is_inline                           -> uf_arity > 0  -- See Note [RHS of lets]               _other      -> False         -- See Note [Nested functions]  +vselems :: VarSet -> [Var]+vselems s = nonDetStrictFoldVarSet (\v vs -> v : vs) [] s++is_more_evald :: InScopeSet -> Id -> Bool+-- See Note [Inlining join points]+is_more_evald in_scope v+  | Just v1 <- lookupInScope in_scope v+  , idUnfolding v1 `isBetterUnfoldingThan` idUnfolding v+  = True+  | otherwise+  = False+ {- Note [RHS of lets] ~~~~~~~~~~~~~~~~~~~~~ When the call is the argument of a function with a RULE, or the RHS of a let,@@ -338,6 +447,94 @@ /non-recursive/ let as not-totally-boring.  A /recursive/ let isn't going be inlined so there is much less point.  Hence the (only reason for the) RecFlag in RhsCtxt++We inline only if `f` has an `UnfWhen` guidance.  I found that being more eager+led to fruitless inlining.  See Note [Seq is boring] wrinkle (SB1) in+GHC.Core.Opt.Simplify.Utils.++Note [Inlining join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+In general we /do not/ want to inline join points /even if they are small/.+See Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration.++But, assuming it is small, there are various times when we /do/ want to+inline a (non-recursive) join point.  Namely, if either of these hold:++(1) A /scrutinised/ argument (non-zero discount) has a /ValueArg/ info.+    Inlining will give some benefit.++(2) A free variable of the RHS is+    * Is /not/ evaluated at the join point defn site+    * Is evaluated at the join point call site.+    This is the is_more_evald predicate.++(1) is fairly obvious but (2) is less so. Here is the code for `integerGT`+without (2):++  integerGt = \ (x :: Integer) (y :: Integer) ->+     join fail _ = case x of {+       IS x1 -> case y of {+           IS y1 -> case <# x1 y1  of+                      _DEFAULT -> case ==# x1 y1 of+                                    DEFAULT -> True;+                                    1#      -> False+                      1# -> False+           IP ds1 -> False+           IN ds1 -> True++       IP x1 -> case y of {+                 _DEFAULT -> True;+                 IP y1    -> case bigNatCompare x1 y1 of+                               _DEFAULT -> False;+                               GT -> True+       IN x1 -> case y of {+                  _DEFAULT -> False;+                  IN y1    -> case bigNatCompare y1 x1 of+                                _DEFAULT -> False;+                                GT -> True+     in case x of {+       _DEFAULT -> jump fail GHC.Prim.(##);+       IS x1    -> case y of {+                     _DEFAULT -> jump fail GHC.Prim.(##);+                     IS y1 -> tagToEnum# @Bool (># x1 y1)++If we inline `fail` we get /much/ better code.  The only clue is that+`x` and `y` (a) are not evaluated at the definition site, and (b) are+evaluated at the call site.  This predicate is `isBetterUnfoldingThan`.++You might think that the variable should also be /scrutinised/ in the+join-point RHS, but here are two reasons for not taking that into+account.++First, we see code somewhat like this in imaginary/wheel-sieve1:+    let x = <small thunk> in+    join $j = (x,y) in+    case z of+      A -> case x of+             P -> $j+             Q -> blah+      B -> (x,x)+      C -> True+Here `x` can't be duplicated into the branches becuase it is used+in both the join point and the A branch.  But if we inline $j we get+    let x = <small thunk> in+    case z of+      A -> case x of x'+             P -> (x', y)+             Q -> blah+      B -> x+      C -> True+and now we /can/ duplicate x into the branches, at which point:+  * it is used strictly in the A branch (evaluated, but no thunk)+  * it is used lazily in the B branch (still a thunk)+  * it is not used at all in the C branch (no thunk)++Second, spectral/treejoin gets a big win from SpecConstr due+to evaluated-ness. Something like this:+    join $j x = ...(foo fv)...+    in case fv of I# x ->+       ...  jump $j True ...+If we inline $j, SpecConstr sees a call (foo (I# x)) and specialises.  Note [Unsaturated applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Core/Opt/Simplify/Iteration.hs view
@@ -13,19 +13,17 @@  import GHC.Prelude -import GHC.Platform- import GHC.Driver.Flags  import GHC.Core import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.ConstantFold-import GHC.Core.Type hiding ( substTy, substCo, substTyVar, extendTvSubst, extendCvSubst )+import GHC.Core.Type hiding ( substCo, substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline import GHC.Core.Opt.Simplify.Utils-import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutBinderSwap_maybe )+import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) ) import GHC.Core.Make       ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar )@@ -35,7 +33,7 @@ import GHC.Core.DataCon    ( DataCon, dataConWorkId, dataConRepStrictness    , dataConRepArgTys, isUnboxedTupleDataCon-   , StrictnessMark (..) )+   , StrictnessMark (..), dataConWrapId_maybe ) import GHC.Core.Opt.Stats ( Tick(..) ) import GHC.Core.Ppr     ( pprCoreExpr ) import GHC.Core.Unfold@@ -45,7 +43,7 @@                           , pushCoTyArg, pushCoValArg, exprIsDeadEnd                           , typeArity, arityTypeArity, etaExpandAT ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )-import GHC.Core.FVs     ( mkRuleInfo )+import GHC.Core.FVs     ( mkRuleInfo {- exprsFreeIds -} ) import GHC.Core.Rules   ( lookupRule, getRules ) import GHC.Core.Multiplicity @@ -60,9 +58,8 @@ import GHC.Types.Basic import GHC.Types.Tickish import GHC.Types.Var    ( isTyCoVar )-import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy )-import GHC.Builtin.Names( runRWKey )+import GHC.Builtin.Names( runRWKey, seqHashKey )  import GHC.Data.Maybe   ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString@@ -388,7 +385,8 @@         ; completeBind (BC_Join is_rec cont) (old_bndr, unf_se) (new_bndr, rhs', env) }  ---------------------------simplAuxBind :: SimplEnv+simplAuxBind :: String+             -> SimplEnv              -> InId            -- Old binder; not a JoinId              -> OutExpr         -- Simplified RHS              -> SimplM (SimplFloats, SimplEnv)@@ -400,21 +398,26 @@ -- -- Precondition: rhs satisfies the let-can-float invariant -simplAuxBind env bndr new_rhs+simplAuxBind _str env bndr new_rhs   | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $     isDeadBinder bndr   -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p }   = return (emptyFloats env, env)    --  Here c is dead, and we avoid                                      --  creating the binding c = (a,b) -  -- The cases would be inlined unconditionally by completeBind:-  -- but it seems not uncommon, and avoids faff to do it here-  -- This is safe because it's only used for auxiliary bindings, which-  -- have no NOLINE pragmas, nor RULEs+  -- Next we have a fast-path for cases that would be inlined unconditionally by+  -- completeBind: but it seems not uncommon, and it turns to be a little more+  -- efficient (in compile time allocations) to do it here.+  -- Effectively this is just a vastly-simplified postInlineUnconditionally+  --   See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils+  -- We could instead use postInlineUnconditionally itself, but I think it's simpler+  --   and more direct to focus on the "hot" cases.+  -- e.g. auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings   | exprIsTrivial new_rhs  -- Short-cut for let x = y in ...+    || case (idOccInfo bndr) of+          OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True+          _                                                 -> False   = return ( emptyFloats env-           , case new_rhs of-                Coercion co -> extendCvSubst env bndr co-                _           -> extendIdSubst env bndr (DoneEx new_rhs NotJoinPoint) )+           , extendCvIdSubst env bndr new_rhs )  -- bndr can be a CoVar    | otherwise   = do  { -- ANF-ise the RHS@@ -576,17 +579,16 @@ -}  tryCastWorkerWrapper :: SimplEnv -> BindContext-                     -> InId -> OccInfo-                     -> OutId -> OutExpr+                     -> InId -> OutId -> OutExpr                      -> SimplM (SimplFloats, SimplEnv) -- See Note [Cast worker/wrapper]-tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)+tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)   | BC_Let top_lvl is_rec <- bind_cxt  -- Not join points   , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform                         --            a DFunUnfolding in mk_worker_unfolding   , not (exprIsTrivial rhs)        -- Not x = y |> co; Wrinkle 1   , not (hasInlineUnfolding info)  -- Not INLINE things: Wrinkle 4-  , isConcreteType (typeKind work_ty) -- Don't peel off a cast if doing so would+  , typeHasFixedRuntimeRep work_ty    -- Don't peel off a cast if doing so would                                       -- lose the underlying runtime representation.                                       -- See Note [Preserve RuntimeRep info in cast w/w]   , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings@@ -606,7 +608,7 @@                 triv_rhs = Cast (Var work_id_w_unf) co -        ; if postInlineUnconditionally env bind_cxt bndr occ_info triv_rhs+        ; if postInlineUnconditionally env bind_cxt old_bndr bndr triv_rhs              -- Almost always True, because the RHS is trivial              -- In that case we want to eliminate the binding fast              -- We conservatively use postInlineUnconditionally so that we@@ -616,7 +618,7 @@                            , extendIdSubst (setInScopeFromF env floats) old_bndr $                              DoneEx triv_rhs NotJoinPoint ) } -          else do { wrap_unf <- mkLetUnfolding uf_opts top_lvl VanillaSrc bndr triv_rhs+          else do { wrap_unf <- mkLetUnfolding env top_lvl VanillaSrc bndr False triv_rhs                   ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr)                                 `setIdUnfolding`  wrap_unf                         floats' = floats `extendFloats` NonRec bndr' triv_rhs@@ -624,7 +626,6 @@   where     -- Force the occ_fs so that the old Id is not retained in the new Id.     !occ_fs = getOccFS bndr-    uf_opts = seUnfoldingOpts env     work_ty = coercionLKind co     info   = idInfo bndr     work_arity = arityInfo info `min` typeArity work_ty@@ -647,9 +648,9 @@       = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers            unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })              | isStableSource src -> return (unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) })-           _ -> mkLetUnfolding uf_opts top_lvl VanillaSrc work_id work_rhs+           _ -> mkLetUnfolding env top_lvl VanillaSrc work_id False work_rhs -tryCastWorkerWrapper env _ _ _ bndr rhs  -- All other bindings+tryCastWorkerWrapper env _ _ bndr rhs  -- All other bindings   = do { traceSmpl "tcww:no" (vcat [ text "bndr:" <+> ppr bndr                                    , text "rhs:" <+> ppr rhs ])         ; return (mkFloatBind env (NonRec bndr rhs)) }@@ -751,7 +752,7 @@   | is_expandable = anfise rhs0   | otherwise     = return (emptyLetFloats, rhs0)   where-    -- We can' use exprIsExpandable because the WHOLE POINT is that+    -- We can't use exprIsExpandable because the WHOLE POINT is that     -- we want to treat (K <big>) as expandable, because we are just     -- about "anfise" the <big> expression.  exprIsExpandable would     -- just say no!@@ -834,7 +835,7 @@           -- the 'floats' from prepareRHS; but they are all fresh, so there is           -- no danger of introducing name shadowing in eta expansion -        ; unf <- mkLetUnfolding uf_opts top_lvl VanillaSrc var expr2+        ; unf <- mkLetUnfolding env top_lvl VanillaSrc var False expr2          ; let final_id = addLetBndrInfo var arity_type unf               bind     = NonRec final_id expr2@@ -844,7 +845,6 @@   where     id_info = vanillaIdInfo `setDemandInfo` dmd     expr_ty = exprType expr-    uf_opts = seUnfoldingOpts env  bindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool -- True iff we can have a binding of this expression at this level@@ -928,7 +928,6 @@  = assert (isId new_bndr) $    do { let old_info = idInfo old_bndr             old_unf  = realUnfoldingInfo old_info-            occ_info = occInfo old_info           -- Do eta-expansion on the RHS of the binding          -- See Note [Eta-expanding at let bindings] in GHC.Core.Opt.Simplify.Utils@@ -942,7 +941,7 @@       ; let new_bndr_w_info = addLetBndrInfo new_bndr new_arity new_unfolding         -- See Note [In-scope set as a substitution] -      ; if postInlineUnconditionally env bind_cxt new_bndr_w_info occ_info eta_rhs+      ; if postInlineUnconditionally env bind_cxt old_bndr new_bndr_w_info eta_rhs          then -- Inline and discard the binding              do  { tick (PostInlineUnconditionally old_bndr)@@ -956,8 +955,9 @@                 -- substitution will happen, since we are going to discard the binding          else -- Keep the binding; do cast worker/wrapper-             -- pprTrace "Binding" (ppr new_bndr <+> ppr new_unfolding) $-             tryCastWorkerWrapper env bind_cxt old_bndr occ_info new_bndr_w_info eta_rhs }+--             simplTrace "completeBind" (vcat [ text "bndrs" <+> ppr old_bndr <+> ppr new_bndr+--                                             , text "eta_rhs" <+> ppr eta_rhs ]) $+             tryCastWorkerWrapper env bind_cxt old_bndr new_bndr_w_info eta_rhs }  addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId addLetBndrInfo new_bndr new_arity_type new_unf@@ -1352,10 +1352,16 @@  simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co-  = do { let opt_co = optCoercion opts (getSubst env) co+  = do { let opt_co | reSimplifying env = substCo env co+                    | otherwise         = optCoercion opts subst co+             -- If (reSimplifying env) is True we have already simplified+             -- this coercion once, and we don't want do so again; doing+             -- so repeatedly risks non-linear behaviour+             -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env        ; seqCo opt_co `seq` return opt_co }   where-    opts = seOptCoercionOpts env+    subst = getSubst env+    opts  = seOptCoercionOpts env  ----------------------------------- -- | Push a TickIt context outwards past applications and cases, as@@ -1372,6 +1378,9 @@   -- NB, don't do this with counting ticks, because if the expr is   -- bottom, then rebuildCall will discard the continuation. +--------------------------+--  | tickishScoped tickish && not (tickishCounts tickish)+--  = simplExprF env expr (TickIt tickish cont) -- XXX: we cannot do this, because the simplifier assumes that -- the context can be pushed into a case with a single branch. e.g. --    scc<f>  case expensive of p -> e@@ -1380,9 +1389,7 @@ -- -- So I'm disabling this for now.  It just means we will do more -- simplifier iterations that necessary in some cases.----  | tickishScoped tickish && not (tickishCounts tickish)---  = simplExprF env expr (TickIt tickish cont)+--------------------------    -- For unscoped or soft-scoped ticks, we are allowed to float in new   -- cost, so we simply push the continuation inside the tick.  This@@ -1464,8 +1471,8 @@   splitCont :: SimplCont -> (SimplCont, SimplCont)   splitCont cont@(ApplyToTy { sc_cont = tail }) = (cont { sc_cont = inc }, outc)     where (inc,outc) = splitCont tail-  splitCont (CastIt co c) = (CastIt co inc, outc)-    where (inc,outc) = splitCont c+  splitCont cont@(CastIt { sc_cont = tail }) = (cont { sc_cont = inc }, outc)+    where (inc,outc) = splitCont tail   splitCont other = (mkBoringStop (contHoleType other), other)    getDoneId (DoneId id)  = Just id@@ -1521,8 +1528,11 @@   = case cont of       Stop {}          -> return (emptyFloats env, expr)       TickIt t cont    -> rebuild env (mkTick t expr) cont-      CastIt co cont   -> rebuild env (mkCast expr co) cont-                       -- NB: mkCast implements the (Coercion co |> g) optimisation+      CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }+        -> rebuild env (mkCast expr co') cont+           -- NB: mkCast implements the (Coercion co |> g) optimisation+        where+          co' = optOutCoercion env co opt        Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }         -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont@@ -1573,7 +1583,7 @@                                                bndr2 (emptyFloats env) rhs               -- NB: it makes a surprisingly big difference (5% in compiler allocation               -- in T9630) to pass 'env' rather than 'env1'.  It's fine to pass 'env',-              -- because this is simplNonRecX, so bndr is not in scope in the RHS.+              -- because this is completeBindX, so bndr is not in scope in the RHS.          ; let env3 = env2 `setInScopeFromF` rhs_floats         ; (bind_float, env4) <- completeBind (BC_Let NotTopLevel NonRecursive)@@ -1621,36 +1631,73 @@  In investigating this I saw missed opportunities for on-the-fly coercion shrinkage. See #15090.++Note [Avoid re-simplifying coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In some benchmarks (with deeply nested cases) we successively push+casts onto the SimplCont.  We don't want to call the coercion optimiser+on each successive composition -- that's at least quadratic.  So:++* The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to+  record whether the coercion optimiser has been applied to the coercion.++* In `simplCast`, when we see (Cast e co), we simplify `co` to get+  an OutCoercion, and built a CastIt with sc_opt=True.++  Actually not quite: if we are simplifying the result of inlining an+  unfolding (seInlineDepth > 0), then instead of /optimising/ it again,+  just /substitute/ which is cheaper.  See `simplCoercion`.++* In `addCoerce` (in `simplCast`) if we combine this new coercion with+  an existing once, we build a CastIt for (co1 ; co2) with sc_opt=False.++* When unpacking a CastIt, in `rebuildCall` and `rebuild`, we optimise+  the (presumably composed) coercion if sc_opt=False; this is done+  by `optOutCoercion`.++* When duplicating a continuation in `mkDupableContWithDmds`, before+  duplicating a CastIt, optimise the coercion. Otherwise we'll end up+  optimising it separately in the duplicate copies. -}  -simplCast :: SimplEnv -> InExpr -> Coercion -> SimplCont+optOutCoercion :: SimplEnv -> OutCoercion -> Bool -> OutCoercion+-- See Note [Avoid re-simplifying coercions]+optOutCoercion env co already_optimised+  | already_optimised = co  -- See Note [Avoid re-simplifying coercions]+  | otherwise         = optCoercion opts empty_subst co+  where+    empty_subst = mkEmptySubst (seInScope env)+    opts = seOptCoercionOpts env++simplCast :: SimplEnv -> InExpr -> InCoercion -> SimplCont           -> SimplM (SimplFloats, OutExpr) simplCast env body co0 cont0   = do  { co1   <- {-#SCC "simplCast-simplCoercion" #-} simplCoercion env co0         ; cont1 <- {-#SCC "simplCast-addCoerce" #-}                    if isReflCo co1                    then return cont0  -- See Note [Optimising reflexivity]-                   else addCoerce co1 cont0+                   else addCoerce co1 True cont0+                        -- True <=> co1 is optimised         ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 }   where+         -- If the first parameter is MRefl, then simplifying revealed a         -- reflexive coercion. Omit.-        addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont-        addCoerceM MRefl   cont = return cont-        addCoerceM (MCo co) cont = addCoerce co cont+        addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont+        addCoerceM MRefl    _   cont = return cont+        addCoerceM (MCo co) opt cont = addCoerce co opt cont -        addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont-        addCoerce co1 (CastIt co2 cont)  -- See Note [Optimising reflexivity]-          | isReflexiveCo co' = return cont-          | otherwise         = addCoerce co' cont-          where-            co' = mkTransCo co1 co2+        addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont+        addCoerce co1 _ (CastIt { sc_co = co2, sc_cont = cont })  -- See Note [Optimising reflexivity]+          = addCoerce (mkTransCo co1 co2) False cont+                      -- False: (mkTransCo co1 co2) is not fully optimised+                      -- See Note [Avoid re-simplifying coercions] -        addCoerce co (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })+        addCoerce co opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })           | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty           = {-#SCC "addCoerce-pushCoTyArg" #-}-            do { tail' <- addCoerceM m_co' tail+            do { tail' <- addCoerceM m_co' opt tail                ; return (ApplyToTy { sc_arg_ty  = arg_ty'                                    , sc_cont    = tail'                                    , sc_hole_ty = coercionLKind co }) }@@ -1660,18 +1707,20 @@         -- where   co :: (s1->s2) ~ (t1->t2)         --         co1 :: t1 ~ s1         --         co2 :: s2 ~ t2-        addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se-                                      , sc_dup = dup, sc_cont = tail-                                      , sc_hole_ty = fun_ty })+        addCoerce co opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se+                                          , sc_dup = dup, sc_cont = tail+                                          , sc_hole_ty = fun_ty })+          | not opt  -- pushCoValArg duplicates the coercion, so optimise first+          = addCoerce (optOutCoercion env co opt) True cont+           | Just (m_co1, m_co2) <- pushCoValArg co           , fixed_rep m_co1           = {-#SCC "addCoerce-pushCoValArg" #-}-            do { tail' <- addCoerceM m_co2 tail+            do { tail' <- addCoerceM m_co2 opt tail                ; case m_co1 of {                    MRefl -> return (cont { sc_cont = tail'                                          , sc_hole_ty = coercionLKind co }) ;-                      -- Avoid simplifying if possible;-                      -- See Note [Avoiding exponential behaviour]+                      -- See Note [Avoiding simplifying repeatedly]                     MCo co1 ->             do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing arg_se arg@@ -1686,11 +1735,11 @@                                     , sc_cont = tail'                                     , sc_hole_ty = coercionLKind co }) } } } -        addCoerce co cont-          | isReflexiveCo co = return cont  -- Having this at the end makes a huge-                                            -- difference in T12227, for some reason-                                            -- See Note [Optimising reflexivity]-          | otherwise        = return (CastIt co cont)+        addCoerce co opt cont+          | isReflCo co = return cont  -- Having this at the end makes a huge+                                       -- difference in T12227, for some reason+                                       -- See Note [Optimising reflexivity]+          | otherwise = return (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont })          fixed_rep :: MCoercionR -> Bool         fixed_rep MRefl    = True@@ -1782,7 +1831,7 @@         ; if | isSimplified dup  -- Don't re-simplify if we've simplified it once                                 -- Including don't preInlineUnconditionally-                                -- See Note [Avoiding exponential behaviour]+                                -- See Note [Avoiding simplifying repeatedly]             -> completeBindX env from_what bndr arg body cont              | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se@@ -1915,35 +1964,48 @@ GHCi or TH and operator sections will fall over if we don't take care here. -Note [Avoiding exponential behaviour]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Avoiding simplifying repeatedly]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way.  So we must be jolly careful about re-simplifying-an expression (#13379).  That is why simplNonRecX does not try-preInlineUnconditionally (unlike simplNonRecE).+an expression (#13379).  Example:   f BIG, where f has a RULE Then  * We simplify BIG before trying the rule; but the rule does not fire- * We inline f = \x. x True- * So if we did preInlineUnconditionally we'd re-simplify (BIG True)+   (forcing this simplification is why we have the RULE in this example)+ * We inline f = \x. g x, in `simpl_lam`+ * So if `simpl_lam` did preInlineUnconditionally we get (g BIG)+ * Now if g has a RULE we'll simplify BIG again, and this whole thing can+   iterate.+ * However, if `f` did not have a RULE, so that BIG has /not/ already been+   simplified, we /want/ to do preInlineUnconditionally in simpl_lam. -However, if BIG has /not/ already been simplified, we'd /like/ to-simplify BIG True; maybe good things happen.  That is why+So we go to some effort to avoid repeatedly simplifying the same thing: -* simplLam has-    - a case for (isSimplified dup), which goes via simplNonRecX, and-    - a case for the un-simplified case, which goes via simplNonRecE+* ApplyToVal has a (sc_dup :: DupFlag) field which records if the argument+  has been evaluated. +* simplArg checks this flag to avoid re-simplifying.++* simpl_lam has:+    - a case for (isSimplified dup), which goes via completeBindX, and+    - a case for an un-simplified argument, which tries preInlineUnconditionally+ * We go to some efforts to avoid unnecessarily simplifying ApplyToVal,   in at least two places     - In simplCast/addCoerce, where we check for isReflCo     - In rebuildCall we avoid simplifying arguments before we have to       (see Note [Trying rewrite rules]) +All that said /postInlineUnconditionally/ (called in `completeBind`) does+fire in the above (f BIG) situation.  See Note [Post-inline for single-use+things] in Simplify.Utils.  This certainly risks repeated simplification, but+in practice seems to be a small win. + ************************************************************************ *                                                                      *                      Join points@@ -2263,8 +2325,10 @@                       _             -> True  ---------- Simplify type applications and casts ---------------rebuildCall env info (CastIt co cont)-  = rebuildCall env (addCastTo info co) cont+rebuildCall env info (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont })+  = rebuildCall env (addCastTo info co') cont+  where+    co' = optOutCoercion env co opt  rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont })   = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont@@ -2353,8 +2417,7 @@ ----------------------------------- tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr) tryInlining env logger var cont-  | Just expr <- callSiteInline logger uf_opts case_depth var active_unf-                                lone_variable arg_infos interesting_cont+  | Just expr <- callSiteInline env logger var lone_variable arg_infos interesting_cont   = do { dump_inline expr cont        ; return (Just expr) } @@ -2362,11 +2425,8 @@   = return Nothing    where-    uf_opts    = seUnfoldingOpts env-    case_depth = seCaseDepth env     (lone_variable, arg_infos, call_cont) = contArgs cont     interesting_cont = interestingCallContext env call_cont-    active_unf       = activeUnfolding (seMode env) var      log_inlining doc       = liftIO $ logDumpFile logger (mkDumpStyle alwaysQualify)@@ -2401,7 +2461,7 @@    (\x. x True) e1 without simplifying e1.  Now we can inline x into its unique call site, and absorb the True into it all in the same pass.  If we simplified-e1 first, we couldn't do that; see Note [Avoiding exponential behaviour].+e1 first, we couldn't do that; see Note [Avoiding simplifying repeatedly].  So we try to apply rules if either   (a) no_more_args: we've run out of argument that the rules can "see"@@ -2813,11 +2873,11 @@      let z = case y of { __DEFAULT -> expr } in      z+1 }   The "y*" means "y is used strictly in its scope.  Now we may:-   - Eliminate the inner case because `y` is evaluated.+     - Eliminate the inner case because `y` is evaluated.   Now the demand-info on `y` is not right, because `y` is no longer used   strictly in its scope.  But it is hard to spot that without doing a new   demand analysis.  So there is a danger that we will subsequently:-   - Eliminate the outer case because `y` is used strictly+     - Eliminate the outer case because `y` is used strictly   Yikes!  We can't eliminate both!  * It introduces space leaks (#24251).  Consider@@ -2825,7 +2885,7 @@   It is an infinite loop, true, but it should not leak space. Yet if we drop   the `seq`, it will.  Another great example is #21741. -* Dropping the outer `case can change the error behaviour.  For example,+* Dropping the outer `case` can change the error behaviour.  For example,   we might transform        case x of { _ -> error "bad" }    -->     error "bad"   which is might be puzzling if 'x' currently lambda-bound, but later gets@@ -3022,7 +3082,7 @@   where     simple_rhs env wfloats case_bndr_rhs bs rhs =       assert (null bs) $-      do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs+      do { (floats1, env') <- simplAuxBind "rebuildCase" env case_bndr case_bndr_rhs              -- scrut is a constructor application,              -- hence satisfies let-can-float invariant          ; (floats2, expr') <- simplExprF env' rhs cont@@ -3088,7 +3148,7 @@   | all_dead_bndrs   , doCaseToLet scrut case_bndr   = do { tick (CaseElim case_bndr)-       ; (floats1, env')  <- simplAuxBind env case_bndr scrut+       ; (floats1, env')  <- simplAuxBind "rebuildCaseAlt1" env case_bndr scrut        ; (floats2, expr') <- simplExprF env' rhs cont        ; return (floats1 `addFloats` floats2, expr') } @@ -3116,7 +3176,6 @@ rebuildCase env scrut case_bndr alts cont   = reallyRebuildCase env scrut case_bndr alts cont - doCaseToLet :: OutExpr          -- Scrutinee             -> InId             -- Case binder             -> Bool@@ -3188,16 +3247,36 @@ after the outer case, and that makes (a,b) alive.  At least we do unless the case binder is guaranteed dead. -Note [Case alternative occ info]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-When we are simply reconstructing a case (the common case), we always-zap the occurrence info on the binders in the alternatives.  Even-if the case binder is dead, the scrutinee is usually a variable, and *that*-can bring the case-alternative binders back to life.-See Note [Add unfolding for scrutinee]+Note [DataAlt occ info]+~~~~~~~~~~~~~~~~~~~~~~~+Our general goal is to preserve dead-ness occ-info on the field binders of a+case alternative. Why? It's generally a good idea, but one specific reason is to+support (SEQ4) of Note [seq# magic]. +But we have to be careful: even if the field binder is not mentioned in the case+alternative and thus annotated IAmDead by OccurAnal, it might "come back to+life" in one of two ways:++ 1. If the case binder is alive, its unfolding might bring back the field+    binder, as in Note [knownCon occ info]:+      case blah of y { I# _ -> $wf (case y of I# v -> v) }+      ==>+      case blah of y { I# v -> $wf v }+ 2. Even if the case binder appears to be dead, there is the scenario in+    Note [Add unfolding for scrutinee], in which the fields come back to live+    through the unfolding of variable scrutinee, as follows:+      join j = case x of Just v -> blah v; Nothing -> ... in+      case x of Just _ -> jump j; Nothing -> ...+      ==> { inline j, unfold x to Just v, simplify }+      join j = case x of Just v -> blah v; Nothing -> ... in+      case x of Just v -> blah v; Nothing -> ...++Thus, when we are simply reconstructing a case (the common case), and the+case binder is not dead, or the scrutinee is a variable, we zap the+occurrence info on DataAlt field binders. See `adjustFieldOccInfo`.+ Note [Improving seq]-~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~ Consider         type family F :: * -> *         type instance F Int = Int@@ -3303,8 +3382,9 @@           -- NB: pass case_bndr::InId, not case_bndr' :: OutId, to prepareAlts           --     See Note [Shadowing in prepareAlts] in GHC.Core.Opt.Simplify.Utils -        ; alts' <- mapM (simplAlt alt_env' (Just scrut') imposs_deflt_cons case_bndr' cont') in_alts---      ; pprTrace "simplAlts" (ppr case_bndr $$ ppr alts $$ ppr cont') $ return ()+        ; alts' <- forM in_alts $+            simplAlt alt_env' (Just scrut') imposs_deflt_cons+                     case_bndr' (scrutOkForBinderSwap scrut) cont'          ; let alts_ty' = contResultType cont'         -- See Note [Avoiding space leaks in OutType]@@ -3330,39 +3410,43 @@  ------------------------------------ simplAlt :: SimplEnv-         -> Maybe OutExpr  -- The scrutinee-         -> [AltCon]       -- These constructors can't be present when-                           -- matching the DEFAULT alternative-         -> OutId          -- The case binder+         -> Maybe OutExpr       -- The scrutinee+         -> [AltCon]            -- These constructors can't be present when+                                -- matching the DEFAULT alternative+         -> OutId               -- The case binder `bndr`+         -> BinderSwapDecision  -- DoBinderSwap v co <==> scrut = Just (v |> co),+                                --           add unfolding `v :-> bndr |> sym co`          -> SimplCont          -> InAlt          -> SimplM OutAlt -simplAlt env _ imposs_deflt_cons case_bndr' cont' (Alt DEFAULT bndrs rhs)+simplAlt env _scrut' imposs_deflt_cons case_bndr' bndr_swap' cont' (Alt DEFAULT bndrs rhs)   = assert (null bndrs) $-    do  { let env' = addBinderUnfolding env case_bndr'-                                        (mkOtherCon imposs_deflt_cons)-                -- Record the constructors that the case-binder *can't* be.+    do  { let env' = addDefaultUnfoldings env case_bndr' bndr_swap' imposs_deflt_cons         ; rhs' <- simplExprC env' rhs cont'         ; return (Alt DEFAULT [] rhs') } -simplAlt env scrut' _ case_bndr' cont' (Alt (LitAlt lit) bndrs rhs)+simplAlt env _scrut' _ case_bndr' bndr_swap' cont' (Alt (LitAlt lit) bndrs rhs)   = assert (null bndrs) $-    do  { env' <- addAltUnfoldings env scrut' case_bndr' (Lit lit)+    do  { let env' = addAltUnfoldings env case_bndr' bndr_swap' (Lit lit)         ; rhs' <- simplExprC env' rhs cont'         ; return (Alt (LitAlt lit) [] rhs') } -simplAlt env scrut' _ case_bndr' cont' (Alt (DataAlt con) vs rhs)+simplAlt env scrut' _ case_bndr' bndr_swap' cont' (Alt (DataAlt con) vs rhs)   = do  { -- See Note [Adding evaluatedness info to pattern-bound variables]-          let vs_with_evals = addEvals scrut' con vs-        ; (env', vs') <- simplBinders env vs_with_evals+          -- and Note [DataAlt occ info]+        ; let vs_with_info = adjustFieldsIdInfo scrut' case_bndr' bndr_swap' con vs+          -- Adjust evaluated-ness and occ-info flags before `simplBinders`+          -- because the latter extends the in-scope set, which propagates this+          -- adjusted info to use sites.+        ; (env', vs') <- simplBinders env vs_with_info                  -- Bind the case-binder to (con args)         ; let inst_tys' = tyConAppArgs (idType case_bndr')               con_app :: OutExpr-              con_app   = mkConApp2 con inst_tys' vs'+              con_app = mkConApp2 con inst_tys' vs'+              env''   = addAltUnfoldings env' case_bndr' bndr_swap' con_app -        ; env'' <- addAltUnfoldings env' scrut' case_bndr' con_app         ; rhs' <- simplExprC env'' rhs cont'         ; return (Alt (DataAlt con) vs' rhs') } @@ -3383,7 +3467,7 @@  In addition to handling data constructor fields with !s, addEvals also records the fact that the result of seq# is always in WHNF.-See Note [seq# magic] in GHC.Core.Opt.ConstantFold.  Example (#15226):+See Note [seq# magic] in GHC.Types.Id.Make.  Example (#15226):    case seq# v s of     (# s', v' #) -> E@@ -3395,9 +3479,10 @@ see #15226 for discussion. -} -addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id]+adjustFieldsIdInfo :: Maybe OutExpr -> OutId -> BinderSwapDecision -> DataCon -> [Id] -> [Id] -- See Note [Adding evaluatedness info to pattern-bound variables]-addEvals scrut con vs+-- and Note [DataAlt occ info]+adjustFieldsIdInfo scrut case_bndr bndr_swap con vs   -- Deal with seq# applications   | Just scr <- scrut   , isUnboxedTupleDataCon con@@ -3405,55 +3490,83 @@     -- Use stripNArgs rather than collectArgsTicks to avoid building     -- a list of arguments only to throw it away immediately.   , Just (Var f) <- stripNArgs 4 scr-  , Just SeqOp <- isPrimOpId_maybe f-  , let x' = zapIdOccInfoAndSetEvald MarkedStrict x-  = [s, x']+  , f `hasKey` seqHashKey+  , let x' = setCaseBndrEvald MarkedStrict x+  = map (adjustFieldOccInfo case_bndr bndr_swap) [s, x']    -- Deal with banged datacon fields-addEvals _scrut con vs = go vs the_strs-    where-      the_strs = dataConRepStrictness con+  -- This case is quite allocation sensitive to T9233 which has a large record+  -- with strict fields. Hence we try not to update vs twice!+adjustFieldsIdInfo _scrut case_bndr bndr_swap con vs+  | Nothing <- dataConWrapId_maybe con+      -- A common fast path; no need to allocate the_strs when they are all lazy+      -- anyway! It shaves off 2% in T9675+  = map (adjustFieldOccInfo case_bndr bndr_swap) vs+  | otherwise+  = go vs the_strs+  where+    the_strs = dataConRepStrictness con -      go [] [] = []-      go (v:vs') strs | isTyVar v = v : go vs' strs-      go (v:vs') (str:strs) = zapIdOccInfoAndSetEvald str v : go vs' strs-      go _ _ = pprPanic "Simplify.addEvals"-                (ppr con $$-                 ppr vs  $$-                 ppr_with_length (map strdisp the_strs) $$-                 ppr_with_length (dataConRepArgTys con) $$-                 ppr_with_length (dataConRepStrictness con))-        where-          ppr_with_length list-            = ppr list <+> parens (text "length =" <+> ppr (length list))-          strdisp :: StrictnessMark -> SDoc-          strdisp MarkedStrict = text "MarkedStrict"-          strdisp NotMarkedStrict = text "NotMarkedStrict"+    go [] [] = []+    go (v:vs') strs | isTyVar v = v : go vs' strs+    go (v:vs') (str:strs) = adjustFieldOccInfo case_bndr bndr_swap (setCaseBndrEvald str v) : go vs' strs+    go _ _ = pprPanic "Simplify.adjustFieldsIdInfo"+              (ppr con $$+               ppr vs  $$+               ppr_with_length (map strdisp the_strs) $$+               ppr_with_length (dataConRepArgTys con) $$+               ppr_with_length (dataConRepStrictness con))+      where+        ppr_with_length list+          = ppr list <+> parens (text "length =" <+> ppr (length list))+        strdisp :: StrictnessMark -> SDoc+        strdisp MarkedStrict = text "MarkedStrict"+        strdisp NotMarkedStrict = text "NotMarkedStrict" -zapIdOccInfoAndSetEvald :: StrictnessMark -> Id -> Id-zapIdOccInfoAndSetEvald str v =-  setCaseBndrEvald str $ -- Add eval'dness info-  zapIdOccInfo v         -- And kill occ info;-                         -- see Note [Case alternative occ info]+adjustFieldOccInfo :: OutId -> BinderSwapDecision -> CoreBndr -> CoreBndr+-- Kill occ info if we do binder swap and the case binder is alive;+-- see Note [DataAlt occ info]+adjustFieldOccInfo case_bndr bndr_swap field_bndr+  | isTyVar field_bndr+  = field_bndr -addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv-addAltUnfoldings env mb_scrut case_bndr con_app-  = do { let con_app_unf = mk_simple_unf con_app-             env1 = addBinderUnfolding env case_bndr con_app_unf+  | not (isDeadBinder case_bndr)  -- (1) in the Note: If the case binder is alive,+  = zapIdOccInfo field_bndr       -- the field binders might come back alive -             -- See Note [Add unfolding for scrutinee]-             env2 | Just scrut <- mb_scrut-                  , Just (v,mco) <- scrutBinderSwap_maybe scrut-                  = addBinderUnfolding env1 v $-                       if isReflMCo mco  -- isReflMCo: avoid calling mk_simple_unf-                       then con_app_unf  --            twice in the common case-                       else mk_simple_unf (mkCastMCo con_app mco)+  | DoBinderSwap{} <- bndr_swap   -- (2) in the Note: If binder swap might take place,+  = zapIdOccInfo field_bndr       -- the case binder might come back alive -                  | otherwise = env1+  | otherwise+  = field_bndr                    -- otherwise the field binders stay dead -       ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr mb_scrut, ppr con_app])-       ; return env2 }+addDefaultUnfoldings :: SimplEnv -> OutId -> BinderSwapDecision -> [AltCon] -> SimplEnv+addDefaultUnfoldings env case_bndr bndr_swap imposs_deflt_cons+  = env2   where+    unf = mkOtherCon imposs_deflt_cons+          -- Record the constructors that the case-binder *can't* be.+    env1 = addBinderUnfolding env case_bndr unf+    env2 | DoBinderSwap v _mco <- bndr_swap+         = addBinderUnfolding env1 v unf+         | otherwise = env1+++addAltUnfoldings :: SimplEnv -> OutId -> BinderSwapDecision -> OutExpr -> SimplEnv+addAltUnfoldings env case_bndr bndr_swap con_app+  = env2+  where+    con_app_unf = mk_simple_unf con_app+    env1 = addBinderUnfolding env case_bndr con_app_unf++    -- See Note [Add unfolding for scrutinee]+    env2 | DoBinderSwap v mco <- bndr_swap+         = addBinderUnfolding env1 v $+              if isReflMCo mco  -- isReflMCo: avoid calling mk_simple_unf+              then con_app_unf  --            twice in the common case+              else mk_simple_unf (mkCastMCo con_app mco)++         | otherwise = env1+     -- Force the opts, so that the whole SimplEnv isn't retained     !opts = seUnfoldingOpts env     mk_simple_unf = mkSimpleUnfolding opts@@ -3525,7 +3638,7 @@ respective RHSs.  Since this transformation is tantamount to a binder swap, we use-GHC.Core.Opt.OccurAnal.scrutBinderSwap_maybe to do the check.+GHC.Core.Opt.OccurAnal.scrutOkForBinderSwap to do the check.  Exactly the same issue arises in GHC.Core.Opt.SpecConstr; see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr@@ -3591,8 +3704,8 @@              -- occur in the RHS; and simplAuxBind may therefore discard it.              -- Nevertheless we must keep it if the case-binder is alive,              -- because it may be used in the con_app.  See Note [knownCon occ info]-           ; (floats1, env2) <- simplAuxBind env' b' arg  -- arg satisfies let-can-float invariant-           ; (floats2, env3)  <- bind_args env2 bs' args+           ; (floats1, env2) <- simplAuxBind "knownCon" env' b' arg  -- arg satisfies let-can-float invariant+           ; (floats2, env3) <- bind_args env2 bs' args            ; return (floats1 `addFloats` floats2, env3) }      bind_args _ _ _ =@@ -3617,7 +3730,7 @@                                  ; let con_app = Var (dataConWorkId dc)                                                  `mkTyApps` dc_ty_args                                                  `mkApps`   dc_args-                                 ; simplAuxBind env bndr con_app }+                                 ; simplAuxBind "case-bndr" env bndr con_app }  ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont@@ -3714,9 +3827,11 @@  mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont"     -- Handled by previous eqn -mkDupableContWithDmds env dmds (CastIt ty cont)+mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont })   = do  { (floats, cont') <- mkDupableContWithDmds env dmds cont-        ; return (floats, CastIt ty cont') }+        ; return (floats, CastIt { sc_co = optOutCoercion env co opt+                                 , sc_opt = True, sc_cont = cont' }) }+                 -- optOutCoercion: see Note [Avoid re-simplifying coercions]  -- Duplicating ticks for now, not sure if this is good or not mkDupableContWithDmds env dmds (TickIt t cont)@@ -3745,8 +3860,10 @@                , sc_fun_ty = fun_ty })   -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable   | isNothing (isDataConId_maybe (ai_fun fun))-  , thumbsUpPlanA cont  -- See point (3) of Note [Duplicating join points]+         -- isDataConId: see point (DJ4) of Note [Duplicating join points]+  , thumbsUpPlanA cont   = -- Use Plan A of Note [Duplicating StrictArg]+--    pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $     do { let (_ : dmds) = ai_dmds fun        ; (floats1, cont')  <- mkDupableContWithDmds env dmds cont                               -- Use the demands from the function to add the right@@ -3771,13 +3888,13 @@        ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty }   where     thumbsUpPlanA (StrictArg {})               = False-    thumbsUpPlanA (CastIt _ k)                 = thumbsUpPlanA k+    thumbsUpPlanA (StrictBind {})              = True+    thumbsUpPlanA (Stop {})                    = True+    thumbsUpPlanA (Select {})                  = True+    thumbsUpPlanA (CastIt { sc_cont = k })     = thumbsUpPlanA k     thumbsUpPlanA (TickIt _ k)                 = thumbsUpPlanA k     thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k     thumbsUpPlanA (ApplyToTy  { sc_cont = k }) = thumbsUpPlanA k-    thumbsUpPlanA (Select {})                  = True-    thumbsUpPlanA (StrictBind {})              = True-    thumbsUpPlanA (Stop {})                    = True  mkDupableContWithDmds env dmds     (ApplyToTy { sc_cont = cont, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty })@@ -3825,8 +3942,9 @@         ; let cont_scaling = contHoleScaling cont           -- See Note [Scaling in case-of-case]         ; (alt_env', case_bndr') <- simplBinder alt_env (scaleIdBy cont_scaling case_bndr)-        ; alts' <- mapM (simplAlt alt_env' Nothing [] case_bndr' alt_cont) (scaleAltsBy cont_scaling alts)-        -- Safe to say that there are no handled-cons for the DEFAULT case+        ; alts' <- forM (scaleAltsBy cont_scaling alts) $+            simplAlt alt_env' Nothing [] case_bndr' NoBinderSwap alt_cont+                -- Safe to say that there are no handled-cons for the DEFAULT case                 -- NB: simplBinder does not zap deadness occ-info, so                 -- a dead case_bndr' will still advertise its deadness                 -- This is really important because in@@ -3838,8 +3956,7 @@         -- NB: we don't use alt_env further; it has the substEnv for         --     the alternatives, and we don't want that -        ; let platform = sePlatform env-        ; (join_floats, alts'') <- mapAccumLM (mkDupableAlt platform case_bndr')+        ; (join_floats, alts'') <- mapAccumLM (mkDupableAlt env case_bndr')                                               emptyJoinFloats alts'          ; let all_floats = floats `addJoinFloats` join_floats@@ -3855,7 +3972,8 @@ mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType                     -> SimplM (SimplFloats, SimplCont) mkDupableStrictBind env arg_bndr join_rhs res_ty-  | exprIsTrivial join_rhs   -- See point (2) of Note [Duplicating join points]+  | uncondInlineJoin [arg_bndr] join_rhs+     -- See point (DJ2) of Note [Duplicating join points]   = return (emptyFloats env            , StrictBind { sc_bndr = arg_bndr                         , sc_body = join_rhs@@ -3880,11 +3998,12 @@                             , sc_cont   = mkBoringStop res_ty                             } ) } -mkDupableAlt :: Platform -> OutId+mkDupableAlt :: SimplEnv -> OutId              -> JoinFloats -> OutAlt              -> SimplM (JoinFloats, OutAlt)-mkDupableAlt _platform case_bndr jfloats (Alt con alt_bndrs alt_rhs_in)-  | exprIsTrivial alt_rhs_in   -- See point (2) of Note [Duplicating join points]+mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in)+  | uncondInlineJoin alt_bndrs alt_rhs_in+    -- See point (DJ2) of Note [Duplicating join points]   = return (jfloats, Alt con alt_bndrs alt_rhs_in)    | otherwise@@ -3915,7 +4034,7 @@               filtered_binders = map fst abstracted_binders               -- We want to make any binder with an evaldUnfolding strict in the rhs.               -- See Note [Call-by-value for worker args] (which also applies to join points)-              (rhs_with_seqs) = mkStrictFieldSeqs abstracted_binders alt_rhs_in+              rhs_with_seqs = mkStrictFieldSeqs abstracted_binders alt_rhs_in                final_args = varsToCoreExprs filtered_binders                            -- Note [Join point abstraction]@@ -3933,8 +4052,10 @@               join_rhs   = mkLams (map zapIdUnfolding final_bndrs) rhs_with_seqs          ; join_bndr <- newJoinId filtered_binders rhs_ty'--        ; let join_call = mkApps (Var join_bndr) final_args+        ; let -- join_bndr_w_unf = join_bndr `setIdUnfolding`+              --                   mkUnfolding uf_opts VanillaSrc False False join_rhs Nothing+              -- See Note [Do not add unfoldings to join points at birth]+              join_call = mkApps (Var join_bndr) final_args               alt'      = Alt con alt_bndrs join_call          ; return ( jfloats `addJoinFlts` unitJoinFloat (NonRec join_bndr join_rhs)@@ -3942,6 +4063,62 @@                 -- See Note [Duplicated env]  {-+Note [Do not add unfoldings to join points at birth]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this (#15360)++   case (case (case (case ...))) of+      Left x  -> e1+      Right y -> e2++We will make a join point for e1, e2, thus+    $j1a x = e1+    $j1b y = e2++Now those join point calls count as "duplicable" , so we feel free to duplicate+them into the loop nest.  And each of those calls are then subject to+callSiteInline, which might inline them, if e1, e2 are reasonably small.  Now,+if this applies recursive to the next `case` inwards, and so on, the net+effect is that we can get an exponential number of calls to $j1a and $j1b, and+an exponential number of inlinings (since each is done independently).++This hit #15360 (not a complicated program!) badly.  Our simple solution is this:+when a join point is born, we don't give it an unfolding, so it will not be inlined+at its call sites, at least not in that pass.  So we end up with+    $j1a x = e1+    $j1b y = e2+    $j2a x = ...$j1a ... $j1b...+    $j2b x = ...$j1a ... $j1b...+    ... and so on...++In the next iteration of the Simplifier we are into Note [Avoid inlining into+deeply nested cases] in Simplify.Inline, which is still a challenge.  But at+least we have a chance. If we add inlinings at birth we never get that chance.++Wrinkle++(JU1) It turns out that the same problem shows up in a different guise, via+      Note [Post-inline for single-use things] in Simplify.Utils.  I think+      we have something like+         case K (join $j x = <rhs> in jblah) of K y{OneOcc} -> blah+      where $j is a freshly-born join point.  After case-of-known-constructor+      wo we end up substituting (join $j x = <rhs> in jblah) for `y` in `blah`;+      and thus we re-simplify that join binding.  In test T15630 this results in+      massive duplication.++      So in `simplLetUnfolding` we spot this case a bit hackily; a freshly-born+      join point will have OccInfo of ManyOccs, unlike an existing join point which+      will have OneOcc.  So in simplLetUnfolding we kill the unfolding of a freshly+      born join point.++I can't quite articulate precisely why this is so important.  But it makes a+MASSIVE difference in T15630 (a fantastic test case); and at worst it'll merely+delay inlining join points by one simplifier iteration.++In effect (JU1) just extends the original Note [Do not add unfoldings to join+points at birth] to occasions where we re-visit the same join-point in the same+Simplifier iteration.+ Note [Fusing case continuations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important to fuse two successive case continuations when the@@ -3975,7 +4152,7 @@  Note [Duplicating join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-IN #19996 we discovered that we want to be really careful about+In #19996 we discovered that we want to be really careful about inlining join points.   Consider     case (join $j x = K f x )          (in case v of      )@@ -3985,8 +4162,8 @@       K g y -> blah[g,y]  Here the join-point RHS is very small, just a constructor-application (K x y).  So we might inline it to get-    case (case v of        )+application (K f x).  So we might inline it to get+    case (case v of          )          (     p1 -> K f x1  ) of          (     p2 -> K f x2  )          (     p3 -> K f x3  )@@ -4004,46 +4181,53 @@ This can make a /massive/ difference, because `blah` can see what `f` is, instead of lambda-abstracting over it. -To achieve this:+Beyond this, not-inlining join points reduces duplication.  In the above+example, if `blah` was small enough we'd inline it, but that duplicates code,+for no gain.  Best just to keep not-inline the join point in the first place.+So not-inlining join points is our default: but see Note [Inlining join points]+in GHC.Core.Opt.Simplify.Inline for when we /do/ inline them. -1. Do not postInlineUnconditionally a join point, until the Final-   phase.  (The Final phase is still quite early, so we might consider-   delaying still more.)+To achieve this parsimonious inlining of join points, we need to do two things:+(a) create a join point even if the RHS is small; and (b) don't do+unconditional-inlining for join points. -2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for-   all alternatives, except for exprIsTrival RHSs. Previously we used-   exprIsDupable.  This generates a lot more join points, but makes-   them much more case-of-case friendly.+(DJ1) Do not postInlineUnconditionally a join point, ever. Doing+   postInlineUnconditionally is primarily to push allocation into cold+   branches; but a join point doesn't allocate, so that's a non-motivation. -   It is definitely worth checking for exprIsTrivial, otherwise we get-   an extra Simplifier iteration, because it is inlined in the next-   round.+(DJ2) In mkDupableAlt and mkDupableStrictBind, generate an alterative for /all/+   alternatives, /except/ for ones that will definitely inline unconditionally+   straight away.  (In that case it's silly to make a join point in the first+   place; it just takes an extra Simplifier iteration to undo.)  This choice is+   made by GHC.Core.Unfold.uncondInlineJoin. -3. By the same token we want to use Plan B in-   Note [Duplicating StrictArg] when the RHS of the new join point-   is a data constructor application.  That same Note explains why we-   want Plan A when the RHS of the new join point would be a-   non-data-constructor application+   This plan generates a lot of join points, but makes them much more+   case-of-case friendly. -4. You might worry that $j will be inlined by the call-site inliner,-   but it won't because the call-site context for a join is usually-   extremely boring (the arguments come from the pattern match).-   And if not, then perhaps inlining it would be a good idea.+(DJ3) When should `uncondInlineJoin` return True?+   * (exprIsTrivial rhs); this includes uses of unsafeEqualityProof etc; see+     the defn of exprIsTrivial.  Also nullary constructors. -   You might also wonder if we get UnfWhen, because the RHS of the-   join point is no bigger than the call. But in the cases we care-   about it will be a little bigger, because of that free `f` in-       $j x = K f x-   So for now we don't do anything special in callSiteInline+   * The RHS is a call ($j x y z), where the arguments are all trivial and $j+     is a join point: there is no point in creating an indirection. -There is a bit of tension between (2) and (3).  Do we want to retain-the join point only when the RHS is-* a constructor application? or-* just non-trivial?-Currently, a bit ad-hoc, but we definitely want to retain the join-point for data constructors in mkDupalbleALt (point 2); that is the-whole point of #19996 described above.+(DJ4) By the same token we want to use Plan B in Note [Duplicating StrictArg] when+   the RHS of the new join point is a data constructor application.  See the+   call to isDataConId in the StrictArg case of mkDupableContWithDmds. +   That same Note [Duplicating StrictArg] explains why we sometimes want Plan A+   when the RHS of the new join point would be a non-data-constructor+   application++(DJ5) You might worry that $j = K x y might look so small that it is inlined+   by the call site inliner, defeating (DJ3). But in fact++   - The UnfoldingGuidance for a join point is only UnfWhen (unconditional)+     if `uncondInlineJoin` is true; see GHC.Core.Unfold.uncondInline++   - `GHC.Core.Opt.Simplify.Inline.tryUnfolding` has a special case for join+     points, described Note [Inlining join points] in that module.+ Historical Note [Case binders and join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ NB: this entire Note is now irrelevant.  In Jun 21 we stopped@@ -4154,26 +4338,28 @@   So, looking at Note [Duplicating join points], we also want Plan B   when `f` is a data constructor. -Plan A is often good. Here's an example from #3116-     go (n+1) (case l of-                 1  -> bs'-                 _  -> Chunk p fpc (o+1) (l-1) bs')--If we pushed the entire call for 'go' inside the case, we get-call-pattern specialisation for 'go', which is *crucial* for-this particular program.+Plan A is often good: -Here is another example.+* The calls to `f` may well be able to inline, since they are now applied+  to more informative arguments, `r1`, `r2`. For example:         && E (case x of { T -> F; F -> T })--Pushing the call inward (being careful not to duplicate E)+  Pushing the call inward (being careful not to duplicate E) we get         let a = E         in case x of { T -> && a F; F -> && a T }+  and now the (&& a F) etc can optimise. -and now the (&& a F) etc can optimise.  Moreover there might-be a RULE for the function that can fire when it "sees" the-particular case alternative.+* Moreover there might be a RULE for the function that can fire when it "sees"+  the particular case alternative. +* More specialisation can happen.  Here's an example from #3116+     go (n+1) (case l of+                 1  -> bs'+                 _  -> Chunk p fpc (o+1) (l-1) bs')++  If we pushed the entire call for 'go' inside the case, we get+  call-pattern specialisation for 'go', which is *crucial* for+  this particular program.+ But Plan A can have terrible, terrible behaviour. Here is a classic case:   f (f (f (f (f True))))@@ -4304,18 +4490,30 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf   | isStableUnfolding unf   = simplStableUnfolding env bind_cxt id rhs_ty arity unf++  | freshly_born_join_point id+  = -- This is a tricky one!+    -- See wrinkle (JU1) in Note [Do not add unfoldings to join points at birth]+    return noUnfolding+   | isExitJoinId id-  = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify+  = -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify+    return noUnfolding+   | otherwise-  = -- Otherwise, we end up retaining all the SimpleEnv-    let !opts = seUnfoldingOpts env-    in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs+  = mkLetUnfolding env (bindContextLevel bind_cxt) VanillaSrc id is_join_point new_rhs +  where+    is_join_point = isJoinId id+    freshly_born_join_point id = is_join_point && isManyOccs (idOccInfo id)+      -- OLD: too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627+ --------------------mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource-               -> InId -> OutExpr -> SimplM Unfolding-mkLetUnfolding !uf_opts top_lvl src id new_rhs-  = return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs Nothing)+mkLetUnfolding :: SimplEnv -> TopLevelFlag -> UnfoldingSource+               -> InId -> Bool    -- True <=> this is a join point+               -> OutExpr -> SimplM Unfolding+mkLetUnfolding env top_lvl src id is_join new_rhs+  = return (mkUnfolding uf_opts src is_top_lvl is_bottoming is_join new_rhs Nothing)             -- We make an  unfolding *even for loop-breakers*.             -- Reason: (a) It might be useful to know that they are WHNF             --         (b) In GHC.Iface.Tidy we currently assume that, if we want to@@ -4323,8 +4521,11 @@             --             to expose.  (We could instead use the RHS, but currently             --             we don't.)  The simple thing is always to have one.   where-    -- Might as well force this, profiles indicate up to 0.5MB of thunks-    -- just from this site.+    -- !opts: otherwise, we end up retaining all the SimpleEnv+    !uf_opts = seUnfoldingOpts env++    -- Might as well force this, profiles indicate up to+    -- 0.5MB of thunks just from this site.     !is_top_lvl   = isTopLevel top_lvl     -- See Note [Force bottoming field]     !is_bottoming = isDeadEndId id@@ -4379,14 +4580,13 @@                             -- See Note [Top-level flag on inline rules] in GHC.Core.Unfold                    _other              -- Happens for INLINABLE things-                     -> mkLetUnfolding uf_opts top_lvl src id expr' }+                     -> mkLetUnfolding env top_lvl src id False expr' }                 -- If the guidance is UnfIfGoodArgs, this is an INLINABLE                 -- unfolding, and we need to make sure the guidance is kept up                 -- to date with respect to any changes in the unfolding.          | otherwise -> return noUnfolding   -- Discard unstable unfoldings   where-    uf_opts    = seUnfoldingOpts env     -- Forcing this can save about 0.5MB of max residency and the result     -- is small and easy to compute so might as well force it.     top_lvl     = bindContextLevel bind_cxt
compiler/GHC/Core/Opt/Simplify/Monad.hs view
@@ -219,7 +219,6 @@              join_arity = length bndrs              details    = JoinId join_arity Nothing              id_info    = vanillaIdInfo `setArityInfo` arity---                                        `setOccInfo` strongLoopBreaker         ; return (mkLocalVar details name ManyTy join_id_ty id_info) }
compiler/GHC/Core/Opt/Simplify/Utils.hs view
@@ -13,7 +13,7 @@          -- Inlining,         preInlineUnconditionally, postInlineUnconditionally,-        activeUnfolding, activeRule,+        activeRule,         getUnfoldingInRuleMatch,         updModeForStableUnfoldings, updModeForRules, @@ -48,7 +48,7 @@ import GHC.Core import GHC.Types.Literal ( isLitRubbish ) import GHC.Core.Opt.Simplify.Env-import GHC.Core.Opt.Simplify.Inline+import GHC.Core.Opt.Simplify.Inline( smallEnoughToInline ) import GHC.Core.Opt.Stats ( Tick(..) ) import qualified GHC.Core.Subst import GHC.Core.Ppr@@ -74,7 +74,6 @@ import GHC.Types.Var.Set import GHC.Types.Basic -import GHC.Data.Maybe ( orElse ) import GHC.Data.OrdList ( isNilOL ) import GHC.Data.FastString ( fsLit ) @@ -164,9 +163,12 @@     | CastIt              -- (CastIt co K)[e] = K[ e `cast` co ]-        OutCoercion             -- The coercion simplified+      { sc_co   :: OutCoercion  -- The coercion simplified                                 -- Invariant: never an identity coercion-        SimplCont+      , sc_opt  :: Bool         -- True <=> sc_co has had optCoercion applied to it+                                --      See Note [Avoid re-simplifying coercions]+                                --      in GHC.Core.Opt.Simplify.Iteration+      , sc_cont :: SimplCont }    | ApplyToVal         -- (ApplyToVal arg K)[e] = K[ e arg ]       { sc_dup     :: DupFlag   -- See Note [DupFlag invariants]@@ -275,8 +277,10 @@     = text "Stop" <> brackets (sep $ punctuate comma pps) <+> ppr ty     where       pps = [ppr interesting] ++ [ppr eval_sd | eval_sd /= topSubDmd]-  ppr (CastIt co cont  )    = (text "CastIt" <+> pprOptCo co) $$ ppr cont-  ppr (TickIt t cont)       = (text "TickIt" <+> ppr t) $$ ppr cont+  ppr (CastIt { sc_co = co, sc_cont = cont })+    = (text "CastIt" <+> pprOptCo co) $$ ppr cont+  ppr (TickIt t cont)+    = (text "TickIt" <+> ppr t) $$ ppr cont   ppr (ApplyToTy  { sc_arg_ty = ty, sc_cont = cont })     = (text "ApplyToTy" <+> pprParendType ty) $$ ppr cont   ppr (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_cont = cont, sc_hole_ty = hole_ty })@@ -287,9 +291,9 @@     = (text "StrictBind" <+> ppr b) $$ ppr cont   ppr (StrictArg { sc_fun = ai, sc_cont = cont })     = (text "StrictArg" <+> ppr (ai_fun ai)) $$ ppr cont-  ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont })+  ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_cont = cont })     = (text "Select" <+> ppr dup <+> ppr bndr) $$-       whenPprDebug (nest 2 $ vcat [ppr (seTvSubst se), ppr alts]) $$ ppr cont+      whenPprDebug (nest 2 $ ppr alts) $$ ppr cont   {- Note [The hole type in ApplyToTy]@@ -353,6 +357,7 @@           , as_hole_ty :: OutType }   -- Type of the function (presumably forall a. blah)    | CastBy OutCoercion                -- Cast by this; c.f. CastIt+                                      -- Coercion is optimised  instance Outputable ArgInfo where   ppr (ArgInfo { ai_fun = fun, ai_args = args, ai_dmds = dmds })@@ -415,7 +420,8 @@   = ApplyToVal { sc_arg = arg, sc_env = env, sc_dup = Simplified                  -- The SubstEnv will be ignored since sc_dup=Simplified                , sc_hole_ty = hole_ty, sc_cont = cont }-pushSimplifiedArg _ (CastBy c) cont = CastIt c cont+pushSimplifiedArg _ (CastBy c) cont+  = CastIt { sc_co = c, sc_cont = cont, sc_opt = True }  argInfoExpr :: OutId -> [ArgSpec] -> OutExpr -- NB: the [ArgSpec] is reversed so that the first arg@@ -472,7 +478,7 @@ ------------------- contIsRhs :: SimplCont -> Maybe RecFlag contIsRhs (Stop _ (RhsCtxt is_rec) _) = Just is_rec-contIsRhs (CastIt _ k)                = contIsRhs k   -- For f = e |> co, treat e as Rhs context+contIsRhs (CastIt { sc_cont = k })    = contIsRhs k   -- For f = e |> co, treat e as Rhs context contIsRhs _                           = Nothing  -------------------@@ -486,7 +492,7 @@ contIsDupable (ApplyToVal { sc_dup = OkToDup }) = True -- See Note [DupFlag invariants] contIsDupable (Select { sc_dup = OkToDup })     = True -- ...ditto... contIsDupable (StrictArg { sc_dup = OkToDup })  = True -- ...ditto...-contIsDupable (CastIt _ k)                      = contIsDupable k+contIsDupable (CastIt { sc_cont = k })          = contIsDupable k contIsDupable _                                 = False  -------------------@@ -495,13 +501,13 @@ contIsTrivial (ApplyToTy { sc_cont = k })                       = contIsTrivial k -- This one doesn't look right.  A value application is not trivial -- contIsTrivial (ApplyToVal { sc_arg = Coercion _, sc_cont = k }) = contIsTrivial k-contIsTrivial (CastIt _ k)                                      = contIsTrivial k+contIsTrivial (CastIt { sc_cont = k })                          = contIsTrivial k contIsTrivial _                                                 = False  ------------------- contResultType :: SimplCont -> OutType contResultType (Stop ty _ _)                = ty-contResultType (CastIt _ k)                 = contResultType k+contResultType (CastIt { sc_cont = k })     = contResultType k contResultType (StrictBind { sc_cont = k }) = contResultType k contResultType (StrictArg { sc_cont = k })  = contResultType k contResultType (Select { sc_cont = k })     = contResultType k@@ -512,7 +518,7 @@ contHoleType :: SimplCont -> OutType contHoleType (Stop ty _ _)                    = ty contHoleType (TickIt _ k)                     = contHoleType k-contHoleType (CastIt co _)                    = coercionLKind co+contHoleType (CastIt { sc_co = co })          = coercionLKind co contHoleType (StrictBind { sc_bndr = b, sc_dup = dup, sc_env = se })   = perhapsSubstTy dup se (idType b) contHoleType (StrictArg  { sc_fun_ty = ty })  = funArgTy ty@@ -532,7 +538,8 @@ -- case-of-case transformation. contHoleScaling :: SimplCont -> Mult contHoleScaling (Stop _ _ _) = OneTy-contHoleScaling (CastIt _ k) = contHoleScaling k+contHoleScaling (CastIt { sc_cont = k })+  = contHoleScaling k contHoleScaling (StrictBind { sc_bndr = id, sc_cont = k })   = idMult id `mkMultMul` contHoleScaling k contHoleScaling (Select { sc_bndr = id, sc_cont = k })@@ -551,14 +558,14 @@ -- and other values; skipping over casts. countArgs (ApplyToTy  { sc_cont = cont }) = 1 + countArgs cont countArgs (ApplyToVal { sc_cont = cont }) = 1 + countArgs cont-countArgs (CastIt _ cont)                 = countArgs cont+countArgs (CastIt     { sc_cont = cont }) = countArgs cont countArgs _                               = 0  countValArgs :: SimplCont -> Int -- Count value arguments only countValArgs (ApplyToTy  { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont-countValArgs (CastIt _ cont)                 = countValArgs cont+countValArgs (CastIt     { sc_cont = cont }) = countValArgs cont countValArgs _                               = 0  -------------------@@ -578,7 +585,7 @@     go args (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = k })                                         = go (is_interesting arg se : args) k     go args (ApplyToTy { sc_cont = k }) = go args k-    go args (CastIt _ k)                = go args k+    go args (CastIt { sc_cont = k })    = go args k     go args k                           = (False, reverse args, k)      is_interesting arg se = interestingArg se arg@@ -597,10 +604,10 @@ -- about what to do then and no call sites so far seem to care. contEvalContext :: SimplCont -> SubDemand contEvalContext k = case k of-  (Stop _ _ sd)              -> sd-  (TickIt _ k)               -> contEvalContext k-  (CastIt _ k)               -> contEvalContext k-  ApplyToTy{sc_cont=k}       -> contEvalContext k+  Stop _ _ sd              -> sd+  TickIt _ k               -> contEvalContext k+  CastIt   { sc_cont = k } -> contEvalContext k+  ApplyToTy{ sc_cont = k } -> contEvalContext k     --  ApplyToVal{sc_cont=k}      -> mkCalledOnceDmd $ contEvalContext k     -- Not 100% sure that's correct, . Here's an example:     --   f (e x) and f :: <SC(S,C(1,L))>@@ -796,45 +803,87 @@           True  -> Just x           False -> Just (x-1) -Now consider these cases:+Now consider these variants of+   case (f x) of ... -1. case f x of b{-dead-} { DEFAULT -> blah[no b] }-     Inlining (f x) will allow us to avoid ever allocating (Just x),-     since the case binder `b` is dead.  We will end up with a+1. [Dead case binder]: inline f+      case f x of b{-dead-} { DEFAULT -> blah[no b] }+   Inlining (f x) will allow us to avoid ever allocating (Just x),+   since the case binder `b` is dead.  We will end up with a      join point for blah, thus          join j = blah in          case v of { True -> j; False -> j }-     which will turn into (case v of DEFAULT -> blah-     All good--2. case f x of b { DEFAULT -> blah[b] }-     Inlining (f x) will still mean we allocate (Just x). We'd get:-         join j b = blah[b]-         case v of { True -> j (Just x); False -> j (Just (x-1)) }-     No new optimisations are revealed. Nothing is gained.-     (This is the situation in T22317.)--2a. case g x of b { (x{-dead-}, x{-dead-}) -> blah[b, no x, no y] }-      Instead of DEFAULT we have a single constructor alternative-      with all dead binders.  This is just a variant of (2); no-      gain from inlining (f x)+   which will turn into (case v of DEFAULT -> blah)+   All good -3. case f x of b { Just y -> blah[y,b] }-     Inlining (f x) will mean we still allocate (Just x),-     but we also get to bind `y` without fetching it out of the Just, thus+2. [Live case binder, live alt binders]: inline f+       case f x of b { Just y -> blah[y,b] }+   Inlining (f x) will mean we still allocate (Just x),+   but we also get to bind `y` without fetching it out of the Just, thus          join j y b = blah[y,b]          case v of { True -> j x (Just x)                    ; False -> let y = x-1 in j y (Just y) }    Inlining (f x) has a small benefit, perhaps.    (To T14955 it makes a surprisingly large difference of ~30% to inline here.) +3. [Live case binder, dead alt binders]: maybe don't inline f+      case f x of b { DEFAULT -> blah[b] }+   Inlining (f x) will still mean we allocate (Just x). We'd get:+         join j b = blah[b]+         case v of { True -> j (Just x); False -> j (Just (x-1)) }+   No new optimisations are revealed. Nothing is gained.+   (This is the situation in T22317.) -Conclusion: if the case expression-  * Has a non-dead case-binder-  * Has one alternative+   A variant is when we have a data constructor with dead binders:+       case g x of b { (x{-dead-}, x{-dead-}) -> blah[b, no x, no y] }+   Instead of DEFAULT we have a single constructor alternative+   with all dead binders.  Again, no gain from inlining (f x)++4. [Live case binder, dead alt binders]: small f+   Suppose f is CPR'd, so it looks like+       f x = case $wf x of (# a #) -> Just a+   Then even in case (3) we want to inline:+      case f x of b { DEFAULT -> blah[b] }+   -->+      case $wf x of (# a #) ->+      let b = Just a in blah[b]+   This is very good; we now know a lot about `b` (instead of nothing)+   and `blah` might benefit.  Similarly if `f` has a join point+      f x = join $j y = Just y in ...+   Again the case (f x) is now consuming a constructor (Just y).++   This is very like the situation described in Note [RHS of lets]+   in GHC.Core.Opt.Simplify.Inline; (case e of b -> blah) is just+   like a strict `let`.++Conclusion: in interestingCallCtxt, a case-expression (i.e. Select continuation)+usually gives a CaseCtxt (cases 1,2); but when (cases 3,4):+  * It has a non-dead case-binder+  * It has one alternative   * All the binders in the alternative are dead-then the `case` is just a strict let-binding, and the scrutinee is-BoringCtxt (don't inline).  Otherwise CaseCtxt.+then the `case` is just a strict let-binding, so use RhsCtxt NonRecursive.+This RhsCtxt gives a small incentive for small functions to inline.+That incentive is what is needed in case (4).++Wrinkle (SB1).  The 'small incentive' is implemented by `calc_some_benefit` in+GHC.Core.Opt.Simplify.Inline.tryUnfolding.  We restrict the incentive just to+funtions that have unfolding guidance of `UnfWhen`, which particularly includes+wrappers created by CPR, exactly case (4) above.  Without this limitation I+got too much fruitless inlining, which led to regressions (#22317 is an example).++A good example of a function where this 'small incentive' is important is+GHC.Num.Integer where we ended up with calls like this:+     case (integerSignum a b) of r -> ...+but were failing to inline integerSignum, even though it always returns+a single constructor, so it is very helpful to inline it. There is also an+issue of confluence-of-the-simplifier.  Suppose we have+    f x = case x of r -> ...+and the Simplifier sees+    f (integerSigNum a b)+Because `f` scrutines `x`, the unfolding guidance for f gives a discount+for `x`; and that discount makes interestingCallContext for the context+`f <>` return DiscArgCtxt, which again gives that incentive.  We don't want+the incentive to disappear when we inline `f`! -}  lazyArgContext :: ArgInfo -> CallCtxt@@ -869,7 +918,7 @@       | not (seCaseCase env)         = BoringCtxt -- See Note [No case of case is boring]       | [Alt _ bs _] <- alts       , all isDeadBinder bs-      , not (isDeadBinder case_bndr) = BoringCtxt -- See Note [Seq is boring]+      , not (isDeadBinder case_bndr) = RhsCtxt NonRecursive -- See Note [Seq is boring]       | otherwise                    = CaseCtxt  @@ -884,7 +933,7 @@     interesting (Stop _ cci _)               = cci     interesting (TickIt _ k)                 = interesting k     interesting (ApplyToTy { sc_cont = k })  = interesting k-    interesting (CastIt _ k)                 = interesting k+    interesting (CastIt { sc_cont = k })     = interesting k         -- If this call is the arg of a strict function, the context         -- is a bit interesting.  If we inline here, we may get useful         -- evaluation information to avoid repeated evals: e.g.@@ -924,7 +973,7 @@   where     go (ApplyToVal { sc_cont = cont }) = go cont     go (ApplyToTy  { sc_cont = cont }) = go cont-    go (CastIt _ cont)                 = go cont+    go (CastIt { sc_cont = cont })     = go cont     go (StrictArg { sc_fun = fun })    = ai_encl fun     go (Stop _ RuleArgCtxt _)          = True     go (TickIt _ c)                    = go c@@ -995,17 +1044,41 @@                                  env' = env `addNewInScopeIds` bindersOf b      go_var n v-       | isConLikeId v     = ValueArg   -- Experimenting with 'conlike' rather that-                                        --    data constructors here-       | idArity v > n     = ValueArg   -- Catches (eg) primops with arity but no unfolding-       | n > 0             = NonTrivArg -- Saturated or unknown call-       | conlike_unfolding = ValueArg   -- n==0; look for an interesting unfolding-                                        -- See Note [Conlike is interesting]-       | otherwise         = TrivArg    -- n==0, no useful unfolding-       where-         conlike_unfolding = isConLikeUnfolding (idUnfolding v)+       | isConLikeId v = ValueArg   -- Experimenting with 'conlike' rather that+                                    --    data constructors here+                                    -- DFuns are con-like; see Note [Conlike is interesting]+       | idArity v > n = ValueArg   -- Catches (eg) primops with arity but no unfolding+       | n > 0         = NonTrivArg -- Saturated or unknown call+       | otherwise  -- n==0, no value arguments; look for an interesting unfolding+       = case idUnfolding v of+           OtherCon [] -> NonTrivArg   -- It's evaluated, but that's all we know+           OtherCon _  -> ValueArg     -- Evaluated and we know it isn't these constructors+              -- See Note [OtherCon and interestingArg]+           DFunUnfolding {} -> ValueArg   -- We konw that idArity=0+           CoreUnfolding{ uf_cache = cache }+             | uf_is_conlike cache -> ValueArg    -- Includes constructor applications+             | uf_is_value cache   -> NonTrivArg  -- Things like partial applications+             | otherwise           -> TrivArg+           BootUnfolding           -> TrivArg+           NoUnfolding             -> TrivArg -{-+{- Note [OtherCon and interestingArg]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+interstingArg returns+   (a) NonTrivArg for an arg with an OtherCon [] unfolding+   (b) ValueArg for an arg with an OtherCon [c1,c2..] unfolding.++Reason for (a): I found (in the GHC.Num.Integer library) that I was+inlining a pretty big function when all we knew was that its arguments+were evaluated, nothing more.  That in turn make the enclosing function+too big to inline elsewhere.++Reason for (b): we want to inline integerCompare here+  integerLt# :: Integer -> Integer -> Bool#+  integerLt# (IS x) (IS y)                  = x <# y+  integerLt# x y | LT <- integerCompare x y = 1#+  integerLt# _ _                            = 0#+ ************************************************************************ *                                                                      *                   SimplMode@@ -1226,19 +1299,6 @@ continuation. -} -activeUnfolding :: SimplMode -> Id -> Bool-activeUnfolding mode id-  | isCompulsoryUnfolding (realIdUnfolding id)-  = True   -- Even sm_inline can't override compulsory unfoldings-  | otherwise-  = isActive (sm_phase mode) (idInlineActivation id)-  && sm_inline mode-      -- `or` isStableUnfolding (realIdUnfolding id)-      -- Inline things when-      --  (a) they are active-      --  (b) sm_inline says so, except that for stable unfoldings-      --                         (ie pragmas) we inline anyway- getUnfoldingInRuleMatch :: SimplEnv -> InScopeEnv -- When matching in RULE, we want to "look through" an unfolding -- (to see a constructor) if *rules* are on, even if *inlinings*@@ -1529,15 +1589,14 @@  postInlineUnconditionally     :: SimplEnv -> BindContext-    -> OutId            -- The binder (*not* a CoVar), including its unfolding-    -> OccInfo          -- From the InId+    -> InId -> OutId    -- The binder (*not* a CoVar), including its unfolding     -> OutExpr     -> Bool -- Precondition: rhs satisfies the let-can-float invariant -- See Note [Core let-can-float invariant] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, --         for unlifted, side-effect-ful bindings-postInlineUnconditionally env bind_cxt bndr occ_info rhs+postInlineUnconditionally env bind_cxt old_bndr bndr rhs   | not active                  = False   | isWeakLoopBreaker occ_info  = False -- If it's a loop-breaker of any kind, don't inline                                         -- because it might be referred to "earlier"@@ -1545,40 +1604,33 @@   | isTopLevel (bindContextLevel bind_cxt)                                 = False -- Note [Top level and postInlineUnconditionally]   | exprIsTrivial rhs           = True-  | BC_Join {} <- bind_cxt              -- See point (1) of Note [Duplicating join points]-  , not (phase == FinalPhase)   = False -- in Simplify.hs+  | BC_Join {} <- bind_cxt      = False -- See point (1) of Note [Duplicating join points]+                                        --     in GHC.Core.Opt.Simplify.Iteration   | otherwise   = case occ_info of       OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt, occ_n_br = n_br }         -- See Note [Inline small things to avoid creating a thunk] -        -> n_br < 100  -- See Note [Suppress exponential blowup]+        | n_br >= 100 -> False  -- See #23627 -           && smallEnoughToInline uf_opts unfolding     -- Small enough to dup-                        -- ToDo: consider discount on smallEnoughToInline if int_cxt is true-                        ---                        -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1-                        -- Reason: doing so risks exponential behaviour.  We simplify a big-                        --         expression, inline it, and simplify it again.  But if the-                        --         very same thing happens in the big expression, we get-                        --         exponential cost!-                        -- PRINCIPLE: when we've already simplified an expression once,-                        -- make sure that we only inline it if it's reasonably small.+        | n_br == 1, NotInsideLam <- in_lam  -- One syntactic occurrence+        -> True                              -- See Note [Post-inline for single-use things] -           && (in_lam == NotInsideLam ||-                        -- Outside a lambda, we want to be reasonably aggressive-                        -- about inlining into multiple branches of case-                        -- e.g. let x = <non-value>-                        --      in case y of { C1 -> ..x..; C2 -> ..x..; C3 -> ... }-                        -- Inlining can be a big win if C3 is the hot-spot, even if-                        -- the uses in C1, C2 are not 'interesting'-                        -- An example that gets worse if you add int_cxt here is 'clausify'+--        | is_unlifted                        -- Unlifted binding, hence ok-for-spec+--        -> True                              -- hence cheap to inline probably just a primop+--                                             -- Not a big deal either way+-- No, this is wrong.  {v = p +# q; x = K v}.+-- Don't inline v; it'll just get floated out again. Stupid. -                (isCheapUnfolding unfolding && int_cxt == IsInteresting))-                        -- isCheap => acceptable work duplication; in_lam may be true-                        -- int_cxt to prevent us inlining inside a lambda without some-                        -- good reason.  See the notes on int_cxt in preInlineUnconditionally+        | is_demanded+        -> False                            -- No allocation (it'll be a case expression in the end)+                                            -- so inlining duplicates code but nothing more +        | otherwise+        -> work_ok in_lam int_cxt && smallEnoughToInline uf_opts unfolding+              -- Multiple syntactic occurences; but lazy, and small enough to dup+              -- ToDo: consider discount on smallEnoughToInline if int_cxt is true+       IAmDead -> True   -- This happens; for example, the case_bndr during case of                         -- known constructor:  case (a,b) of x { (p,q) -> ... }                         -- Here x isn't mentioned in the RHS, so we don't want to@@ -1586,23 +1638,29 @@        _ -> False --- Here's an example that we don't handle well:---      let f = if b then Left (\x.BIG) else Right (\y.BIG)---      in \y. ....case f of {...} ....--- Here f is used just once, and duplicating the case work is fine (exprIsCheap).--- But---  - We can't preInlineUnconditionally because that would invalidate---    the occ info for b.---  - We can't postInlineUnconditionally because the RHS is big, and---    that risks exponential behaviour---  - We can't call-site inline, because the rhs is big--- Alas!-   where-    unfolding = idUnfolding bndr-    uf_opts   = seUnfoldingOpts env-    phase     = sePhase env-    active    = isActive phase (idInlineActivation bndr)+    work_ok NotInsideLam _              = True+    work_ok IsInsideLam  IsInteresting  = isCheapUnfolding unfolding+    work_ok IsInsideLam  NotInteresting = False+      -- NotInsideLam: outside a lambda, we want to be reasonably aggressive+      -- about inlining into multiple branches of case+      -- e.g. let x = <non-value>+      --      in case y of { C1 -> ..x..; C2 -> ..x..; C3 -> ... }+      -- Inlining can be a big win if C3 is the hot-spot, even if+      -- the uses in C1, C2 are not 'interesting'+      -- An example that gets worse if you add int_cxt here is 'clausify'++      -- InsideLam: check for acceptable work duplication, using isCheapUnfoldign+      -- int_cxt to prevent us inlining inside a lambda without some+      -- good reason.  See the notes on int_cxt in preInlineUnconditionally++--    is_unlifted = isUnliftedType (idType bndr)+    is_demanded = isStrUsedDmd (idDemandInfo bndr)+    occ_info    = idOccInfo old_bndr+    unfolding   = idUnfolding bndr+    uf_opts     = seUnfoldingOpts env+    phase       = sePhase env+    active      = isActive phase (idInlineActivation bndr)         -- See Note [pre/postInlineUnconditionally in gentle mode]  {- Note [Inline small things to avoid creating a thunk]@@ -1623,38 +1681,52 @@ to allocate more.  An egregious example is test perf/compiler/T14697, where GHC.Driver.CmdLine.$wprocessArgs allocated hugely more. -Note [Suppress exponential blowup]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-In #13253, and several related tickets, we got an exponential blowup-in code size from postInlineUnconditionally.  The trouble comes when-we have-  let j1a = case f y     of { True -> p;   False -> q }-      j1b = case f y     of { True -> q;   False -> p }-      j2a = case f (y+1) of { True -> j1a; False -> j1b }-      j2b = case f (y+1) of { True -> j1b; False -> j1a }-      ...-  in case f (y+10) of { True -> j10a; False -> j10b }+Note [Post-inline for single-use things]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we have -when there are many branches. In pass 1, postInlineUnconditionally-inlines j10a and j10b (they are both small).  Now we have two calls-to j9a and two to j9b.  In pass 2, postInlineUnconditionally inlines-all four of these calls, leaving four calls to j8a and j8b. Etc.-Yikes!  This is exponential!+   let x = rhs in ...x... -A possible plan: stop doing postInlineUnconditionally-for some fixed, smallish number of branches, say 4. But that turned-out to be bad: see Note [Inline small things to avoid creating a thunk].-And, as it happened, the problem with #13253 was solved in a-different way (Note [Duplicating StrictArg] in Simplify).+and `x` is used exactly once, and not inside a lambda, then we will usually+preInlineUnconditinally. But we can still get this situation in+postInlineUnconditionally: -So I just set an arbitrary, high limit of 100, to stop any-totally exponential behaviour.+  case K rhs of K x -> ...x.... -This still leaves the nasty possibility that /ordinary/ inlining (not-postInlineUnconditionally) might inline these join points, each of-which is individually quiet small.  I'm still not sure what to do-about this (e.g. see #15488).+Here we'll use `simplAuxBind` to bind `x` to (the already-simplified) `rhs`;+and `x` is used exactly once.  It's beneficial to inline right away; otherwise+we risk creating +   let x = rhs in ...x...++which will take another iteration of the Simplifier to eliminate.  We do this in+two places++1. In the full `postInlineUnconditionally` look for the special case+   of "one occurrence, not under a lambda", and inline unconditionally then.++   This is a bit risky: see Note [Avoiding simplifying repeatedly] in+   Simplify.Iteration.  But in practice it seems to be a small win.++2. `simplAuxBind` does a kind of poor-man's `postInlineUnconditionally`.  It+   does not need to account for many of the cases (e.g. top level) that the+   full `postInlineUnconditionally` does.  Moreover, we don't have an+   OutId, which `postInlineUnconditionally` needs.  I got a slight improvement+   in compiler performance when I added this test.++Here's an example that we don't currently handle well:+     let f = if b then Left (\x.BIG) else Right (\y.BIG)+     in \y. ....case f of {...} ....+Here f is used just once, and duplicating the case work is fine (exprIsCheap).+But+ - We can't preInlineUnconditionally because that would invalidate+   the occ info for b.+ - We can't postInlineUnconditionally because the RHS is big, and+   that risks exponential behaviour+ - We can't call-site inline, because the rhs is big+Alas!++ Note [Top level and postInlineUnconditionally] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We don't do postInlineUnconditionally for top-level things (even for@@ -2231,7 +2303,7 @@       = (poly_id `setIdUnfolding` unf, poly_rhs)       where         poly_rhs = mkLams tvs_here rhs-        unf = mkUnfolding uf_opts VanillaSrc is_top_lvl False poly_rhs Nothing+        unf = mkUnfolding uf_opts VanillaSrc is_top_lvl False False poly_rhs Nothing          -- We want the unfolding.  Consider         --      let@@ -2362,7 +2434,25 @@                     Var v -> otherCons (idUnfolding v)                     _     -> [] +{- Note [Merging nested cases]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The basic case-merge stuff is described in Note [Merge Nested Cases] in GHC.Core.Utils +We do it here in `prepareAlts` (on InAlts) rather than after (on OutAlts) for two reasons:++* It "belongs" here with `filterAlts`, `refineDefaultAlt` and `combineIdenticalAlts`.++* In test perf/compiler/T22428 I found that I was getting extra Simplifer iterations:+    1. Create a join point+    2. That join point gets inlined at all call sites, so it is now dead.+    3. Case-merge happened, but left behind some trivial bindings (see `mergeCaseAlts`)+    4. Get rid of the trivial bindings+  The first two seem reasonable.  It's imaginable that we could do better on+  (3), by making case-merge join-point-aware, but it's not trivial.  But the+  fourth is just stupid.  Rather than always do an extra iteration, it's better+  to do the transformation on the input-end of teh Simplifier.+-}+ {- ************************************************************************ *                                                                      *@@ -2372,66 +2462,9 @@  mkCase tries these things -* Note [Merge Nested Cases] * Note [Eliminate Identity Case] * Note [Scrutinee Constant Folding] -Note [Merge Nested Cases]-~~~~~~~~~~~~~~~~~~~~~~~~~-       case e of b {             ==>   case e of b {-         p1 -> rhs1                      p1 -> rhs1-         ...                             ...-         pm -> rhsm                      pm -> rhsm-         _  -> case b of b' {            pn -> let b'=b in rhsn-                     pn -> rhsn          ...-                     ...                 po -> let b'=b in rhso-                     po -> rhso          _  -> let b'=b in rhsd-                     _  -> rhsd-       }--which merges two cases in one case when -- the default alternative of-the outer case scrutinises the same variable as the outer case. This-transformation is called Case Merging.  It avoids that the same-variable is scrutinised multiple times.--Wrinkles--(MC1) `tryCaseMerge` "looks though" an inner single-alternative case-on-variable.-     For example-       case x of {-          ...outer-alts...-          DEFAULT -> case y of (a,b) ->-                     case x of { A -> rhs1; B -> rhs2 }-    ===>-       case x of-         ...outer-alts...-         a -> case y of (a,b) -> rhs1-         B -> case y of (a,b) -> rhs2--    This duplicates the `case y` but it removes the case x; so it is a win-    in terms of execution time (combining the cases on x) at the cost of-    perhaps duplicating the `case y`.  A case in point is integerEq, which-    is defined thus-        integerEq :: Integer -> Integer -> Bool-        integerEq !x !y = isTrue# (integerEq# x y)-    which becomes-        integerEq-          = \ (x :: Integer) (y_aAL :: Integer) ->-              case x of x1 { __DEFAULT ->-              case y of y1 { __DEFAULT ->-              case x1 of {-                IS x2 -> case y1 of {-                           __DEFAULT -> GHC.Types.False;-                           IS y2     -> tagToEnum# @Bool (==# x2 y2) };-                IP x2 -> ...-                IN x2 -> ...-    We want to merge the outer `case x` with the inner `case x1`.--    This story is not fully robust; it will be defeated by a let-binding,-    whih we don't want to duplicate.   But accounting for single-alternative-    case-on-variable is easy to do, and seems useful in common cases so-    `tryMergeCase` does it.- Note [Eliminate Identity Case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~         case e of               ===> e@@ -2523,7 +2556,6 @@   see Note [caseRules for dataToTag] in GHC.Core.Opt.ConstantFold  - Note [Example of case-merging and caseRules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The case-transformation rules are quite powerful. Here's a@@ -2609,14 +2641,18 @@  -------------------------------------------------- --      1. Merge Nested Cases+--         See Note [Merge Nested Cases]+--             Note [Example of case-merging and caseRules]+--             Note [Cascading case merge] --------------------------------------------------  mkCase mode scrut outer_bndr alts_ty alts   | sm_case_merge mode-  , Just alts' <- tryMergeCase outer_bndr alts+  , Just (joins, alts') <- mergeCaseAlts outer_bndr alts   = do  { tick (CaseMerge outer_bndr)-        ; mkCase1 mode scrut outer_bndr alts_ty alts' }-        -- Warning: don't call mkCase recursively!+        ; case_expr <- mkCase1 mode scrut outer_bndr alts_ty alts'+        ; return (mkLets joins case_expr) }+        -- mkCase1: don't call mkCase recursively!         -- Firstly, there's no point, because inner alts have already had         -- mkCase applied to them, so they won't have a case in their default         -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr@@ -2624,59 +2660,9 @@   | otherwise   = mkCase1 mode scrut outer_bndr alts_ty alts -tryMergeCase :: OutId -> [OutAlt] -> Maybe [OutAlt]--- See Note [Merge Nested Cases]-tryMergeCase outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)-  = case go 5 (\e -> e) emptyVarSet deflt_rhs of-       Nothing         -> Nothing-       Just inner_alts -> Just (mergeAlts outer_alts inner_alts)-                -- NB: mergeAlts gives priority to the left-                --      case x of-                --        A -> e1-                --        DEFAULT -> case x of-                --                      A -> e2-                --                      B -> e3-                -- When we merge, we must ensure that e1 takes-                -- precedence over e2 as the value for A!-  where-    go :: Int -> (OutExpr -> OutExpr) -> VarSet -> OutExpr -> Maybe [OutAlt]-    -- In the call (go wrap free_bndrs rhs), the `wrap` function has free `free_bndrs`;-    -- so do not push `wrap` under any binders that would shadow `free_bndrs`-    ---    -- The 'n' is just a depth-bound to avoid pathalogical quadratic behaviour with-    --   case x1 of DEFAULT -> case x2 of DEFAULT -> case x3 of DEFAULT -> ...-    -- when for each `case` we'll look down the whole chain to see if there is-    -- another `case` on that same variable.  Also all of these (case xi) evals-    -- get duplicated in each branch of the outer case, so 'n' controls how much-    -- duplication we are prepared to put up with.-    go 0 _ _ _ = Nothing--    go n wrap free_bndrs (Tick t rhs)-       = go n (wrap . Tick t) free_bndrs rhs-    go _ wrap free_bndrs (Case (Var inner_scrut_var) inner_bndr _ inner_alts)-       | inner_scrut_var == outer_bndr-       , let wrap_let rhs' | isDeadBinder inner_bndr = rhs'-                           | otherwise = Let (NonRec inner_bndr (Var outer_bndr)) rhs'-                              -- The let is OK even for unboxed binders,-             free_bndrs' = extendVarSet free_bndrs outer_bndr-       = Just [ assert (not (any (`elemVarSet` free_bndrs') bndrs)) $-                Alt con bndrs (wrap (wrap_let rhs))-              | Alt con bndrs rhs <- inner_alts ]-    go n wrap free_bndrs (Case (Var inner_scrut) inner_bndr ty inner_alts)-       | [Alt con bndrs rhs] <- inner_alts -- Wrinkle (MC1)-       , let wrap_case rhs' = Case (Var inner_scrut) inner_bndr ty $-                              tryMergeCase inner_bndr alts `orElse` alts-                where-                  alts = [Alt con bndrs rhs']-        = assert (not (outer_bndr `elem` (inner_bndr : bndrs))) $-         go (n-1) (wrap . wrap_case) (free_bndrs `extendVarSet` inner_scrut) rhs--    go _ _ _ _ = Nothing--tryMergeCase _ _ = Nothing- -------------------------------------------------- --      2. Eliminate Identity Case+--         See Note [Eliminate Identity Case] --------------------------------------------------  mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts')      -- Identity case@@ -2720,8 +2706,10 @@  mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts + -------------------------------------------------- --      2. Scrutinee Constant Folding+--         See Note [Scrutinee Constant Folding] --------------------------------------------------  mkCase2 mode scrut bndr alts_ty alts@@ -2840,64 +2828,4 @@ Note that dead-ness is maintained by the simplifier, so that it is accurate after simplification as well as before. --Note [Cascading case merge]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-Case merging should cascade in one sweep, because it-happens bottom-up--      case e of a {-        DEFAULT -> case a of b-                      DEFAULT -> case b of c {-                                     DEFAULT -> e-                                     A -> ea-                      B -> eb-        C -> ec-==>-      case e of a {-        DEFAULT -> case a of b-                      DEFAULT -> let c = b in e-                      A -> let c = b in ea-                      B -> eb-        C -> ec-==>-      case e of a {-        DEFAULT -> let b = a in let c = b in e-        A -> let b = a in let c = b in ea-        B -> let b = a in eb-        C -> ec---However here's a tricky case that we still don't catch, and I don't-see how to catch it in one pass:--  case x of c1 { I# a1 ->-  case a1 of c2 ->-    0 -> ...-    DEFAULT -> case x of c3 { I# a2 ->-               case a2 of ...--After occurrence analysis (and its binder-swap) we get this--  case x of c1 { I# a1 ->-  let x = c1 in         -- Binder-swap addition-  case a1 of c2 ->-    0 -> ...-    DEFAULT -> case x of c3 { I# a2 ->-               case a2 of ...--When we simplify the inner case x, we'll see that-x=c1=I# a1.  So we'll bind a2 to a1, and get--  case x of c1 { I# a1 ->-  case a1 of c2 ->-    0 -> ...-    DEFAULT -> case a1 of ...--This is correct, but we can't do a case merge in this sweep-because c2 /= a1.  Reason: the binding c1=I# a1 went inwards-without getting changed to c1=I# c2.--I don't think this is worth fixing, even if I knew how. It'll-all come out in the next pass anyway. -}
compiler/GHC/Core/Opt/Stats.hs view
@@ -179,6 +179,13 @@   transformations for the same reason as PreInlineUnconditionally,   so it's probably not innocuous anyway. +  One annoying variant is this.  CaseMerge introduces auxiliary bindings+     let b = b' in ...+  This takes another full run of the simplifier to elimiante.  But if+  the PostInlineUnconditionally, replacing b with b', is the only thing+  that happens in a Simplifier run, that probably really is innocuous.+  Perhaps an opportunity here.+ KnownBranch, BetaReduction:   May drop chunks of code, and thereby enable PreInlineUnconditionally   for some let-binding which now occurs once
compiler/GHC/Core/Predicate.hs view
@@ -12,7 +12,7 @@    -- Equality predicates   EqRel(..), eqRelRole,-  isEqPrimPred, isEqPred,+  isEqPrimPred, isNomEqPred, isReprEqPrimPred, isEqPred, isCoVarType,   getEqPredTys, getEqPredTys_maybe, getEqPredRole,   predTypeEqRel,   mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,@@ -27,7 +27,7 @@   -- Implicit parameters   isIPLikePred, mentionsIP, isIPTyCon, isIPClass,   isCallStackTy, isCallStackPred, isCallStackPredTy,-  isExceptionContextPred, isExceptionContextTy,+  isExceptionContextPred,   isIPPred_maybe,    -- Evidence variables@@ -39,6 +39,7 @@  import GHC.Core.Type import GHC.Core.Class+import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Var@@ -59,7 +60,7 @@   -- | 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.@@ -79,7 +80,7 @@ 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@@ -188,16 +189,15 @@       _ -> 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.+-- | Get the equality relation relevant for a pred type+-- Returns NomEq for dictionary predicates, etc predTypeEqRel :: PredType -> EqRel predTypeEqRel ty-  | Just (tc, _) <- splitTyConApp_maybe ty-  , tc `hasKey` eqReprPrimTyConKey-  = ReprEq-  | otherwise-  = NomEq+  | isReprEqPrimPred ty = ReprEq+  | otherwise           = NomEq  {------------------------------------------- Predicates on PredType@@ -218,20 +218,51 @@ 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@@ -239,10 +270,6 @@   | 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#)@@ -291,7 +318,7 @@   | otherwise   = Nothing --- | Is a type an 'ExceptionContext'?+-- | Is a type a 'CallStack'? isExceptionContextTy :: Type -> Bool isExceptionContextTy ty   | Just tc <- tyConAppTyCon_maybe ty@@ -337,38 +364,31 @@ isIPLikePred :: Type -> Bool -- Is `pred`, or any of its superclasses, an implicit parameter? -- See Note [Local implicit parameters]-isIPLikePred pred =-  mentions_ip_pred initIPRecTc (const True) (const True) pred+isIPLikePred pred = mentions_ip_pred initIPRecTc Nothing pred -mentionsIP :: (Type -> Bool) -- ^ predicate on the string-           -> (Type -> Bool) -- ^ predicate on the type-           -> Class-           -> [Type] -> Bool--- ^ @'mentionsIP' str_cond ty_cond cls tys@ returns @True@ if:------    - @cls tys@ is of the form @IP str ty@, where @str_cond str@ and @ty_cond ty@---      are both @True@,---    - or any superclass of @cls tys@ has this property.---+mentionsIP :: Type -> Class -> [Type] -> Bool+-- Is (cls tys) an implicit parameter with key `str_ty`, or+-- is any of its superclasses such at thing. -- See Note [Local implicit parameters]-mentionsIP = mentions_ip initIPRecTc+mentionsIP str_ty cls tys = mentions_ip initIPRecTc (Just str_ty) cls tys -mentions_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool-mentions_ip rec_clss str_cond ty_cond cls tys-  | Just (str_ty, ty) <- isIPPred_maybe cls tys-  = str_cond str_ty && ty_cond ty+mentions_ip :: RecTcChecker -> Maybe Type -> Class -> [Type] -> Bool+mentions_ip rec_clss mb_str_ty cls tys+  | Just (str_ty', _) <- isIPPred_maybe cls tys+  = case mb_str_ty of+       Nothing -> True+       Just str_ty -> str_ty `eqType` str_ty'   | otherwise-  = or [ mentions_ip_pred rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys)+  = or [ mentions_ip_pred rec_clss mb_str_ty (classMethodInstTy sc_sel_id tys)        | sc_sel_id <- classSCSelIds cls ] --mentions_ip_pred :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool-mentions_ip_pred rec_clss str_cond ty_cond ty+mentions_ip_pred :: RecTcChecker -> Maybe Type -> Type -> Bool+mentions_ip_pred  rec_clss mb_str_ty ty   | Just (cls, tys) <- getClassPredTys_maybe ty   , let tc = classTyCon cls   , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss                       else checkRecTc rec_clss tc-  = mentions_ip rec_clss' str_cond ty_cond cls tys+  = mentions_ip rec_clss' mb_str_ty cls tys   | otherwise   = False -- Includes things like (D []) where D is           -- a Constraint-ranged family; #7785@@ -435,38 +455,7 @@ * The superclass hunt stops when it encounters the same class again,   but in principle we could have the same class, differently instantiated,   and the second time it could have an implicit parameter-I'm going to treat these as problems for another day. They are all exotic.--Note [Using typesAreApart when calling mentionsIP]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We call 'mentionsIP' in two situations:--  (1) to check that a predicate does not contain any implicit parameters-      IP str ty, for a fixed literal str and any type ty,-  (2) to check that a predicate does not contain any HasCallStack or-      HasExceptionContext constraints.--In both of these cases, we want to be sure, so we should be conservative:--  For (1), the predicate might contain an implicit parameter IP Str a, where-  Str is a type family such as:--    type family MyStr where MyStr = "abc"--  To safeguard against this (niche) situation, instead of doing a simple-  type equality check, we use 'typesAreApart'. This allows us to recognise-  that 'IP MyStr a' contains an implicit parameter of the form 'IP "abc" ty'.--  For (2), we similarly might have--    type family MyCallStack where MyCallStack = CallStack--  Again, here we use 'typesAreApart'. This allows us to see that--    (?foo :: MyCallStack)--  is indeed a CallStack constraint, hidden under a type family.--}+I'm going to treat these as problems for another day. They are all exotic.  -}  {- ********************************************************************* *                                                                      *
compiler/GHC/Core/Rules.hs view
@@ -48,7 +48,7 @@ import GHC.Core.Subst import GHC.Core.SimpleOpt ( exprIsLambda_maybe ) import GHC.Core.FVs       ( exprFreeVars, bindFreeVars-                          , rulesFreeVarsDSet, exprsOrphNames )+                          , rulesFreeVarsDSet, orphNamesOfExprs ) import GHC.Core.Utils     ( exprType, mkTick, mkTicks                           , stripTicksTopT, stripTicksTopE                           , isJoinBind, mkCastMCo )@@ -207,7 +207,7 @@         -- Compute orphanhood.  See Note [Orphans] in GHC.Core.InstEnv         -- A rule is an orphan only if none of the variables         -- mentioned on its left-hand side are locally defined-    lhs_names = extendNameSet (exprsOrphNames args) fn+    lhs_names = extendNameSet (orphNamesOfExprs args) fn          -- Since rules get eventually attached to one of the free names         -- from the definition when compiling the ABI hash, we should make@@ -1239,7 +1239,7 @@           [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 view
@@ -29,27 +29,32 @@ 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)@@ -228,13 +233,14 @@     (env', r) = k env{soe_rec_ids = extendUnVarSetList bndrs (soe_rec_ids env)}  ----------------simple_opt_clo :: InScopeSet+simple_opt_clo :: HasDebugCallStack+               => InScopeSet                -> SimpleClo                -> OutExpr simple_opt_clo in_scope (e_env, e)   = simple_opt_expr (soeSetInScope in_scope e_env) e -simple_opt_expr :: HasCallStack => SimpleOptEnv -> InExpr -> OutExpr+simple_opt_expr :: HasDebugCallStack => SimpleOptEnv -> InExpr -> OutExpr simple_opt_expr env expr   = go expr   where@@ -397,7 +403,8 @@ simple_app env e as   = finish_app env (simple_opt_expr env e) as -finish_app :: SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr+finish_app :: HasDebugCallStack+           => SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr -- See Note [Eliminate casts in function position] finish_app env (Cast (Lam x e) co) as@(_:_)   | not (isTyVar x) && not (isCoVar x)@@ -510,6 +517,12 @@   = exprIsTrivial rhs                   -- Can duplicate     || safe_to_inline (idOccInfo bndr)  -- Occurs at most once +do_case_elim :: CoreExpr -> Id -> [Id] -> Bool+do_case_elim scrut case_bndr alt_bndrs+  =  exprIsHNF scrut+  && safe_to_inline (idOccInfo case_bndr)+  && all isDeadBinder alt_bndrs+ ------------------- simple_out_bind :: TopLevelFlag                 -> SimpleOptEnv@@ -764,6 +777,7 @@    unfolding_from_rhs = mkUnfolding uf_opts VanillaSrc                                     (isTopLevel top_level)                                     False -- may be bottom or not+                                    False -- Not a join point                                     new_rhs Nothing  wrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr@@ -1211,7 +1225,7 @@ This Note exists solely to document the problem. -} -data ConCont = CC [CoreExpr] Coercion+data ConCont = CC [CoreExpr] MCoercion                   -- Substitution already applied  -- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument@@ -1233,7 +1247,7 @@                    => InScopeEnv -> CoreExpr                    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr]) exprIsConApp_maybe ise@(ISE in_scope id_unf) expr-  = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr)))+  = go (Left in_scope) [] expr (CC [] MRefl)   where     go :: Either InScopeSet Subst              -- Left in-scope  means "empty substitution"@@ -1246,14 +1260,12 @@     go subst floats (Tick t expr) cont        | not (tickishIsCode t) = go subst floats expr cont -    go subst floats (Cast expr co1) (CC args co2)+    go subst floats (Cast expr co1) (CC args m_co2)        | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args             -- See Note [Push coercions in exprIsConApp_maybe]-       = case m_co1' of-           MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2))-           MRefl    -> go subst floats expr (CC args' co2)+       = go subst floats expr (CC args' (m_co1' `mkTransMCo` m_co2)) -    go subst floats (App fun arg) (CC args co)+    go subst floats (App fun arg) (CC args mco)        | let arg_type = exprType arg        , not (isTypeArg arg) && needsCaseBinding arg_type arg        -- An unlifted argument that’s not ok for speculation must not simply be@@ -1276,17 +1288,17 @@              bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type)              float = FloatCase arg' bndr DEFAULT []              subst' = subst_extend_in_scope subst bndr-         in go subst' (float:floats) fun (CC (Var bndr : args) co)+         in go subst' (float:floats) fun (CC (Var bndr : args) mco)        | otherwise-       = go subst floats fun (CC (subst_expr subst arg : args) co)+       = go subst floats fun (CC (subst_expr subst arg : args) mco) -    go subst floats (Lam bndr body) (CC (arg:args) co)+    go subst floats (Lam bndr body) (CC (arg:args) mco)        | do_beta_by_substitution bndr arg-       = go (extend subst bndr arg) floats body (CC args co)+       = go (extend subst bndr arg) floats body (CC args mco)        | otherwise        = let (subst', bndr') = subst_bndr subst bndr              float           = FloatLet (NonRec bndr' arg)-         in go subst' (float:floats) body (CC args co)+         in go subst' (float:floats) body (CC args mco)      go subst floats (Let (NonRec bndr rhs) expr) cont        | not (isJoinId bndr)@@ -1297,13 +1309,17 @@          in go subst' (float:floats) expr cont      go subst floats (Case scrut b _ [Alt con vars expr]) cont+       | do_case_elim scrut' b vars  -- See Note [Case elim in exprIsConApp_maybe]+       = go (extend subst b scrut') floats expr cont+       | otherwise        = let-          scrut'           = subst_expr subst scrut           (subst', b')     = subst_bndr subst b           (subst'', vars') = subst_bndrs subst' vars           float            = FloatCase scrut' b' con vars'          in            go subst'' (float:floats) expr cont+       where+          scrut'           = subst_expr subst scrut      go (Right sub) floats (Var v) cont        = go (Left (getSubstInScope sub))@@ -1311,12 +1327,12 @@             (lookupIdSubst sub v)             cont -    go (Left in_scope) floats (Var fun) cont@(CC args co)+    go (Left in_scope) floats (Var fun) cont@(CC args mco)          | Just con <- isDataConWorkId_maybe fun         , count isValArg args == idArity fun         = succeedWith in_scope floats $-          pushCoDataCon con args co+          pushCoDataCon con args mco          -- Look through data constructor wrappers: they inline late (See Note         -- [Activation for data constructor wrappers]) but we want to do@@ -1336,7 +1352,7 @@               -- simplOptExpr initialises the in-scope set with exprFreeVars,               -- but that doesn't account for DFun unfoldings         = succeedWith in_scope floats $-          pushCoDataCon con (map (substExpr subst) dfun_args) co+          pushCoDataCon con (map (substExpr subst) dfun_args) mco          -- Look through unfoldings, but only arity-zero one;         -- if arity > 0 we are effectively inlining a function call,@@ -1354,7 +1370,7 @@         , [arg]              <- args         , Just (LitString str) <- exprIsLiteral_maybe ise arg         = succeedWith in_scope floats $-          dealWithStringLiteral fun str co+          dealWithStringLiteral fun str mco         where           unfolding = id_unf fun           extend_in_scope unf_fvs@@ -1404,15 +1420,15 @@   -- See Note [exprIsConApp_maybe on literal strings]-dealWithStringLiteral :: Var -> BS.ByteString -> Coercion+dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion                       -> Maybe (DataCon, [Type], [CoreExpr])  -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS -- turns those into [] automatically, but just in case something else in GHC -- generates a string literal directly.-dealWithStringLiteral fun str co =+dealWithStringLiteral fun str mco =   case utf8UnconsByteString str of-    Nothing -> pushCoDataCon nilDataCon [Type charTy] co+    Nothing -> pushCoDataCon nilDataCon [Type charTy] mco     Just (char, charTail) ->       let char_expr = mkConApp charDataCon [mkCharLit char]           -- In singleton strings, just add [] instead of unpackCstring# ""#.@@ -1421,9 +1437,30 @@                    else App (Var fun)                             (Lit (LitString charTail)) -      in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co+      in pushCoDataCon consDataCon [Type charTy, char_expr, rest] mco  {-+Note [Case elim in exprIsConApp_maybe]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+   data K a = MkK !a++   $WMkK x = case x of y -> K y   -- Wrapper for MkK++   ...case $WMkK v of K w -> <rhs>++We call `exprIsConApp_maybe` on ($WMkK v); we inline the wrapper+and beta-reduce, so we get to+   exprIsConApp_maybe (case v of y -> K y)++So we may float the case, and end up with+   case v of y -> <rhs>[y/w]++But if `v` is already evaluated, the next run of the Simplifier will+eliminate the case, and we may then make more progress with <rhs>.+Better to do it in one iteration.  Hence the `do_case_elim`+check in `exprIsConApp_maybe`.+ Note [Unfolding DFuns] ~~~~~~~~~~~~~~~~~~~~~~ DFuns look like
compiler/GHC/Core/TyCo/Compare.hs view
@@ -7,15 +7,17 @@ -- | Type equality and comparison module GHC.Core.TyCo.Compare ( -    -- * Type comparison-    eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX,-    nonDetCmpTypesX, nonDetCmpTc,+    -- * Type equality+    eqType, eqTypeIgnoringMultiplicity, eqTypeX, eqTypes,     eqVarBndrs,      pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck,     tcEqTyConApps,     mayLookIdentical, +    -- * Type comparison+    nonDetCmpType,+    -- * Visiblity comparision    eqForAllVis, cmpForAllVis @@ -29,10 +31,12 @@ import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs import GHC.Core.TyCon+import GHC.Core.Multiplicity( MultiplicityFlag(..) )  import GHC.Types.Var import GHC.Types.Unique import GHC.Types.Var.Env+import GHC.Types.Var.Set  import GHC.Utils.Outputable import GHC.Utils.Misc@@ -52,7 +56,11 @@  {- ********************************************************************* *                                                                      *-            Type equality+                       Type equality++     We don't use (==) from class Eq, partly so that we know where+     type equality is called, and partly because there are multiple+     variants. *                                                                      * ********************************************************************* -} @@ -72,6 +80,110 @@ * See Historical Note [Typechecker equality vs definitional equality]   below +Note [Casts and coercions in type comparision]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As (EQTYPE) in Note [Non-trivial definitional equality] says, our+general plan, implemented by `fullEq`, is:+ (1) ignore both casts and coercions when comparing types,+ (2) instead, compare the /kinds/ of the two types,+     as well as the types themselves++If possible we want to avoid step (2), comparing the kinds; doing so involves+calling `typeKind` and doing another comparision.++When can we avoid doing so?  Answer: we can certainly avoid doing so if the+types we are comparing have no casts or coercions.  But we can do better.+Consider+    eqType (TyConApp T [s1, ..., sn]) (TyConApp T [t1, .., tn])+We are going to call (eqType s1 t1), (eqType s2 t2) etc.++The kinds of `s1` and `t1` must be equal, because these TyConApps are well-kinded,+and both TyConApps are headed by the same T. So the first recursive call to `eqType`+certainly doesn't need to check kinds. If that call returns False, we stop. Otherwise,+we know that `s1` and `t1` are themselves equal (not just their kinds). This+makes the kinds of `s2` and `t2` to be equal, because those kinds come from the+kind of T instantiated with `s1` and `t1` -- which are the same. Thus we do not+need to check the kinds of `s2` and `t2`. By induction, we don't need to check+the kinds of *any* of the types in a TyConApp, and we also do not need to check+the kinds of the TyConApps themselves.++Conclusion:++* casts and coercions under a TyConApp don't matter -- even including type synonyms++* In step (2), use `hasCasts` to tell if there are any casts to worry about. It+  does not look very deep, because TyConApps and FunTys are so common, and it+  doesn't allocate.  The only recursive cases are AppTy and ForAllTy.++Alternative implementation.  Instead of `hasCasts`, we could make the+generic_eq_type function return+  data EqResult = NotEq | EqWithNoCasts | EqWithCasts+Practically free; but stylistically I prefer useing `hasCasts`:+  * `generic_eq_type` can just uses familiar booleans+  * There is a lot more branching with the three-value variant.+  * It separates concerns.  No need to think about cast-tracking when doing the+    equality comparison.+  * Indeed sometimes we omit the kind check unconditionally, so tracking it is just wasted+    work.+I did try both; there was no perceptible perf difference so I chose `hasCasts` version.++Note [Equality on AppTys]+~~~~~~~~~~~~~~~~~~~~~~~~~+In our cast-ignoring equality, we want to say that the following two+are equal:++  (Maybe |> co) (Int |> co')   ~?       Maybe Int++But the left is an AppTy while the right is a TyConApp. The solution is+to use splitAppTyNoView_maybe to break up the TyConApp into its pieces and+then continue. Easy to do, but also easy to forget to do.++Note [Comparing type synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the task of testing equality between two 'Type's of the form++  TyConApp tc tys1  =  TyConApp tc tys2++where `tc` is a type synonym. A naive way to perform this comparison these+would first expand the synonym and then compare the resulting expansions.++However, this is obviously wasteful and the RHS of `tc` may be large. We'd+prefer to compare `tys1 = tys2`.  When is that sound?  Precisely when the+synonym is not /forgetful/; that is, all its type variables appear in its+RHS -- see `GHC.Core.TyCon.isForgetfulSynTyCon`.++Of course, if we find that the TyCons are *not* equal then we still need to+perform the expansion as their RHSs may still be equal.++This works fine for /equality/, but not for /comparison/.  Consider+   type S a b = (b, a)+Now consider+   S Int Bool `compare` S Char Char+The ordering may depend on whether we expand the synonym or not, and we+don't want the result to depend on that. So for comparison we stick to+/nullary/ synonyms only, which is still useful.++We perform this optimisation in a number of places:++ * GHC.Core.TyCo.Compare.eqType      (works for non-nullary synonyms)+ * GHC.Core.Map.TYpe.eqDeBruijnType  (works for non-nullary synonyms)+ * GHC.Core.Types.nonDetCmpType      (nullary only)++This optimisation is especially helpful for the ubiquitous GHC.Types.Type,+since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications+whenever possible. See Note [Using synonyms to compress types] in+GHC.Core.Type for details.++Currently-missed opportunity (#25009):+* In the case of forgetful synonyms, we could still compare the args, pairwise,+  and then compare the RHS's with a suitably extended RnEnv2.  That would avoid+  comparing the same arg repeatedly.  e.g.+      type S a b = (a,a)+  Compare   S <big> y ~ S <big> y+  If we expand, we end up compare <big> with itself twice.++  But since forgetful synonyms are rare, we have not tried this.+ Note [Type comparisons using object pointer comparisons] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Quite often we substitute the type from a definition site into@@ -81,6 +193,21 @@ in the heap. We can take advantage of this by shortcutting the equality check if two types are represented by the same pointer under the hood. In some cases this reduces compiler allocations by ~2%.++See Note [Pointer comparison operations] in GHC.Builtin.primops.txt.pp++Note [Respecting multiplicity when comparing types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Generally speaking, we respect multiplicities (i.e. the linear part of the type+system) when comparing types.  Doing so is of course crucial during typechecking.++But for reasons described in Note [Linting linearity] in GHC.Core.Lint, it is hard+to ensure that Core is always type-correct when it comes to linearity.  So+* `eqTypeIgnoringMultiplicity` provides a way to compare types that /ignores/ multiplicities+* We use this multiplicity-blind comparison very occasionally, notably+    - in Core Lint: see Note [Linting linearity] in GHC.Core.Lint+    - in rule matching: see Note [Rewrite rules ignore multiplicities in FunTy]+      in GHC.Core.Unify -}  @@ -88,21 +215,12 @@ tcEqKind = tcEqType  tcEqType :: HasDebugCallStack => Type -> Type -> Bool--- ^ tcEqType implements typechecker equality--- It behaves just like eqType, but is implemented--- differently (for now)-tcEqType ty1 ty2-  =  tcEqTypeNoSyns ki1 ki2-  && tcEqTypeNoSyns ty1 ty2-  where-    ki1 = typeKind ty1-    ki2 = typeKind ty2+tcEqType = eqType  -- | Just like 'tcEqType', but will return True for types of different kinds -- as long as their non-coercion structure is identical. tcEqTypeNoKindCheck :: Type -> Type -> Bool-tcEqTypeNoKindCheck ty1 ty2-  = tcEqTypeNoSyns ty1 ty2+tcEqTypeNoKindCheck = eqTypeNoKindCheck  -- | Check whether two TyConApps are the same; if the number of arguments -- are different, just checks the common prefix of arguments.@@ -114,176 +232,223 @@     -- any difference in the kinds of later arguments would show up     -- as differences in earlier (dependent) arguments -{--Note [Specialising tc_eq_type]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The type equality predicates in Type are hit pretty hard during typechecking.-Consequently we take pains to ensure that these paths are compiled to-efficient, minimally-allocating code. -To this end we place an INLINE on tc_eq_type, ensuring that it is inlined into-its publicly-visible interfaces (e.g. tcEqType). In addition to eliminating-some dynamic branches, this allows the simplifier to eliminate the closure-allocations that would otherwise be necessary to capture the two boolean "mode"-flags. This reduces allocations by a good fraction of a percent when compiling-Cabal.+-- | Type equality on lists of types, looking through type synonyms+eqTypes :: [Type] -> [Type] -> Bool+eqTypes []       []       = True+eqTypes (t1:ts1) (t2:ts2) = eqType t1 t2 && eqTypes ts1 ts2+eqTypes _        _        = False -See #19226.--}+eqVarBndrs :: HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2+-- Check that the var lists are the same length+-- and have matching kinds; if so, extend the RnEnv2+-- Returns Nothing if they don't match+eqVarBndrs env [] []+ = Just env+eqVarBndrs env (tv1:tvs1) (tv2:tvs2)+ | eqTypeX env (varType tv1) (varType tv2)+ = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2+eqVarBndrs _ _ _= Nothing -mayLookIdentical :: Type -> Type -> Bool--- | Returns True if the /visible/ part of the types--- might look equal, even if they are really unequal (in the invisible bits)------ This function is very similar to tc_eq_type but it is much more--- heuristic.  Notably, it is always safe to return True, even with types--- that might (in truth) be unequal  -- this affects error messages only--- (Originally there were one function with an extra flag, but the result---  was hard to understand.)-mayLookIdentical orig_ty1 orig_ty2-  = go orig_env orig_ty1 orig_ty2-  where-    orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]+initRnEnv :: Type -> Type -> RnEnv2+initRnEnv ta tb = mkRnEnv2 $ mkInScopeSet $+                  tyCoVarsOfType ta `unionVarSet` tyCoVarsOfType tb -    go :: RnEnv2 -> Type -> Type -> Bool-    -- See Note [Comparing nullary type synonyms]-    go _  (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True+eqTypeNoKindCheck :: Type -> Type -> Bool+eqTypeNoKindCheck ty1 ty2 = eq_type_expand_respect ty1 ty2 -    go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2-    go env t1 t2 | Just t2' <- coreView t2 = go env t1 t2'+-- | Type equality comparing both visible and invisible arguments,+-- expanding synonyms and respecting multiplicities.+eqType :: HasCallStack => Type -> Type -> Bool+eqType ta tb = fullEq eq_type_expand_respect ta tb -    go env (TyVarTy tv1)   (TyVarTy tv2)   = rnOccL env tv1 == rnOccR env tv2-    go _   (LitTy lit1)    (LitTy lit2)    = lit1 == lit2-    go env (CastTy t1 _)   t2              = go env t1 t2-    go env t1              (CastTy t2 _)   = go env t1 t2-    go _   (CoercionTy {}) (CoercionTy {}) = True+-- | Compare types with respect to a (presumably) non-empty 'RnEnv2'.+eqTypeX :: HasCallStack => RnEnv2 -> Type -> Type -> Bool+eqTypeX env ta tb = fullEq (eq_type_expand_respect_x env) ta tb -    go env (ForAllTy (Bndr tv1 vis1) ty1)-           (ForAllTy (Bndr tv2 vis2) ty2)-      =  vis1 `eqForAllVis` vis2  -- See Note [ForAllTy and type equality]-      && go (rnBndr2 env tv1 tv2) ty1 ty2-         -- Visible stuff only: ignore kinds of binders+eqTypeIgnoringMultiplicity :: Type -> Type -> Bool+-- See Note [Respecting multiplicity when comparing types]+eqTypeIgnoringMultiplicity ta tb = fullEq eq_type_expand_ignore ta tb -    -- If we have (forall (r::RunTimeRep). ty1  ~   blah) then respond-    -- with True.  Reason: the type pretty-printer defaults RuntimeRep-    -- foralls (see Ghc.Iface.Type.hideNonStandardTypes).  That can make,-    -- say (forall r. TYPE r -> Type) into (Type -> Type), so it looks the-    -- same as a very different type (#24553).  By responding True, we-    -- tell GHC (see calls of mayLookIdentical) to display without defaulting.-    -- See Note [Showing invisible bits of types in error messages]-    -- in GHC.Tc.Errors.Ppr-    go _ (ForAllTy b _) _ | isDefaultableBndr b = True-    go _ _ (ForAllTy b _) | isDefaultableBndr b = True+-- | Like 'pickyEqTypeVis', but returns a Bool for convenience+pickyEqType :: Type -> Type -> Bool+-- Check when two types _look_ the same, _including_ synonyms.+-- So (pickyEqType String [Char]) returns False+-- This ignores kinds and coercions, because this is used only for printing.+pickyEqType ta tb = eq_type_keep_respect ta tb -    go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)-      = go env arg1 arg2 && go env res1 res2 && go env w1 w2-        -- Visible stuff only: ignore agg kinds+{- Note [Specialising type equality]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The type equality predicates in Type are hit pretty hard by GHC.  Consequently+we take pains to ensure that these paths are compiled to efficient,+minimally-allocating code.  Plan: -      -- See Note [Equality on AppTys] in GHC.Core.Type-    go env (AppTy s1 t1) ty2-      | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2-      = go env s1 s2 && go env t1 t2-    go env ty1 (AppTy s2 t2)-      | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1-      = go env s1 s2 && go env t1 t2+* The main workhorse is `inline_generic_eq_type_x`.  It is /non-recursive/+  and is marked INLINE. -    go env (TyConApp tc1 ts1)   (TyConApp tc2 ts2)-      = tc1 == tc2 && gos env (tyConBinders tc1) ts1 ts2+* `inline_generic_eq_type_x` has various parameters that control what it does:+  * syn_flag::SynFlag            whether type synonyms are expanded or kept.+  * mult_flag::MultiplicityFlag  whether multiplicities are ignored or respected+  * mb_env::Maybe RnEnv2         an optional RnEnv2. -    go _ _ _ = False+* `inline_generic_eq_type_x` has a handful of call sites, namely the ones+  in `eq_type_expand_respect`, `eq_type_expand_repect_x` etc.  It inlines+  at all these sites, specialising to the data values passed for the+  control parameters. -    gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool-    gos _   _         []       []      = True-    gos env bs (t1:ts1) (t2:ts2)-      | (invisible, bs') <- case bs of-                               []     -> (False,                    [])-                               (b:bs) -> (isInvisibleTyConBinder b, bs)-      = (invisible || go env t1 t2) && gos env bs' ts1 ts2+* All /other/ calls to `inline_generic_eq_type_x` go via+     generic_eq_type_x = inline_generic_eq_type_x+     {-# NOINLNE generic_eq_type_x #-}+  The idea is that all calls to `generic_eq_type_x` are specialised by the+  RULES, so this NOINLINE version is seldom, if ever, actually called. -    gos _ _ _ _ = False+* For each of specialised copy of `inline_generic_eq_type_x, there is a+  corresponding rewrite RULE that rewrites a call to (generic_eq_type_x args)+  into the appropriate specialied version. +See #19226.+-} --- | Type equality comparing both visible and invisible arguments and expanding--- type synonyms.-tcEqTypeNoSyns :: Type -> Type -> Bool-tcEqTypeNoSyns ta tb = tc_eq_type False ta tb+-- | This flag controls whether we expand synonyms during comparison+data SynFlag = ExpandSynonyms | KeepSynonyms --- | Like 'pickyEqTypeVis', but returns a Bool for convenience-pickyEqType :: Type -> Type -> Bool--- Check when two types _look_ the same, _including_ synonyms.--- So (pickyEqType String [Char]) returns False--- This ignores kinds and coercions, because this is used only for printing.-pickyEqType ty1 ty2 = tc_eq_type True ty1 ty2+eq_type_expand_respect, eq_type_expand_ignore, eq_type_keep_respect+  :: Type -> Type -> Bool+eq_type_expand_respect_x, eq_type_expand_ignore_x, eq_type_keep_respect_x+   :: RnEnv2 -> Type -> Type -> Bool --- | Real worker for 'tcEqType'. No kind check!-tc_eq_type :: Bool          -- ^ True <=> do not expand type synonyms-           -> Type -> Type-           -> Bool--- Flags False, False is the usual setting for tc_eq_type+eq_type_expand_respect       = inline_generic_eq_type_x ExpandSynonyms RespectMultiplicities Nothing+eq_type_expand_respect_x env = inline_generic_eq_type_x ExpandSynonyms RespectMultiplicities (Just env)+eq_type_expand_ignore        = inline_generic_eq_type_x ExpandSynonyms IgnoreMultiplicities  Nothing+eq_type_expand_ignore_x env  = inline_generic_eq_type_x ExpandSynonyms IgnoreMultiplicities  (Just env)+eq_type_keep_respect         = inline_generic_eq_type_x KeepSynonyms   RespectMultiplicities Nothing+eq_type_keep_respect_x env   = inline_generic_eq_type_x KeepSynonyms   RespectMultiplicities (Just env)++{-# RULES+"eqType1" generic_eq_type_x ExpandSynonyms RespectMultiplicities Nothing+             = eq_type_expand_respect+"eqType2" forall env. generic_eq_type_x ExpandSynonyms RespectMultiplicities (Just env)+             = eq_type_expand_respect_x env+"eqType3" generic_eq_type_x ExpandSynonyms IgnoreMultiplicities Nothing+             = eq_type_expand_ignore+"eqType4" forall env. generic_eq_type_x ExpandSynonyms IgnoreMultiplicities (Just env)+             = eq_type_expand_ignore_x env+"eqType5" generic_eq_type_x KeepSynonyms RespectMultiplicities Nothing+             = eq_type_keep_respect+"eqType6" forall env. generic_eq_type_x KeepSynonyms RespectMultiplicities (Just env)+             = eq_type_keep_respect_x env+ #-}++-- ---------------------------------------------------------------+-- | Real worker for 'eqType'. No kind check!+-- Inline it at the (handful of local) call sites+-- The "generic" bit refers to the flag paramerisation+-- See Note [Specialising type equality].+generic_eq_type_x, inline_generic_eq_type_x+  :: SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool++{-# NOINLINE generic_eq_type_x #-}+generic_eq_type_x = inline_generic_eq_type_x -- See Note [Computing equality on types] in Type-{-# INLINE tc_eq_type #-} -- See Note [Specialising tc_eq_type].-tc_eq_type keep_syns orig_ty1 orig_ty2-  = go orig_env orig_ty1 orig_ty2-  where-    orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2] -    go :: RnEnv2 -> Type -> Type -> Bool-    -- See Note [Comparing nullary type synonyms]-    go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True+{-# INLINE inline_generic_eq_type_x #-}+-- This non-recursive function can inline at its (few) call sites.  The+-- recursion goes via generic_eq_type_x, which is the loop-breaker.+inline_generic_eq_type_x syn_flag mult_flag mb_env+  = \ t1 t2 -> t1 `seq` t2 `seq`+    let go = generic_eq_type_x syn_flag mult_flag mb_env+             -- Abbreviation for recursive calls -    go env t1 t2 | not keep_syns, Just t1' <- coreView t1 = go env t1' t2-    go env t1 t2 | not keep_syns, Just t2' <- coreView t2 = go env t1 t2'+        gos []       []       = True+        gos (t1:ts1) (t2:ts2) = go t1 t2 && gos ts1 ts2+        gos _ _               = False -    go env (TyVarTy tv1)   (TyVarTy tv2)   = rnOccL env tv1 == rnOccR env tv2-    go _   (LitTy lit1)    (LitTy lit2)    = lit1 == lit2-    go env (CastTy t1 _)   t2              = go env t1 t2-    go env t1              (CastTy t2 _)   = go env t1 t2-    go _   (CoercionTy {}) (CoercionTy {}) = True+    in case (t1,t2) of+      _ | 1# <- reallyUnsafePtrEquality# t1 t2 -> True+      -- See Note [Type comparisons using object pointer comparisons] -    go env (ForAllTy (Bndr tv1 vis1) ty1)-           (ForAllTy (Bndr tv2 vis2) ty2)-      =  vis1 `eqForAllVis` vis2  -- See Note [ForAllTy and type equality]-      && go env (varType tv1) (varType tv2)-      && go (rnBndr2 env tv1 tv2) ty1 ty2+      (TyConApp tc1 tys1, TyConApp tc2 tys2)+        | tc1 == tc2, not (isForgetfulSynTyCon tc1)   -- See Note [Comparing type synonyms]+        -> gos tys1 tys2 +      _ | ExpandSynonyms <- syn_flag, Just t1' <- coreView t1 -> go t1' t2+        | ExpandSynonyms <- syn_flag, Just t2' <- coreView t2 -> go t1 t2'++      (TyConApp tc1 ts1, TyConApp tc2 ts2)+        | tc1 == tc2 -> gos ts1 ts2+        | otherwise  -> False++      (TyVarTy tv1, TyVarTy tv2)+        -> case mb_env of+              Nothing  -> tv1 == tv2+              Just env -> rnOccL env tv1 == rnOccR env tv2++      (LitTy lit1,    LitTy lit2)    -> lit1 == lit2+      (CastTy t1' _,   _)            -> go t1' t2 -- Ignore casts+      (_,             CastTy t2' _)  -> go t1 t2' -- Ignore casts+      (CoercionTy {}, CoercionTy {}) -> True      -- Ignore coercions+     -- Make sure we handle all FunTy cases since falling through to the     -- AppTy case means that tcSplitAppTyNoView_maybe may see an unzonked     -- kind variable, which causes things to blow up.     -- See Note [Equality on FunTys] in GHC.Core.TyCo.Rep: we must check     -- kinds here-    go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)-      = go env (typeKind arg1) (typeKind arg2) &&-        go env (typeKind res1) (typeKind res2) &&-        go env arg1 arg2 && go env res1 res2 && go env w1 w2+      (FunTy _ w1 arg1 res1, FunTy _ w2 arg2 res2)+        ->   fullEq go arg1 arg2+          && fullEq go res1 res2+          && (case mult_flag of+                  RespectMultiplicities -> go w1 w2+                  IgnoreMultiplicities  -> True)        -- See Note [Equality on AppTys] in GHC.Core.Type-    go env (AppTy s1 t1)        ty2-      | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2-      = go env s1 s2 && go env t1 t2-    go env ty1                  (AppTy s2 t2)-      | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1-      = go env s1 s2 && go env t1 t2+      (AppTy s1 t1', _)+        | Just (s2, t2') <- tcSplitAppTyNoView_maybe t2+        -> go s1 s2 && go t1' t2'+      (_,  AppTy s2 t2')+        | Just (s1, t1') <- tcSplitAppTyNoView_maybe t1+        -> go s1 s2 && go t1' t2' -    go env (TyConApp tc1 ts1)   (TyConApp tc2 ts2)-      = tc1 == tc2 && gos env ts1 ts2+      (ForAllTy (Bndr tv1 vis1) body1, ForAllTy (Bndr tv2 vis2) body2)+        -> case mb_env of+              Nothing -> generic_eq_type_x syn_flag mult_flag+                            (Just (initRnEnv t1 t2)) t1 t2+              Just env+                | vis1 `eqForAllVis` vis2         -- See Note [ForAllTy and type equality]+                -> go (varType tv1) (varType tv2)  -- Always do kind-check+                   && generic_eq_type_x syn_flag mult_flag+                             (Just (rnBndr2 env tv1 tv2)) body1 body2+                | otherwise+                -> False -    go _ _ _ = False+      _ -> False -    gos _   []       []       = True-    gos env (t1:ts1) (t2:ts2) = go env t1 t2 && gos env ts1 ts2-    gos _ _ _                 = False+fullEq :: (Type -> Type -> Bool) -> Type -> Type -> Bool+-- Do "full equality" including the kind check+-- See Note [Casts and coercions in type comparision]+{-# INLINE fullEq #-}+fullEq eq ty1 ty2+  = case eq ty1 ty2 of+          False    -> False+          True | hasCasts ty1 || hasCasts ty2+               -> eq (typeKind ty1) (typeKind ty2)+               | otherwise+               -> True +hasCasts :: Type -> Bool+-- Fast, does not look deep, does not allocate+hasCasts (CastTy {})     = True+hasCasts (CoercionTy {}) = True+hasCasts (AppTy t1 t2)   = hasCasts t1 || hasCasts t2+hasCasts (ForAllTy _ ty) = hasCasts ty+hasCasts _               = False   -- TyVarTy, TyConApp, FunTy, LitTy -isDefaultableBndr :: ForAllTyBinder -> Bool--- This function should line up with the defaulting done---   by GHC.Iface.Type.defaultIfaceTyVarsOfKind--- See Note [Showing invisible bits of types in error messages]---   in GHC.Tc.Errors.Ppr-isDefaultableBndr (Bndr tv vis)-  = isInvisibleForAllTyFlag vis && is_defaultable (tyVarKind tv)-  where-    is_defaultable ki = isLevityTy ki || isRuntimeRepTy ki  || isMultiplicityTy ki +{- *********************************************************************+*                                                                      *+                Comparing ForAllTyFlags+*                                                                      *+********************************************************************* -}+ -- | Do these denote the same level of visibility? 'Required' -- arguments are visible, others are not. So this function -- equates 'Specified' and 'Inferred'. Used for printing.@@ -442,91 +607,13 @@ ************************************************************************ *                                                                      *                 Comparison for types-        (We don't use instances so that we know where it happens)++      Not so heavily used, less carefully optimised *                                                                      * ************************************************************************ -Note [Equality on AppTys]-~~~~~~~~~~~~~~~~~~~~~~~~~-In our cast-ignoring equality, we want to say that the following two-are equal:--  (Maybe |> co) (Int |> co')   ~?       Maybe Int--But the left is an AppTy while the right is a TyConApp. The solution is-to use splitAppTyNoView_maybe to break up the TyConApp into its pieces and-then continue. Easy to do, but also easy to forget to do.--Note [Comparing nullary type synonyms]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider the task of testing equality between two 'Type's of the form--  TyConApp tc []--where @tc@ is a type synonym. A naive way to perform this comparison these-would first expand the synonym and then compare the resulting expansions.--However, this is obviously wasteful and the RHS of @tc@ may be large; it is-much better to rather compare the TyCons directly. Consequently, before-expanding type synonyms in type comparisons we first look for a nullary-TyConApp and simply compare the TyCons if we find one. Of course, if we find-that the TyCons are *not* equal then we still need to perform the expansion as-their RHSs may still be equal.--We perform this optimisation in a number of places:-- * GHC.Core.Types.eqType- * GHC.Core.Types.nonDetCmpType- * GHC.Core.Unify.unify_ty- * GHC.Tc.Solver.Equality.can_eq_nc'- * TcUnify.uType--This optimisation is especially helpful for the ubiquitous GHC.Types.Type,-since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications-whenever possible. See Note [Using synonyms to compress types] in-GHC.Core.Type for details.---}--eqType :: Type -> Type -> Bool--- ^ Type equality on source types. Does not look through @newtypes@,--- 'PredType's or type families, but it does look through type synonyms.--- This first checks that the kinds of the types are equal and then--- checks whether the types are equal, ignoring casts and coercions.--- (The kind check is a recursive call, but since all kinds have type--- @Type@, there is no need to check the types of kinds.)--- See also Note [Non-trivial definitional equality] in "GHC.Core.TyCo.Rep".-eqType t1 t2 = isEqual $ nonDetCmpType t1 t2-  -- It's OK to use nonDetCmpType here and eqType is deterministic,-  -- nonDetCmpType does equality deterministically---- | Compare types with respect to a (presumably) non-empty 'RnEnv2'.-eqTypeX :: RnEnv2 -> Type -> Type -> Bool-eqTypeX env t1 t2 = isEqual $ nonDetCmpTypeX env t1 t2-  -- It's OK to use nonDetCmpType here and eqTypeX is deterministic,-  -- nonDetCmpTypeX does equality deterministically---- | Type equality on lists of types, looking through type synonyms--- but not newtypes.-eqTypes :: [Type] -> [Type] -> Bool-eqTypes tys1 tys2 = isEqual $ nonDetCmpTypes tys1 tys2-  -- It's OK to use nonDetCmpType here and eqTypes is deterministic,-  -- nonDetCmpTypes does equality deterministically--eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2--- Check that the var lists are the same length--- and have matching kinds; if so, extend the RnEnv2--- Returns Nothing if they don't match-eqVarBndrs env [] []- = Just env-eqVarBndrs env (tv1:tvs1) (tv2:tvs2)- | eqTypeX env (varType tv1) (varType tv2)- = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2-eqVarBndrs _ _ _= Nothing- -- Now here comes the real worker -{- Note [nonDetCmpType nondeterminism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ nonDetCmpType is implemented in terms of nonDetCmpTypeX. nonDetCmpTypeX@@ -538,6 +625,7 @@ -}  nonDetCmpType :: Type -> Type -> Ordering+{-# INLINE nonDetCmpType #-} nonDetCmpType !t1 !t2   -- See Note [Type comparisons using object pointer comparisons]   | 1# <- reallyUnsafePtrEquality# t1 t2@@ -549,13 +637,7 @@   = nonDetCmpTypeX rn_env t1 t2   where     rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2]))-{-# INLINE nonDetCmpType #-} -nonDetCmpTypes :: [Type] -> [Type] -> Ordering-nonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2-  where-    rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2)))- -- | An ordering relation between two 'Type's (known below as @t1 :: k1@ -- and @t2 :: k2@) data TypeOrdering = TLT  -- ^ @t1 < t2@@@ -569,6 +651,7 @@ nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering  -- Main workhorse     -- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep     -- See Note [Computing equality on types]+    -- Always respects multiplicities, unlike eqType nonDetCmpTypeX env orig_t1 orig_t2 =     case go env orig_t1 orig_t2 of       -- If there are casts then we also need to do a comparison of@@ -602,10 +685,11 @@     -- Returns both the resulting ordering relation between     -- the two types and whether either contains a cast.     go :: RnEnv2 -> Type -> Type -> TypeOrdering-    -- See Note [Comparing nullary type synonyms]+     go _   (TyConApp tc1 []) (TyConApp tc2 [])       | tc1 == tc2-      = TEQ+      = TEQ    -- See Note [Comparing type synonyms]+     go env t1 t2       | Just t1' <- coreView t1 = go env t1' t2       | Just t2' <- coreView t2 = go env t1 t2'@@ -661,13 +745,6 @@     gos _   _          []         = TGT     gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2 ---------------nonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering-nonDetCmpTypesX _   []        []        = EQ-nonDetCmpTypesX env (t1:tys1) (t2:tys2) = nonDetCmpTypeX env t1 t2 S.<>-                                          nonDetCmpTypesX env tys1 tys2-nonDetCmpTypesX _   []        _         = LT-nonDetCmpTypesX _   _         []        = GT  ------------- -- | Compare two 'TyCon's.@@ -680,4 +757,93 @@     u2  = tyConUnique tc2  +{- *********************************************************************+*                                                                      *+                  mayLookIdentical+*                                                                      *+********************************************************************* -}++mayLookIdentical :: Type -> Type -> Bool+-- | Returns True if the /visible/ part of the types+-- might look equal, even if they are really unequal (in the invisible bits)+--+-- This function is very similar to tc_eq_type but it is much more+-- heuristic.  Notably, it is always safe to return True, even with types+-- that might (in truth) be unequal  -- this affects error messages only+-- (Originally this test was done by eqType with an extra flag, but the result+--  was hard to understand.)+mayLookIdentical orig_ty1 orig_ty2+  = go orig_env orig_ty1 orig_ty2+  where+    orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]++    go :: RnEnv2 -> Type -> Type -> Bool++    go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)+      | tc1 == tc2, not (isForgetfulSynTyCon tc1) -- See Note [Comparing type synonyms]+      = gos env (tyConBinders tc1) ts1 ts2++    go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2+    go env t1 t2 | Just t2' <- coreView t2 = go env t1 t2'++    go env (TyVarTy tv1)   (TyVarTy tv2)   = rnOccL env tv1 == rnOccR env tv2+    go _   (LitTy lit1)    (LitTy lit2)    = lit1 == lit2+    go env (CastTy t1 _)   t2              = go env t1 t2+    go env t1              (CastTy t2 _)   = go env t1 t2+    go _   (CoercionTy {}) (CoercionTy {}) = True++    go env (ForAllTy (Bndr tv1 vis1) ty1)+           (ForAllTy (Bndr tv2 vis2) ty2)+      =  vis1 `eqForAllVis` vis2  -- See Note [ForAllTy and type equality]+      && go (rnBndr2 env tv1 tv2) ty1 ty2+         -- Visible stuff only: ignore kinds of binders++    -- If we have (forall (r::RunTimeRep). ty1  ~   blah) then respond+    -- with True.  Reason: the type pretty-printer defaults RuntimeRep+    -- foralls (see Ghc.Iface.Type.hideNonStandardTypes).  That can make,+    -- say (forall r. TYPE r -> Type) into (Type -> Type), so it looks the+    -- same as a very different type (#24553).  By responding True, we+    -- tell GHC (see calls of mayLookIdentical) to display without defaulting.+    -- See Note [Showing invisible bits of types in error messages]+    -- in GHC.Tc.Errors.Ppr+    go _ (ForAllTy b _) _ | isDefaultableBndr b = True+    go _ _ (ForAllTy b _) | isDefaultableBndr b = True++    go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)+      = go env arg1 arg2 && go env res1 res2 && go env w1 w2+        -- Visible stuff only: ignore agg kinds++      -- See Note [Equality on AppTys] in GHC.Core.Type+    go env (AppTy s1 t1) ty2+      | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2+      = go env s1 s2 && go env t1 t2+    go env ty1 (AppTy s2 t2)+      | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1+      = go env s1 s2 && go env t1 t2++    go env (TyConApp tc1 ts1)   (TyConApp tc2 ts2)+      = tc1 == tc2 && gos env (tyConBinders tc1) ts1 ts2++    go _ _ _ = False++    gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool+    gos _   _         []       []      = True+    gos env bs (t1:ts1) (t2:ts2)+      | (invisible, bs') <- case bs of+                               []     -> (False,                    [])+                               (b:bs) -> (isInvisibleTyConBinder b, bs)+      = (invisible || go env t1 t2) && gos env bs' ts1 ts2++    gos _ _ _ _ = False+++isDefaultableBndr :: ForAllTyBinder -> Bool+-- This function should line up with the defaulting done+--   by GHC.Iface.Type.defaultIfaceTyVarsOfKind+-- See Note [Showing invisible bits of types in error messages]+--   in GHC.Tc.Errors.Ppr+isDefaultableBndr (Bndr tv vis)+  = isInvisibleForAllTyFlag vis && is_defaultable (tyVarKind tv)+  where+    is_defaultable ki = isLevityTy ki || isRuntimeRepTy ki  || isMultiplicityTy ki
compiler/GHC/Core/TyCo/FVs.hs view
@@ -19,6 +19,7 @@         tyCoVarsOfCoDSet,         tyCoFVsOfCo, tyCoFVsOfCos,         tyCoVarsOfCoList,+        coVarsOfCoDSet, coVarsOfCosDSet,          almostDevoidCoVarOfCo, @@ -58,10 +59,10 @@  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 )+import GHC.Core.Coercion.Axiom( CoAxiomRule(..), BuiltInFamRewrite(..), coAxiomTyCon ) import GHC.Utils.FV  import GHC.Types.Var@@ -74,6 +75,8 @@ import GHC.Utils.Panic import GHC.Data.Pair +import Data.Semigroup+ {- %************************************************************************ %*                                                                      *@@ -227,6 +230,17 @@ 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. -}  {- *********************************************************************@@ -289,16 +303,19 @@ ********************************************************************* -}  tyCoVarsOfType :: Type -> TyCoVarSet+-- The "deep" TyCoVars of the the type tyCoVarsOfType ty = runTyCoVars (deep_ty ty) -- Alternative: --   tyCoVarsOfType ty = closeOverKinds (shallowTyCoVarsOfType ty)  tyCoVarsOfTypes :: [Type] -> TyCoVarSet+-- The "deep" TyCoVars of the the type tyCoVarsOfTypes tys = runTyCoVars (deep_tys tys) -- Alternative: --   tyCoVarsOfTypes tys = closeOverKinds (shallowTyCoVarsOfTypes tys)  tyCoVarsOfCo :: Coercion -> TyCoVarSet+-- The "deep" TyCoVars of the the coercion -- See Note [Free variables of types] tyCoVarsOfCo co = runTyCoVars (deep_co co) @@ -316,7 +333,7 @@ (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@@ -374,7 +391,7 @@ (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@@ -446,6 +463,16 @@                        -- See Note [CoercionHoles and coercion free variables]                        -- in GHC.Core.TyCo.Rep +------- Same again, but for DCoVarSet ----------+--    But this time the free vars are shallow++coVarsOfCosDSet :: [Coercion] -> DCoVarSet+coVarsOfCosDSet cos = fvDVarSetSome isCoVar (tyCoFVsOfCos cos)++coVarsOfCoDSet :: Coercion -> DCoVarSet+coVarsOfCoDSet co = fvDVarSetSome isCoVar (tyCoFVsOfCo co)++ {- ********************************************************************* *                                                                      *           Closing over kinds@@ -584,6 +611,7 @@                                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@@ -640,10 +668,10 @@ tyCoFVsOfCo (HoleCo h) fv_cand in_scope acc   = tyCoFVsOfCoVar (coHoleCoVar h) fv_cand in_scope acc     -- See Note [CoercionHoles and coercion free variables]-tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc-tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc-  = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1-                     `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc+tyCoFVsOfCo (AxiomCo _ cs)    fv_cand in_scope acc = tyCoFVsOfCos cs  fv_cand in_scope acc+tyCoFVsOfCo (UnivCo { uco_lty = t1, uco_rty = t2, uco_deps = deps}) fv_cand in_scope acc+  = (tyCoFVsOfCos deps `unionFV` tyCoFVsOfType t1+                      `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc tyCoFVsOfCo (SymCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfCo (TransCo co1 co2)   fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc tyCoFVsOfCo (SelCo _ co)        fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc@@ -651,17 +679,11 @@ tyCoFVsOfCo (InstCo co arg)     fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc tyCoFVsOfCo (KindCo co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfCo (SubCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfCo (AxiomRuleCo _ cs)  fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand in_scope acc  tyCoFVsOfCoVar :: CoVar -> FV tyCoFVsOfCoVar v fv_cand in_scope acc   = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc -tyCoFVsOfProv :: UnivCoProvenance -> FV-tyCoFVsOfProv (PhantomProv co)    fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfProv (PluginProv _)      fv_cand in_scope acc = emptyFV fv_cand in_scope acc- tyCoFVsOfCos :: [Coercion] -> FV tyCoFVsOfCos []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoFVsOfCos (co:cos) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCos cos) fv_cand in_scope acc@@ -694,10 +716,10 @@   && almost_devoid_co_var_of_co co2 cv almost_devoid_co_var_of_co (CoVarCo v) cv = v /= cv almost_devoid_co_var_of_co (HoleCo h)  cv = (coHoleCoVar h) /= cv-almost_devoid_co_var_of_co (AxiomInstCo _ _ cos) cv-  = almost_devoid_co_var_of_cos cos cv-almost_devoid_co_var_of_co (UnivCo p _ t1 t2) cv-  = almost_devoid_co_var_of_prov p cv+almost_devoid_co_var_of_co (AxiomCo _ cs) cv+  = almost_devoid_co_var_of_cos cs cv+almost_devoid_co_var_of_co (UnivCo { uco_lty = t1, uco_rty = t2, uco_deps = deps }) cv+  =  almost_devoid_co_var_of_cos deps cv   && almost_devoid_co_var_of_type t1 cv   && almost_devoid_co_var_of_type t2 cv almost_devoid_co_var_of_co (SymCo co) cv@@ -716,8 +738,6 @@   = almost_devoid_co_var_of_co co cv almost_devoid_co_var_of_co (SubCo co) cv   = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_co (AxiomRuleCo _ cs) cv-  = almost_devoid_co_var_of_cos cs cv  almost_devoid_co_var_of_cos :: [Coercion] -> CoVar -> Bool almost_devoid_co_var_of_cos [] _ = True@@ -725,13 +745,6 @@   = almost_devoid_co_var_of_co co cv   && almost_devoid_co_var_of_cos cos cv -almost_devoid_co_var_of_prov :: UnivCoProvenance -> CoVar -> Bool-almost_devoid_co_var_of_prov (PhantomProv co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_prov (ProofIrrelProv co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_prov (PluginProv _) _ = True- almost_devoid_co_var_of_type :: Type -> CoVar -> Bool almost_devoid_co_var_of_type (TyVarTy _) _ = True almost_devoid_co_var_of_type (TyConApp _ tys) cv@@ -941,7 +954,9 @@  {-# 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@@ -1083,6 +1098,21 @@ ************************************************************************ -} +{- Note [tyConsOfType]+~~~~~~~~~~~~~~~~~~~~~~+It is slightly odd to find the TyCons of a type.  Especially since, via a type+family reduction or axiom, a type that doesn't mention T might start to mention T.++This function is used in only three places:+* In GHC.Tc.Validity.validDerivPred, when identifying "exotic" predicates.+* In GHC.Tc.Errors.Ppr.pprTcSolverReportMsg, when trying to print a helpful+  error about overlapping instances+* In utils/dump-decls/Main.hs, an ill-documented module.++None seem critical. Currently tyConsOfType looks inside coercions, but perhaps+it doesn't even need to do that.+-}+ -- | All type constructors occurring in the type; looking through type --   synonyms, but not newtypes. --  When it finds a Class, it returns the class TyCon.@@ -1111,8 +1141,9 @@                                    = go_co kind_co `unionUniqSets` go_co co      go_co (FunCo { fco_mult = m, fco_arg = a, fco_res = r })                                    = go_co m `unionUniqSets` go_co a `unionUniqSets` go_co r-     go_co (AxiomInstCo ax _ args) = go_ax ax `unionUniqSets` go_cos args-     go_co (UnivCo p _ t1 t2)      = go_prov p `unionUniqSets` go t1 `unionUniqSets` go t2+     go_co (AxiomCo ax args)       = go_ax ax `unionUniqSets` go_cos args+     go_co (UnivCo { uco_lty = t1, uco_rty = t2, uco_deps = cos })+                                   = go t1 `unionUniqSets` go t2 `unionUniqSets` go_cos cos      go_co (CoVarCo {})            = emptyUniqSet      go_co (HoleCo {})             = emptyUniqSet      go_co (SymCo co)              = go_co co@@ -1122,20 +1153,19 @@      go_co (InstCo co arg)         = go_co co `unionUniqSets` go_co arg      go_co (KindCo co)             = go_co co      go_co (SubCo co)              = go_co co-     go_co (AxiomRuleCo _ cs)      = go_cos cs       go_mco MRefl    = emptyUniqSet      go_mco (MCo co) = go_co co -     go_prov (PhantomProv co)    = go_co co-     go_prov (ProofIrrelProv co) = go_co co-     go_prov (PluginProv _)      = emptyUniqSet-      go_cos cos   = foldr (unionUniqSets . go_co)  emptyUniqSet cos       go_tc tc = unitUniqSet tc-     go_ax ax = go_tc $ coAxiomTyCon ax +     go_ax (UnbranchedAxiom ax) = go_tc $ coAxiomTyCon ax+     go_ax (BranchedAxiom ax _) = go_tc $ coAxiomTyCon ax+     go_ax (BuiltInFamRew  bif) = go_tc $ bifrw_fam_tc bif+     go_ax (BuiltInFamInj {})   = emptyUniqSet  -- A free-floating axiom+ tyConsOfTypes :: [Type] -> UniqSet TyCon tyConsOfTypes tys = foldr (unionUniqSets . tyConsOfType) emptyUniqSet tys @@ -1289,6 +1319,23 @@     go_co cxt (AppCo co arg)            = do { co' <- go_co cxt co                                              ; arg' <- go_co cxt arg                                              ; return (AppCo co' arg') }+    go_co cxt (SymCo co)                = do { co' <- go_co cxt co+                                             ; return (SymCo co') }+    go_co cxt (TransCo co1 co2)         = do { co1' <- go_co cxt co1+                                             ; co2' <- go_co cxt co2+                                             ; return (TransCo co1' co2') }+    go_co cxt (SelCo n co)              = do { co' <- go_co cxt co+                                             ; return (SelCo n co') }+    go_co cxt (LRCo lr co)              = do { co' <- go_co cxt co+                                             ; return (LRCo lr co') }+    go_co cxt (InstCo co arg)           = do { co' <- go_co cxt co+                                             ; arg' <- go_co cxt arg+                                             ; return (InstCo co' arg') }+    go_co cxt (KindCo co)               = do { co' <- go_co cxt co+                                             ; return (KindCo co') }+    go_co cxt (SubCo co)                = do { co' <- go_co cxt co+                                             ; return (SubCo co') }+     go_co cxt@(as, env) co@(ForAllCo { fco_tcv = tv, fco_kind = kind_co, fco_body = body_co })       = do { kind_co' <- go_co cxt kind_co            ; let tv' = setVarType tv $@@ -1297,6 +1344,7 @@                  as'  = as `delVarSet` tv            ; body' <- go_co (as', env') body_co            ; return (co { fco_tcv = tv', fco_kind = kind_co', fco_body = body' }) }+     go_co cxt co@(FunCo { fco_mult = w, fco_arg = co1 ,fco_res = co2 })       = do { co1' <- go_co cxt co1            ; co2' <- go_co cxt co2@@ -1312,32 +1360,11 @@       | bad_var_occ as (ch_co_var h)    = Nothing       | otherwise                       = return co -    go_co cxt (AxiomInstCo ax ind args) = do { args' <- mapM (go_co cxt) args-                                             ; return (AxiomInstCo ax ind args') }-    go_co cxt (UnivCo p r ty1 ty2)      = do { p' <- go_prov cxt p-                                             ; ty1' <- go cxt ty1-                                             ; ty2' <- go cxt ty2-                                             ; return (UnivCo p' r ty1' ty2') }-    go_co cxt (SymCo co)                = do { co' <- go_co cxt co-                                             ; return (SymCo co') }-    go_co cxt (TransCo co1 co2)         = do { co1' <- go_co cxt co1-                                             ; co2' <- go_co cxt co2-                                             ; return (TransCo co1' co2') }-    go_co cxt (SelCo n co)              = do { co' <- go_co cxt co-                                             ; return (SelCo n co') }-    go_co cxt (LRCo lr co)              = do { co' <- go_co cxt co-                                             ; return (LRCo lr co') }-    go_co cxt (InstCo co arg)           = do { co' <- go_co cxt co-                                             ; arg' <- go_co cxt arg-                                             ; return (InstCo co' arg') }-    go_co cxt (KindCo co)               = do { co' <- go_co cxt co-                                             ; return (KindCo co') }-    go_co cxt (SubCo co)                = do { co' <- go_co cxt co-                                             ; return (SubCo co') }-    go_co cxt (AxiomRuleCo ax cs)       = do { cs' <- mapM (go_co cxt) cs-                                             ; return (AxiomRuleCo ax cs') }+    go_co cxt (AxiomCo ax cs)           = do { cs' <- mapM (go_co cxt) cs+                                             ; return (AxiomCo ax cs') }+    go_co cxt co@(UnivCo { uco_lty = ty1, uco_rty = ty2, uco_deps = cos })+      = do { ty1' <- go cxt ty1+           ; ty2' <- go cxt ty2+           ; cos' <- mapM (go_co cxt) cos+           ; return (co { uco_lty = ty1', uco_rty = ty2', uco_deps = cos' }) } -    -------------------    go_prov cxt (PhantomProv co)    = PhantomProv <$> go_co cxt co-    go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co-    go_prov _   p@(PluginProv _)    = return p
compiler/GHC/Core/TyCo/Ppr.hs view
@@ -93,6 +93,13 @@     -- NB: debug-style is used for -dppr-debug     --     dump-style  is used for -ddump-tc-trace etc +tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType+tidyToIfaceTypeStyX env ty sty+  | userStyle sty = tidyToIfaceTypeX env ty+  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty+     -- in latter case, don't tidy, as we'll be printing uniques.++ pprTyLit :: TyLit -> SDoc pprTyLit = pprIfaceTyLit . toIfaceTyLit @@ -100,12 +107,6 @@ pprKind       = pprType pprParendKind = pprParendType -tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType-tidyToIfaceTypeStyX env ty sty-  | userStyle sty = tidyToIfaceTypeX env ty-  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty-     -- in latter case, don't tidy, as we'll be printing uniques.- tidyToIfaceType :: Type -> IfaceType tidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv @@ -117,9 +118,12 @@ -- leave them as IfaceFreeTyVar.  This is super-important -- for debug printing. tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)+  -- NB: if the type has /already/ been tidied (for example by the typechecker)+  --     the tidy step here is a no-op.  See Note [Tidying is idempotent]+  --     in GHC.Core.TyCo.Tidy   where     env'      = tidyFreeTyCoVars env free_tcvs-    free_tcvs = tyCoVarsOfTypeWellScoped ty+    free_tcvs = tyCoVarsOfTypeList ty  ------------ pprCo, pprParendCo :: Coercion -> SDoc
compiler/GHC/Core/TyCo/Rep.hs view
@@ -1,4 +1,3 @@- {-# LANGUAGE DeriveDataTypeable #-}  {-# OPTIONS_HADDOCK not-home #-}@@ -61,7 +60,7 @@         TyCoFolder(..), foldTyCo, noView,          -- * Sizes-        typeSize, typesSize, coercionSize, provSize,+        typeSize, typesSize, coercionSize,          -- * Multiplicities         Scaled(..), scaledMult, scaledThing, mapScaledType, Mult@@ -351,15 +350,25 @@  Note [Non-trivial definitional equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Is Int |> <*> the same as Int? YES! In order to reduce headaches,-we decide that any reflexive casts in types are just ignored.-(Indeed they must be. See Note [Respecting definitional equality].)-More generally, the `eqType` function, which defines Core's type equality-relation, ignores casts and coercion arguments, as long as the-two types have the same kind. This allows us to be a little sloppier-in keeping track of coercions, which is a good thing. It also means-that eqType does not depend on eqCoercion, which is also a good thing.+Is ((IO |> co1) Int |> co2) equal to (IO Int)?+Assume+   co1 :: (Type->Type) ~ (Type->Wombat)+   co2 :: Wombat ~ Type+Well, yes.  The casts are just getting in the way.+See also Note [Respecting definitional equality]. +So we do this:++(EQTYPE)+  The `eqType` function, which defines Core's type equality relation,+  - /ignores/ casts, and+  - /ignores/ coercion arguments+  - /provided/ two types have the same kind++This allows us to be a little sloppier in keeping track of coercions, which is a+good thing. It also means that eqType does not depend on eqCoercion, which is+also a good thing.+ Why is this sensible? That is, why is something different than α-equivalence appropriate for the implementation of eqType? @@ -886,7 +895,7 @@    | FunCo  -- FunCo :: "e" -> N/P -> e -> e -> e            -- See Note [FunCo] for fco_afl, fco_afr-       { fco_role         :: Role+        { fco_role         :: Role         , fco_afl          :: FunTyFlag   -- Arrow for coercionLKind         , fco_afr          :: FunTyFlag   -- Arrow for coercionRKind         , fco_mult         :: CoercionN@@ -898,9 +907,7 @@   | CoVarCo CoVar      -- :: _ -> (N or R)                        -- result role depends on the tycon of the variable's type -    -- AxiomInstCo :: e -> _ -> ?? -> e-  | AxiomInstCo (CoAxiom Branched) BranchIndex [Coercion]-     -- See also [CoAxiom index]+  | AxiomCo CoAxiomRule [Coercion]      -- The coercion arguments always *precisely* saturate      -- arity of (that branch of) the CoAxiom. If there are      -- any left over, we use AppCo.@@ -908,13 +915,14 @@      -- The roles of the argument coercions are determined      -- by the cab_roles field of the relevant branch of the CoAxiom -  | AxiomRuleCo CoAxiomRule [Coercion]-    -- AxiomRuleCo is very like AxiomInstCo, but for a CoAxiomRule-    -- The number coercions should match exactly the expectations-    -- of the CoAxiomRule (i.e., the rule is fully saturated).--  | UnivCo UnivCoProvenance Role Type Type-      -- :: _ -> "e" -> _ -> _ -> e+  | UnivCo  -- See Note [UnivCo]+            -- Of kind (lty ~role rty)+      { uco_prov         :: UnivCoProvenance+      , uco_role         :: Role+      , uco_lty, uco_rty :: Type+      , uco_deps         :: [Coercion]  -- Coercions on which it depends+               --   See Note [The importance of tracking UnivCo dependencies]+      }    | SymCo Coercion             -- :: e -> e   | TransCo Coercion Coercion  -- :: e -> e -> e@@ -952,13 +960,13 @@    | SelForAll          -- Decomposes (forall a. co) -  deriving( Eq, Data.Data )+  deriving( Eq, Data.Data, Ord )  data FunSel  -- See Note [SelCo]   = SelMult  -- Multiplicity   | SelArg   -- Argument of function   | SelRes   -- Result of function-  deriving( Eq, Data.Data )+  deriving( Eq, Data.Data, Ord )  type CoercionN = Coercion       -- always nominal type CoercionR = Coercion       -- always representational@@ -969,10 +977,16 @@   ppr = pprCo  instance Outputable CoSel where-  ppr (SelTyCon n _r) = text "Tc" <> parens (int n)-  ppr SelForAll       = text "All"-  ppr (SelFun fs)     = text "Fun" <> parens (ppr fs)+  ppr (SelTyCon n r) = text "Tc" <> parens (int n <> comma <> pprOneCharRole r)+  ppr SelForAll      = text "All"+  ppr (SelFun fs)    = text "Fun" <> parens (ppr fs) ++pprOneCharRole :: Role -> SDoc+pprOneCharRole Nominal          = char 'N'+pprOneCharRole Representational = char 'R'+pprOneCharRole Phantom          = char 'P'+ instance Outputable FunSel where   ppr SelMult = text "mult"   ppr SelArg  = text "arg"@@ -1085,7 +1099,7 @@       r = tyConRole tc r0 i       i < n    (i is zero-indexed)       -----------------------------------      SelCo (SelTyCon i r) : si ~r ti+      SelCo (SelTyCon i r) co : si ~r ti    "Not a newtype": see Note [SelCo and newtypes]   "Not an arrow type": see SelFun below@@ -1095,7 +1109,7 @@ * SelForAll:       co : forall (a:k1).t1 ~r0 forall (a:k2).t2       -----------------------------------      SelCo SelForAll : k1 ~N k2+      SelCo SelForAll co : k1 ~N k2    NB: SelForAll always gives a Nominal coercion. @@ -1105,17 +1119,17 @@       co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2)       r = funRole r0 SelMult       -----------------------------------      SelCo (SelFun SelMult) : m1 ~r m2+      SelCo (SelFun SelMult) co : m1 ~r m2        co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2)       r = funRole r0 SelArg       -----------------------------------      SelCo (SelFun SelArg) : s1 ~r s2+      SelCo (SelFun SelArg) co : s1 ~r s2        co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2)       r = funRole r0 SelRes       -----------------------------------      SelCo (SelFun SelRes) : t1 ~r t2+      SelCo (SelFun SelRes) co : t1 ~r t2  Note [FunCo] ~~~~~~~~~~~~@@ -1177,19 +1191,6 @@  which can be optimized to F g. -Note [CoAxiom index]-~~~~~~~~~~~~~~~~~~~~-A CoAxiom has 1 or more branches. Each branch has contains a list-of the free type variables in that branch, the LHS type patterns,-and the RHS type for that branch. When we apply an axiom to a list-of coercions, we must choose which branch of the axiom we wish to-use, as the different branches may have different numbers of free-type variables. (The number of type patterns is always the same-among branches, but that doesn't quite concern us here.)--The Int in the AxiomInstCo constructor is the 0-indexed number-of the chosen branch.- Note [Required foralls in Core] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the CoreExpr (Lam a e) where `a` is a TyVar, and (e::e_ty).@@ -1513,17 +1514,30 @@  %************************************************************************ %*                                                                      *-                UnivCoProvenance+                UnivCo %*                                                                      * %************************************************************************ +Note [UnivCo]+~~~~~~~~~~~~~ A UnivCo is a coercion whose proof does not directly express its role and kind (indeed for some UnivCos, like PluginProv, there /is/ no proof). -The different kinds of UnivCo are described by UnivCoProvenance.  Really-each is entirely separate, but they all share the need to represent their-role and kind, which is done in the UnivCo constructor.+The different kinds of UnivCo are described by UnivCoProvenance.  Really each+is entirely separate, but they all share the need to represent these fields: +  UnivCo+      { uco_prov         :: UnivCoProvenance+      , uco_role         :: Role+      , uco_lty, uco_rty :: Type+      , uco_deps         :: [Coercion]  -- Coercions on which it depends++Here,+ * uco_role, uco_lty, uco_rty express the type of the coercion+ * uco_prov says where it came from+ * uco_deps specifies the coercions on which this proof (which is not+   explicity given) depends. See+   Note [The importance of tracking UnivCo dependencies] -}  -- | For simplicity, we have just one UnivCo that represents a coercion from@@ -1535,23 +1549,128 @@ -- that they don't tell you what types they coercion between. (That info -- is in the 'UnivCo' constructor of 'Coercion'. data UnivCoProvenance-  = PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom-                             -- roled coercions+  = PhantomProv    -- ^ See Note [Phantom coercions]. Only in Phantom+                   -- roled coercions -  | ProofIrrelProv KindCoercion  -- ^ From the fact that any two coercions are-                                 --   considered equivalent. See Note [ProofIrrelProv].-                                 -- Can be used in Nominal or Representational coercions+  | ProofIrrelProv -- ^ From the fact that any two coercions are+                   --   considered equivalent. See Note [ProofIrrelProv].+                   -- Can be used in Nominal or Representational coercions -  | PluginProv String  -- ^ From a plugin, which asserts that this coercion-                       --   is sound. The string is for the use of the plugin.+  | PluginProv String+      -- ^ From a plugin, which asserts that this coercion is sound.+      --   The string and the variable set are for the use by the plugin. -  deriving Data.Data+  deriving (Eq, Ord, Data.Data)+  -- Why Ord?  See Note [Ord instance of IfaceType] in GHC.Iface.Type  instance Outputable UnivCoProvenance where-  ppr (PhantomProv _)    = text "(phantom)"-  ppr (ProofIrrelProv _) = text "(proof irrel.)"-  ppr (PluginProv str)   = parens (text "plugin" <+> brackets (text str))+  ppr PhantomProv      = text "(phantom)"+  ppr ProofIrrelProv   = text "(proof irrel)"+  ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) +instance NFData UnivCoProvenance where+  rnf p = p `seq` ()++instance Binary UnivCoProvenance where+  put_ bh PhantomProv    = putByte bh 1+  put_ bh ProofIrrelProv = putByte bh 2+  put_ bh (PluginProv a) = putByte bh 3 >> put_ bh a+  get bh = do+      tag <- getByte bh+      case tag of+           1 -> return PhantomProv+           2 -> return ProofIrrelProv+           3 -> do a <- get bh+                   return $ PluginProv a+           _ -> panic ("get UnivCoProvenance " ++ show tag)+++{- Note [Phantom coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+     data T a = T1 | T2+Then we have+     T s ~R T t+for any old s,t. The witness for this is (TyConAppCo T Rep co),+where (co :: s ~P t) is a phantom coercion built with PhantomProv.+The role of the UnivCo is always Phantom.  The Coercion stored is the+(nominal) kind coercion between the types+   kind(s) ~N kind (t)++Note [ProofIrrelProv]+~~~~~~~~~~~~~~~~~~~~~+A ProofIrrelProv is a coercion between coercions. For example:++  data G a where+    MkG :: G Bool++In core, we get++  G :: * -> *+  MkG :: forall (a :: *). (a ~# Bool) -> G a++Now, consider 'MkG -- that is, MkG used in a type -- and suppose we want+a proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be++  TyConAppCo Nominal MkG [co3, co4]+  where+    co3 :: co1 ~ co2+    co4 :: a1 ~ a2++Note that+  co1 :: a1 ~ Bool+  co2 :: a2 ~ Bool++Here,+  co3 = UnivCo ProofIrrelProv Nominal (CoercionTy co1) (CoercionTy co2) [co5]+  where+    co5 :: (a1 ~# Bool) ~# (a2 ~# Bool)+    co5 = TyConAppCo Nominal (~#) [<Consraint#>, <Constraint#>, co4, <Bool>]+++Note [The importance of tracking UnivCo dependencies]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It is vital that `UnivCo` (a coercion that lacks a proper proof)+tracks the coercions on which it depends. To see why, consider this program:++    type S :: Nat -> Nat++    data T (a::Nat) where+      T1 :: T 0+      T2 :: ...++    f :: T a -> S (a+1) -> S 1+    f = /\a (x:T a) (y:a).+        case x of+          T1 (gco : a ~# 0) -> y |> wco++For this to typecheck we need `wco :: S (a+1) ~# S 1`, given that `gco : a ~# 0`.+To prove that we need to know that `a+1 = 1` if `a=0`, which a plugin might know.+So it solves `wco` by providing a `UnivCo (PluginProv "my-plugin") (a+1) 1 [gco]`.++    But the `uco_deps` in `PluginProv` must mention `gco`!++Why? Otherwise we might float the entire expression (y |> wco) out of the+the case alternative for `T1` which brings `gco` into scope. If this+happens then we aren't far from a segmentation fault or much worse.+See #23923 for a real-world example of this happening.++So it is /crucial/ for the `UnivCo` to mention, in `uco_deps`, the coercion+variables used by the plugin to justify the `UnivCo` that it builds.  You+should think of it like `TyConAppCo`: the `UnivCo` proof constructor is+applied to a list of coercions, just as `TyConAppCo` is++It's very convenient to record a full coercion, not just a set of free coercion+variables, because during typechecking those coercions might contain coercion+holes `HoleCo`, which get filled in later.+-}++{- **********************************************************************+%*                                                                      *+                Coercion holes+%*                                                                      *+%********************************************************************* -}+ -- | A coercion to be filled in by the type-checker. See Note [Coercion holes] data CoercionHole   = CoercionHole { ch_co_var  :: CoVar@@ -1587,19 +1706,7 @@ instance Uniquable CoercionHole where   getUnique (CoercionHole { ch_co_var = cv }) = getUnique cv -{- Note [Phantom coercions]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider-     data T a = T1 | T2-Then we have-     T s ~R T t-for any old s,t. The witness for this is (TyConAppCo T Rep co),-where (co :: s ~P t) is a phantom coercion built with PhantomProv.-The role of the UnivCo is always Phantom.  The Coercion stored is the-(nominal) kind coercion between the types-   kind(s) ~N kind (t)--Note [Coercion holes]+{- Note [Coercion holes] ~~~~~~~~~~~~~~~~~~~~~~~~ During typechecking, constraint solving for type classes works by   - Generate an evidence Id,  d7 :: Num a@@ -1674,40 +1781,10 @@ Here co2 is a CoercionHole. But we /must/ know that it is free in co1, because that's all that stops it floating outside the implication.---Note [ProofIrrelProv]-~~~~~~~~~~~~~~~~~~~~~-A ProofIrrelProv is a coercion between coercions. For example:--  data G a where-    MkG :: G Bool--In core, we get--  G :: * -> *-  MkG :: forall (a :: *). (a ~ Bool) -> G a--Now, consider 'MkG -- that is, MkG used in a type -- and suppose we want-a proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be--  TyConAppCo Nominal MkG [co3, co4]-  where-    co3 :: co1 ~ co2-    co4 :: a1 ~ a2--Note that-  co1 :: a1 ~ Bool-  co2 :: a2 ~ Bool--Here,-  co3 = UnivCo (ProofIrrelProv co5) Nominal (CoercionTy co1) (CoercionTy co2)-  where-    co5 :: (a1 ~ Bool) ~ (a2 ~ Bool)-    co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, <Bool>] -}  + {- ********************************************************************* *                                                                      *                 foldType  and   foldCoercion@@ -1764,7 +1841,6 @@                        | tv `elemVarSet` acc = acc                        | otherwise = acc `extendVarSet` tv - we want to end up with    fvs ty = go emptyVarSet ty emptyVarSet      where@@ -1794,6 +1870,38 @@ But, amazingly, we get good code here too. GHC is careful not to mark TyCoFolder data constructor for deep_tcf as a loop breaker, so the record selections still cancel.  And eta expansion still happens too.++Note [Use explicit recursion in foldTyCo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In foldTyCo you'll see things like:+    go_tys _   []     = mempty+    go_tys env (t:ts) = go_ty env t `mappend` go_tys env ts+where we use /explicit recursion/.  You might wonder about using foldl instead:+    go_tys env = foldl (\t acc -> go_ty env t `mappend` acc) mempty+Or maybe foldl', or foldr.++But don't do that for two reasons (see #24591)++* We sometimes instantiate `a` to (Endo VarSet). Remembering+     newtype Endo a = Endo (a->a)+  after inlining `foldTyCo` bodily, the explicit recursion looks like+    go_tys _   []     = \acc -> acc+    go_tys env (t:ts) = \acc -> go_ty env t (go_tys env ts acc)+  The strictness analyser has no problem spotting that this function is+  strict in `acc`, provided `go_ty` is.++  But in the foldl form that is /much/ less obvious, and the strictness+  analyser fails utterly.  Result: lots and lots of thunks get built.  In+  !12037, Mikolaj found that GHC allocated /six times/ as much heap+  on test perf/compiler/T9198 as a result of this single problem!++* Second, while I think that using `foldr` would be fine (simple experiments in+  #24591 suggest as much), it builds a local loop (with env free) and I'm not 100%+  confident it'll be lambda lifted in the end. It seems more direct just to write+  the code we want.++  On the other hand in `go_cvs` we might hope that the `foldr` will fuse with the+  `dVarSetElems` so I have used `foldr`. -}  data TyCoFolder env a@@ -1832,12 +1940,11 @@       = let !env' = tycobinder env tv vis  -- Avoid building a thunk here         in go_ty env (varType tv) `mappend` go_ty env' inner -    -- Explicit recursion because using foldr builds a local-    -- loop (with env free) and I'm not confident it'll be-    -- lambda lifted in the end+    -- See Note [Use explicit recursion in foldTyCo]     go_tys _   []     = mempty     go_tys env (t:ts) = go_ty env t `mappend` go_tys env ts +    -- See Note [Use explicit recursion in foldTyCo]     go_cos _   []     = mempty     go_cos env (c:cs) = go_co env c `mappend` go_cos env cs @@ -1847,13 +1954,13 @@     go_co env (TyConAppCo _ _ args)    = go_cos env args     go_co env (AppCo c1 c2)            = go_co env c1 `mappend` go_co env c2     go_co env (CoVarCo cv)             = covar env cv-    go_co env (AxiomInstCo _ _ args)   = go_cos env args+    go_co env (AxiomCo _ cos)          = go_cos env cos     go_co env (HoleCo hole)            = cohole env hole-    go_co env (UnivCo p _ t1 t2)       = go_prov env p `mappend` go_ty env t1-                                                       `mappend` go_ty env t2+    go_co env (UnivCo { uco_lty = t1, uco_rty = t2, uco_deps = deps })+                                       = go_ty env t1 `mappend` go_ty env t2+                                         `mappend` go_cos env deps     go_co env (SymCo co)               = go_co env co     go_co env (TransCo c1 c2)          = go_co env c1 `mappend` go_co env c2-    go_co env (AxiomRuleCo _ cos)      = go_cos env cos     go_co env (SelCo _ co)             = go_co env co     go_co env (LRCo _ co)              = go_co env co     go_co env (InstCo co arg)          = go_co env co `mappend` go_co env arg@@ -1869,10 +1976,6 @@       where         env' = tycobinder env tv Inferred -    go_prov env (PhantomProv co)    = go_co env co-    go_prov env (ProofIrrelProv co) = go_co env co-    go_prov _   (PluginProv _)      = mempty- -- | A view function that looks through nothing. noView :: Type -> Maybe Type noView _ = Nothing@@ -1923,8 +2026,8 @@                                                          + coercionSize w coercionSize (CoVarCo _)         = 1 coercionSize (HoleCo _)          = 1-coercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args)-coercionSize (UnivCo p _ t1 t2)  = 1 + provSize p + typeSize t1 + typeSize t2+coercionSize (AxiomCo _ cs)      = 1 + sum (map coercionSize cs)+coercionSize (UnivCo { uco_lty = t1, uco_rty = t2 })  = 1 + typeSize t1 + typeSize t2 coercionSize (SymCo co)          = 1 + coercionSize co coercionSize (TransCo co1 co2)   = 1 + coercionSize co1 + coercionSize co2 coercionSize (SelCo _ co)        = 1 + coercionSize co@@ -1932,12 +2035,6 @@ coercionSize (InstCo co arg)     = 1 + coercionSize co + coercionSize arg coercionSize (KindCo co)         = 1 + coercionSize co coercionSize (SubCo co)          = 1 + coercionSize co-coercionSize (AxiomRuleCo _ cs)  = 1 + sum (map coercionSize cs)--provSize :: UnivCoProvenance -> Int-provSize (PhantomProv co)    = 1 + coercionSize co-provSize (ProofIrrelProv co) = 1 + coercionSize co-provSize (PluginProv _)      = 1  {- ************************************************************************
compiler/GHC/Core/TyCo/Rep.hs-boot view
@@ -3,8 +3,9 @@  import GHC.Utils.Outputable ( Outputable ) import Data.Data  ( Data )-import {-# SOURCE #-} GHC.Types.Var( Var, VarBndr, ForAllTyFlag, FunTyFlag )+import {-# SOURCE #-} GHC.Types.Var( Var, VarBndr, FunTyFlag ) import {-# SOURCE #-} GHC.Core.TyCon ( TyCon )+import Language.Haskell.Syntax.Specificity (ForAllTyFlag)  data Type data Coercion
compiler/GHC/Core/TyCo/Subst.hs view
@@ -41,7 +41,7 @@         cloneTyVarBndr, cloneTyVarBndrs,         substVarBndr, substVarBndrs,         substTyVarBndr, substTyVarBndrs,-        substCoVarBndr,+        substCoVarBndr, substDCoVarSet,         substTyVar, substTyVars, substTyVarToTyVar,         substTyCoVars,         substTyCoBndr, substForAllCoBndr,@@ -57,10 +57,10 @@    ( mkCoVarCo, mkKindCo, mkSelCo, mkTransCo    , mkNomReflCo, mkSubCo, mkSymCo    , mkFunCo2, mkForAllCo, mkUnivCo-   , mkAxiomInstCo, mkAppCo, mkGReflCo+   , mkAxiomCo, mkAppCo, mkGReflCo    , mkInstCo, mkLRCo, mkTyConAppCo    , mkCoercionType-   , coercionKind, coercionLKind, coVarKindsTypesRole )+   , coercionKind, coercionLKind, coVarTypesRole ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprTyVar ) import {-# SOURCE #-} GHC.Core.Ppr ( ) -- instance Outputable CoreExpr import {-# SOURCE #-} GHC.Core ( CoreExpr )@@ -68,6 +68,7 @@ import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs +import GHC.Types.Basic( SwapFlag(..), isSwapped, pickSwap, notSwapped ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env@@ -878,8 +879,8 @@     go :: Coercion -> Coercion     go (Refl ty)             = mkNomReflCo $! (go_ty ty)     go (GRefl r ty mco)      = (mkGReflCo r $! (go_ty ty)) $! (go_mco mco)-    go (TyConAppCo r tc args)= let args' = map go args-                               in  args' `seqList` mkTyConAppCo r tc args'+    go (TyConAppCo r tc args)= mkTyConAppCo r tc $! go_cos args+    go (AxiomCo con cos)     = mkAxiomCo con $! go_cos cos     go (AppCo co arg)        = (mkAppCo $! go co) $! go arg     go (ForAllCo tv visL visR kind_co co)       = case substForAllCoBndrUnchecked subst tv kind_co of@@ -887,9 +888,10 @@           ((mkForAllCo $! tv') visL visR $! kind_co') $! subst_co subst' co     go (FunCo r afl afr w co1 co2)   = ((mkFunCo2 r afl afr $! go w) $! go co1) $! go co2     go (CoVarCo cv)          = substCoVar subst cv-    go (AxiomInstCo con ind cos) = mkAxiomInstCo con ind $! map go cos-    go (UnivCo p r t1 t2)    = (((mkUnivCo $! go_prov p) $! r) $!-                                (go_ty t1)) $! (go_ty t2)+    go (UnivCo { uco_prov = p, uco_role = r+               , uco_lty = t1, uco_rty = t2, uco_deps = deps })+                             = ((((mkUnivCo $! p) $! go_cos deps) $! r) $!+                                  (go_ty t1)) $! (go_ty t2)     go (SymCo co)            = mkSymCo $! (go co)     go (TransCo co1 co2)     = (mkTransCo $! (go co1)) $! (go co2)     go (SelCo d co)          = mkSelCo d $! (go co)@@ -897,22 +899,25 @@     go (InstCo co arg)       = (mkInstCo $! (go co)) $! go arg     go (KindCo co)           = mkKindCo $! (go co)     go (SubCo co)            = mkSubCo $! (go co)-    go (AxiomRuleCo c cs)    = let cs1 = map go cs-                                in cs1 `seqList` AxiomRuleCo c cs1     go (HoleCo h)            = HoleCo $! go_hole h -    go_prov (PhantomProv kco)    = PhantomProv (go kco)-    go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco)-    go_prov p@(PluginProv _)     = p+    go_cos cos = let cos' = map go cos+                 in cos' `seqList` cos'      -- See Note [Substituting in a coercion hole]     go_hole h@(CoercionHole { ch_co_var = cv })       = h { ch_co_var = updateVarType go_ty cv } +-- | Perform a substitution within a 'DVarSet' of free variables,+-- returning the shallow free coercion variables.+substDCoVarSet :: Subst -> DCoVarSet -> DCoVarSet+substDCoVarSet subst cvs = coVarsOfCosDSet $ map (substCoVar subst) $+                           dVarSetElems cvs+ substForAllCoBndr :: Subst -> TyCoVar -> KindCoercion                   -> (Subst, TyCoVar, Coercion) substForAllCoBndr subst-  = substForAllCoBndrUsing False (substCo subst) subst+  = substForAllCoBndrUsing NotSwapped (substCo subst) subst  -- | Like 'substForAllCoBndr', but disables sanity checks. -- The problems that the sanity checks in substCo catch are described in@@ -922,10 +927,10 @@ substForAllCoBndrUnchecked :: Subst -> TyCoVar -> KindCoercion                            -> (Subst, TyCoVar, Coercion) substForAllCoBndrUnchecked subst-  = substForAllCoBndrUsing False (substCoUnchecked subst) subst+  = substForAllCoBndrUsing NotSwapped (substCoUnchecked subst) subst  -- See Note [Sym and ForAllCo]-substForAllCoBndrUsing :: Bool  -- apply sym to binder?+substForAllCoBndrUsing :: SwapFlag  -- Apply sym to binder?                        -> (Coercion -> Coercion)  -- transformation to kind co                        -> Subst -> TyCoVar -> KindCoercion                        -> (Subst, TyCoVar, KindCoercion)@@ -933,7 +938,7 @@   | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var   | otherwise       = substForAllCoCoVarBndrUsing sym sco subst old_var -substForAllCoTyVarBndrUsing :: Bool  -- apply sym to binder?+substForAllCoTyVarBndrUsing :: SwapFlag  -- Apply sym to binder?                             -> (Coercion -> Coercion)  -- transformation to kind co                             -> Subst -> TyVar -> KindCoercion                             -> (Subst, TyVar, KindCoercion)@@ -942,10 +947,13 @@     ( Subst (in_scope `extendInScopeSet` new_var) idenv new_env cenv     , new_var, new_kind_co )   where-    new_env | no_change && not sym = delVarEnv tenv old_var-            | sym       = extendVarEnv tenv old_var $-                          TyVarTy new_var `CastTy` new_kind_co-            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)+    new_env | no_change, notSwapped sym+            = delVarEnv tenv old_var+            | isSwapped sym+            = extendVarEnv tenv old_var $+              TyVarTy new_var `CastTy` new_kind_co+            | otherwise+            = extendVarEnv tenv old_var (TyVarTy new_var)      no_kind_change = noFreeVarsOfCo old_kind_co     no_change = no_kind_change && (new_var == old_var)@@ -961,7 +969,7 @@      new_var  = uniqAway in_scope (setTyVarKind old_var new_ki1) -substForAllCoCoVarBndrUsing :: Bool  -- apply sym to binder?+substForAllCoCoVarBndrUsing :: SwapFlag  -- Apply sym to binder?                             -> (Coercion -> Coercion)  -- transformation to kind co                             -> Subst -> CoVar -> KindCoercion                             -> (Subst, CoVar, KindCoercion)@@ -971,8 +979,10 @@     ( Subst (in_scope `extendInScopeSet` new_var) idenv tenv new_cenv     , new_var, new_kind_co )   where-    new_cenv | no_change && not sym = delVarEnv cenv old_var-             | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var)+    new_cenv | no_change, notSwapped sym+             = delVarEnv cenv old_var+             | otherwise+             = extendVarEnv cenv old_var (mkCoVarCo new_var)      no_kind_change = noFreeVarsOfCo old_kind_co     no_change = no_kind_change && (new_var == old_var)@@ -983,8 +993,7 @@     Pair h1 h2 = coercionKind new_kind_co      new_var       = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type-    new_var_type  | sym       = h2-                  | otherwise = h1+    new_var_type  = pickSwap sym h1 h2  substCoVar :: Subst -> CoVar -> Coercion substCoVar (Subst _ _ _ cenv) cv@@ -1082,7 +1091,7 @@     new_var = uniqAway in_scope subst_old_var     subst_old_var = mkCoVar (varName old_var) new_var_type -    (_, _, t1, t2, role) = coVarKindsTypesRole old_var+    (t1, t2, role) = coVarTypesRole old_var     t1' = subst_fn subst t1     t2' = subst_fn subst t2     new_var_type = mkCoercionType role t1' t2'
compiler/GHC/Core/TyCo/Tidy.hs view
@@ -4,22 +4,25 @@ module GHC.Core.TyCo.Tidy   (         -- * Tidying type related things up for printing-        tidyType,      tidyTypes,-        tidyOpenType,  tidyOpenTypes,-        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars, avoidNameClashes,-        tidyOpenTyCoVar, tidyOpenTyCoVars,-        tidyTyCoVarOcc,+        tidyType, tidyTypes,+        tidyCo,   tidyCos,         tidyTopType,-        tidyCo, tidyCos,-        tidyForAllTyBinder, tidyForAllTyBinders++        tidyOpenType,  tidyOpenTypes,+        tidyOpenTypeX, tidyOpenTypesX,+        tidyFreeTyCoVars, tidyFreeTyCoVarX, tidyFreeTyCoVarsX,++        tidyAvoiding,+        tidyVarBndr, tidyVarBndrs, avoidNameClashes,+        tidyForAllTyBinder, tidyForAllTyBinders,+        tidyTyCoVarOcc   ) where  import GHC.Prelude import GHC.Data.FastString  import GHC.Core.TyCo.Rep-import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList)-+import GHC.Core.TyCo.FVs import GHC.Types.Name hiding (varName) import GHC.Types.Var import GHC.Types.Var.Env@@ -27,12 +30,76 @@  import Data.List (mapAccumL) -{--%************************************************************************-%*                                                                      *-\subsection{TidyType}-%*                                                                      *-%************************************************************************+{- **********************************************************************++                  TidyType++********************************************************************** -}++{- Note [Tidying open types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When tidying some open types [t1,..,tn], we find their free vars, and tidy them first.++But (tricky point) we restrict the occ_env part of inner_env to just the /free/+vars of [t1..tn], so that we don't gratuitously rename the /bound/ variables.++Example: assume the TidyEnv+      ({"a1","b"} , [a_4 :-> a1, b_7 :-> b])+and call tidyOpenTypes on+      [a_1, forall a_2. Maybe (a_2,a_4), forall b. (b,a_1)]+All the a's have the same OccName, but different uniques.++The TidyOccEnv binding for "b" relates b_7, which doesn't appear free in the+these types at all, so we don't want that to mess up the tidying for the+(forall b...).++So we proceed as follows:+  1. Find the free vars.+     In our example:the free vars are a_1 and a_4:++  2. Use tidyFreeTyCoVars to tidy them (workhorse: `tidyFreeCoVarX`)+     In our example:+      * a_4 already has a tidy form, a1, so don't change that+      * a_1 gets tidied to a2++  3. Trim the TidyOccEnv to OccNames of the tidied free vars (`trimTidyEnv`)+     In our example "a1" and "a2"++  4. Now tidy the types.  In our example we get+      [a2, forall a3. Maybe (a3,a1), forall b. (b, a2)]++Note [Tidying is idempotent]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Key invariant: tidyFreeTyCoVars is idempotent, at least if you start with+an empty TidyEnv. This is important because:++  * The typechecker error message processing carefully tidies types, using+    global knowledge; see for example calls to `tidyCt` in GHC.Tc.Errors.++  * Then the type pretty-printer, GHC.Core.TyCo.Ppr.pprType tidies the type+    again, because that's important for pretty-printing types in general.++But the second tidying is a no-op if the first step has happened, because+all the free vars will have distinct OccNames, so no renaming needs to happen.++Note [tidyAvoiding]+~~~~~~~~~~~~~~~~~~~+Consider tidying this unsolved constraint in GHC.Tc.Errors.report_unsolved.+    C a_33, (forall a. Eq a => D a)+Here a_33 is a free unification variable.  If we firs tidy [a_33 :-> "a"]+then we have no choice but to tidy the `forall a` to something else. But it+is confusing (sometimes very confusing) to gratuitously rename skolems in+this way -- see #24868.  So it is better to :++  * Find the /bound/ skolems (just `a` in this case)+  * Initialise the TidyOccEnv to avoid using "a"+  * Now tidy the free a_33 to, say, "a1"+  * Delete "a" from the TidyOccEnv++This is done by `tidyAvoiding`.++The last step is very important; if we leave "a" in the TidyOccEnv, when+we get to the (forall a. blah) we'll rename `a` to "a2", avoiding "a". -}  -- | This tidies up a type for printing in an error message, or in@@ -93,31 +160,38 @@ tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv -- ^ Add the free 'TyVar's to the env in tidy form, -- so that we can tidy the type they are free in-tidyFreeTyCoVars tidy_env tyvars-  = fst (tidyOpenTyCoVars tidy_env tyvars)+-- Precondition: input free vars are closed over kinds and+-- This function does a scopedSort, so that tidied variables+-- have tidied kinds.+-- See Note [Tidying is idempotent]+tidyFreeTyCoVars tidy_env tyvars = fst (tidyFreeTyCoVarsX tidy_env tyvars)  ----------------tidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])-tidyOpenTyCoVars env tyvars = mapAccumL tidyOpenTyCoVar env tyvars+tidyFreeTyCoVarsX :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])+-- Precondition: input free vars are closed over kinds and+-- This function does a scopedSort, so that tidied variables+-- have tidied kinds.+-- See Note [Tidying is idempotent]+tidyFreeTyCoVarsX env tyvars = mapAccumL tidyFreeTyCoVarX env $+                               scopedSort tyvars  ----------------tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)+tidyFreeTyCoVarX :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar) -- ^ Treat a new 'TyCoVar' as a binder, and give it a fresh tidy name -- using the environment if one has not already been allocated. See -- also 'tidyVarBndr'-tidyOpenTyCoVar env@(_, subst) tyvar+-- See Note [Tidying is idempotent]+tidyFreeTyCoVarX env@(_, subst) tyvar   = case lookupVarEnv subst tyvar of-        Just tyvar' -> (env, tyvar')              -- Already substituted-        Nothing     ->-          let env' = tidyFreeTyCoVars env (tyCoVarsOfTypeList (tyVarKind tyvar))-          in tidyVarBndr env' tyvar  -- Treat it as a binder+        Just tyvar' -> (env, tyvar')           -- Already substituted+        Nothing     -> tidyVarBndr env tyvar  -- Treat it as a binder  --------------- tidyTyCoVarOcc :: TidyEnv -> TyCoVar -> TyCoVar-tidyTyCoVarOcc env@(_, subst) tv-  = case lookupVarEnv subst tv of-        Nothing  -> updateVarType (tidyType env) tv-        Just tv' -> tv'+tidyTyCoVarOcc env@(_, subst) tcv+  = case lookupVarEnv subst tcv of+        Nothing   -> updateVarType (tidyType env) tcv+        Just tcv' -> tcv'  --------------- @@ -155,23 +229,27 @@ -- -- See Note [Strictness in tidyType and friends] tidyType :: TidyEnv -> Type -> Type-tidyType _   t@(LitTy {})          = t -- Preserve sharing-tidyType env (TyVarTy tv)          = TyVarTy $! tidyTyCoVarOcc env tv-tidyType _   t@(TyConApp _ [])     = t -- Preserve sharing if possible-tidyType env (TyConApp tycon tys)  = TyConApp tycon $! tidyTypes env tys-tidyType env (AppTy fun arg)       = (AppTy $! (tidyType env fun)) $! (tidyType env arg)-tidyType env ty@(FunTy _ w arg res)  = let { !w'   = tidyType env w-                                           ; !arg' = tidyType env arg-                                           ; !res' = tidyType env res }-                                       in ty { ft_mult = w', ft_arg = arg', ft_res = res' }-tidyType env (ty@(ForAllTy{}))     = (mkForAllTys' $! (zip tvs' vis)) $! tidyType env' body_ty-  where-    (tvs, vis, body_ty) = splitForAllTyCoVars' ty-    (env', tvs') = tidyVarBndrs env tvs-tidyType env (CastTy ty co)       = (CastTy $! tidyType env ty) $! (tidyCo env co)-tidyType env (CoercionTy co)      = CoercionTy $! (tidyCo env co)+tidyType _   t@(LitTy {})           = t -- Preserve sharing+tidyType env (TyVarTy tv)           = TyVarTy $! tidyTyCoVarOcc env tv+tidyType _   t@(TyConApp _ [])      = t -- Preserve sharing if possible+tidyType env (TyConApp tycon tys)   = TyConApp tycon $! tidyTypes env tys+tidyType env (AppTy fun arg)        = (AppTy $! (tidyType env fun)) $! (tidyType env arg)+tidyType env (CastTy ty co)         = (CastTy $! tidyType env ty) $! (tidyCo env co)+tidyType env (CoercionTy co)        = CoercionTy $! (tidyCo env co)+tidyType env ty@(FunTy _ w arg res) = let { !w'   = tidyType env w+                                          ; !arg' = tidyType env arg+                                          ; !res' = tidyType env res }+                                      in ty { ft_mult = w', ft_arg = arg', ft_res = res' }+tidyType env (ty@(ForAllTy{}))      = tidyForAllType env ty  +tidyForAllType :: TidyEnv -> Type -> Type+tidyForAllType env ty+   = (mkForAllTys' $! (zip tcvs' vis)) $! tidyType body_env body_ty+  where+    (tcvs, vis, body_ty) = splitForAllTyCoVars' ty+    (body_env, tcvs') = tidyVarBndrs env tcvs+ -- The following two functions differ from mkForAllTys and splitForAllTyCoVars in that -- they expect/preserve the ForAllTyFlag argument. These belong to "GHC.Core.Type", but -- how should they be named?@@ -188,25 +266,54 @@   ---------------+tidyAvoiding :: [OccName]+             -> (TidyEnv -> a -> TidyEnv)+             -> a -> TidyEnv+-- Initialise an empty TidyEnv with some bound vars to avoid,+-- run the do_tidy function, and then remove the bound vars again.+-- See Note [tidyAvoiding]+tidyAvoiding bound_var_avoids do_tidy thing+  = (occs' `delTidyOccEnvList` bound_var_avoids, vars')+  where+    (occs', vars') = do_tidy init_tidy_env thing+    init_tidy_env  = mkEmptyTidyEnv (initTidyOccEnv bound_var_avoids)++---------------+trimTidyEnv :: TidyEnv -> [TyCoVar] -> TidyEnv+trimTidyEnv (occ_env, var_env) tcvs+  = (trimTidyOccEnv occ_env (map getOccName tcvs), var_env)++--------------- -- | Grabs the free type variables, tidies them -- and then uses 'tidyType' to work over the type itself-tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])-tidyOpenTypes env tys-  = (env', tidyTypes (trimmed_occ_env, var_env) tys)+tidyOpenTypesX :: TidyEnv -> [Type] -> (TidyEnv, [Type])+-- See Note [Tidying open types]+tidyOpenTypesX env tys+  = (env1, tidyTypes inner_env tys)   where-    (env'@(_, var_env), tvs') = tidyOpenTyCoVars env $-                                tyCoVarsOfTypesWellScoped tys-    trimmed_occ_env = initTidyOccEnv (map getOccName tvs')-      -- The idea here was that we restrict the new TidyEnv to the-      -- _free_ vars of the types, so that we don't gratuitously rename-      -- the _bound_ variables of the types.+    free_tcvs :: [TyCoVar] -- Closed over kinds+    free_tcvs          = tyCoVarsOfTypesList tys+    (env1, free_tcvs') = tidyFreeTyCoVarsX env free_tcvs+    inner_env          = trimTidyEnv env1 free_tcvs'  ----------------tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)-tidyOpenType env ty = let (env', [ty']) = tidyOpenTypes env [ty] in-                      (env', ty')+tidyOpenTypeX :: TidyEnv -> Type -> (TidyEnv, Type)+-- See Note [Tidying open types]+tidyOpenTypeX env ty+  = (env1, tidyType inner_env ty)+  where+    free_tcvs          = tyCoVarsOfTypeList ty+    (env1, free_tcvs') = tidyFreeTyCoVarsX env free_tcvs+    inner_env          = trimTidyEnv env1 free_tcvs'  ---------------+tidyOpenTypes :: TidyEnv -> [Type] -> [Type]+tidyOpenTypes env ty = snd (tidyOpenTypesX env ty)++tidyOpenType :: TidyEnv -> Type -> Type+tidyOpenType env ty = snd (tidyOpenTypeX env ty)++--------------- -- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment) tidyTopType :: Type -> Type tidyTopType ty = tidyType emptyTidyEnv ty@@ -217,7 +324,7 @@ -- -- See Note [Strictness in tidyType and friends] tidyCo :: TidyEnv -> Coercion -> Coercion-tidyCo env@(_, subst) co+tidyCo env co   = go co   where     go_mco MRefl    = MRefl@@ -233,13 +340,12 @@             -- the case above duplicates a bit of work in tidying h and the kind             -- of tv. But the alternative is to use coercionKind, which seems worse.     go (FunCo r afl afr w co1 co2) = ((FunCo r afl afr $! go w) $! go co1) $! go co2-    go (CoVarCo cv)          = case lookupVarEnv subst cv of-                                 Nothing  -> CoVarCo cv-                                 Just cv' -> CoVarCo cv'-    go (HoleCo h)            = HoleCo h-    go (AxiomInstCo con ind cos) = AxiomInstCo con ind $! strictMap go cos-    go (UnivCo p r t1 t2)    = (((UnivCo $! (go_prov p)) $! r) $!-                                tidyType env t1) $! tidyType env t2+    go (CoVarCo cv)          = CoVarCo $! go_cv cv+    go (HoleCo h)            = HoleCo $! go_hole h+    go (AxiomCo ax cos)      = AxiomCo ax $ strictMap go cos+    go co@(UnivCo { uco_lty  = t1, uco_rty = t2 })+                             = co { uco_lty = tidyType env t1, uco_rty = tidyType env t2 }+                               -- Don't bother to tidy the uco_deps field     go (SymCo co)            = SymCo $! go co     go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2     go (SelCo d co)          = SelCo d $! go co@@ -247,11 +353,11 @@     go (InstCo co ty)        = (InstCo $! go co) $! go ty     go (KindCo co)           = KindCo $! go co     go (SubCo co)            = SubCo $! go co-    go (AxiomRuleCo ax cos)  = AxiomRuleCo ax $ strictMap go cos -    go_prov (PhantomProv co)    = PhantomProv $! go co-    go_prov (ProofIrrelProv co) = ProofIrrelProv $! go co-    go_prov p@(PluginProv _)    = p+    go_cv cv = tidyTyCoVarOcc env cv++    go_hole (CoercionHole cv r h) = (CoercionHole $! go_cv cv) r h+    -- Tidy even the holes; tidied types should have tidied kinds  tidyCos :: TidyEnv -> [Coercion] -> [Coercion] tidyCos env = strictMap (tidyCo env)
compiler/GHC/Core/TyCon.hs view
@@ -841,7 +841,8 @@                                  --          are fine), again after expanding any                                  --          nested synonyms -        synIsForgetful :: Bool,  -- True <=  at least one argument is not mentioned+        synIsForgetful :: Bool,  -- See Note [Forgetful type synonyms]+                                 -- True <=  at least one argument is not mentioned                                  --          in the RHS (or is mentioned only under                                  --          forgetful synonyms)                                  -- Test is conservative, so True does not guarantee@@ -1564,6 +1565,7 @@  data PrimOrVoidRep = VoidRep | NVRep PrimRep   -- See Note [VoidRep] in GHC.Types.RepType+  deriving (Data.Data, Eq, Ord, Show)  data PrimElemRep   = Int8ElemRep@@ -2120,11 +2122,43 @@ -- True. Thus, False means that all bound variables appear on the RHS; -- True may not mean anything, as the test to set this flag is -- conservative.+--+-- See Note [Forgetful type synonyms] isForgetfulSynTyCon :: TyCon -> Bool isForgetfulSynTyCon (TyCon { tyConDetails = details })   | SynonymTyCon { synIsForgetful = forget } <- details = forget   | otherwise                                           = False +{- Note [Forgetful type synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A type synonyms is /forgetful/ if its RHS fails to mention one (or more) of its bound variables.++Forgetfulness is conservative:+  * A non-forgetful synonym /guarantees/ to mention all its bound variables in its RHS.+  * It is always safe to classify a synonym as forgetful.++Examples:+    type R = Int             -- Not forgetful+    type S a = Int           -- Forgetful+    type T1 a = Int -> S a   -- Forgetful+    type T2 a = a -> S a     -- Not forgetful+    type T3 a = Int -> F a   -- Not forgetful+      where type family F a++* R shows that nullary synonyms are not forgetful.++* T2 shows that forgetfulness needs to account for uses of forgetful+  synonyms. `a` appears on the RHS, but only under a forgetful S++* T3 shows that non-forgetfulness is not the same as injectivity. T3 mentions its+  bound variable on its RHS, but under a type family.  So it is entirely possible+  that    T3 Int ~ T3 Bool++* Since type synonyms are non-recursive, we don't need a fixpoint analysis to+  determine forgetfulness.  It's rather easy -- see `GHC.Core.Type.buildSynTyCon`,+  which is a bit over-conservative for over-saturated synonyms.+-}+ -- As for newtypes, it is in some contexts important to distinguish between -- closed synonyms and synonym families, as synonym families have no unique -- right hand side to which a synonym family application can expand.@@ -2330,12 +2364,12 @@  -- | The workhorse for 'isKindTyCon' and 'isKindName'. isKindUniquable :: Uniquable a => a -> Bool-isKindUniquable thing = getUnique thing `elementOfUniqSet` kindTyConKeys+isKindUniquable thing = getUnique thing `memberUniqueSet` kindTyConKeys  -- | These TyCons should be allowed at the kind level, even without -- -XDataKinds.-kindTyConKeys :: UniqSet Unique-kindTyConKeys = unionManyUniqSets+kindTyConKeys :: UniqueSet+kindTyConKeys = fromListUniqueSet $   -- Make sure to keep this in sync with the following:   --   -- - The Overview section in docs/users_guide/exts/data_kinds.rst in the GHC@@ -2343,10 +2377,10 @@   --   -- - The typecheck/should_compile/T22141f.hs test case, which ensures that all   --   of these can successfully be used without DataKinds.-  ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey, cONSTRAINTTyConKey ]-  : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon, levityTyCon-                                          , multiplicityTyCon-                                          , vecCountTyCon, vecElemTyCon ] )+  [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey, cONSTRAINTTyConKey ]+  ++ concatMap tycon_with_datacons [ runtimeRepTyCon, levityTyCon+                                   , multiplicityTyCon+                                   , vecCountTyCon, vecElemTyCon ]   where     tycon_with_datacons tc = getUnique tc : map getUnique (tyConDataCons tc) @@ -2408,7 +2442,9 @@                -- the representation be fully-known, including levity variables.                -- This might be relaxed in the future (#15532). -       TupleTyCon { tup_sort = tuple_sort } -> isBoxed (tupleSortBoxity tuple_sort)+       TupleTyCon { tup_sort = tuple_sort } -> isBoxed (tupleSortBoxity tuple_sort) ||+                                               -- (# #) also has fixed rep.+                                               tyConArity tc == 0         SumTyCon {} -> False   -- only unboxed sums here @@ -2659,7 +2695,6 @@ tyConStupidTheta tc@(TyCon { tyConDetails = details })   | AlgTyCon {algTcStupidTheta = stupid} <- details = stupid   | PrimTyCon {} <- details                         = []-  | PromotedDataCon {} <- details                   = []   | otherwise = pprPanic "tyConStupidTheta" (ppr tc)  -- | Extract the 'TyVar's bound by a vanilla type synonym
compiler/GHC/Core/TyCon.hs-boot view
@@ -12,6 +12,7 @@  type TyConRepName = Name +isNewTyCon          :: TyCon -> Bool isTupleTyCon        :: TyCon -> Bool isUnboxedTupleTyCon :: TyCon -> Bool
compiler/GHC/Core/Type.hs view
@@ -113,7 +113,7 @@         isForAllTy_ty, isForAllTy_co,         isForAllTy_invis_ty,         isPiTy, isTauTy, isFamFreeTy,-        isCoVarType, isAtomicTy,+        isAtomicTy,          isValidJoinPointType,         tyConAppNeedsKindSig,@@ -171,7 +171,7 @@          anyFreeVarsOfType, anyFreeVarsOfTypes,         noFreeVarsOfType,-        expandTypeSynonyms,+        expandTypeSynonyms, expandSynTyConApp_maybe,         typeSize, occCheckExpand,          -- ** Closing over kinds@@ -226,8 +226,10 @@         -- * Tidying type related things up for printing         tidyType,      tidyTypes,         tidyOpenType,  tidyOpenTypes,-        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,-        tidyOpenTyCoVar, tidyOpenTyCoVars,+        tidyOpenTypeX, tidyOpenTypesX,+        tidyVarBndr, tidyVarBndrs,+        tidyFreeTyCoVars,+        tidyFreeTyCoVarX, tidyFreeTyCoVarsX,         tidyTyCoVarOcc,         tidyTopType,         tidyForAllTyBinder, tidyForAllTyBinders,@@ -253,7 +255,6 @@ import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Var.Set-import GHC.Types.Unique.Set  import GHC.Core.TyCon import GHC.Builtin.Types.Prim@@ -272,7 +273,7 @@ import {-# SOURCE #-} GHC.Core.Coercion    ( mkNomReflCo, mkGReflCo, mkReflCo    , mkTyConAppCo, mkAppCo-   , mkForAllCo, mkFunCo2, mkAxiomInstCo, mkUnivCo+   , mkForAllCo, mkFunCo2, mkAxiomCo, mkUnivCo    , mkSymCo, mkTransCo, mkSelCo, mkLRCo, mkInstCo    , mkKindCo, mkSubCo, mkFunCo, funRole    , decomposePiCos, coercionKind@@ -554,10 +555,10 @@       = mkFunCo2 r afl afr (go_co subst w) (go_co subst co1) (go_co subst co2)     go_co subst (CoVarCo cv)       = substCoVar subst cv-    go_co subst (AxiomInstCo ax ind args)-      = mkAxiomInstCo ax ind (map (go_co subst) args)-    go_co subst (UnivCo p r t1 t2)-      = mkUnivCo (go_prov subst p) r (go subst t1) (go subst t2)+    go_co subst (AxiomCo ax cs)+      = mkAxiomCo ax (map (go_co subst) cs)+    go_co subst co@(UnivCo { uco_lty = lty, uco_rty = rty })+      = co { uco_lty = go subst lty, uco_rty = go subst rty }     go_co subst (SymCo co)       = mkSymCo (go_co subst co)     go_co subst (TransCo co1 co2)@@ -572,20 +573,14 @@       = mkKindCo (go_co subst co)     go_co subst (SubCo co)       = mkSubCo (go_co subst co)-    go_co subst (AxiomRuleCo ax cs)-      = AxiomRuleCo ax (map (go_co subst) cs)     go_co _ (HoleCo h)       = pprPanic "expandTypeSynonyms hit a hole" (ppr h) -    go_prov subst (PhantomProv co)    = PhantomProv (go_co subst co)-    go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co)-    go_prov _     p@(PluginProv _)    = p-       -- the "False" and "const" are to accommodate the type of       -- substForAllCoBndrUsing, which is general enough to       -- handle coercion optimization (which sometimes swaps the       -- order of a coercion)-    go_cobndr subst = substForAllCoBndrUsing False (go_co subst) subst+    go_cobndr subst = substForAllCoBndrUsing NotSwapped (go_co subst) subst  {- Notes on type synonyms ~~~~~~~~~~~~~~~~~~~~~~~~~@@ -911,7 +906,8 @@         -> (go_ty (), go_tys (), go_co (), go_cos ())  {-# INLINE mapTyCoX #-}  -- See Note [Specialising mappers]-mapTyCoX :: Monad m => TyCoMapper env m+mapTyCoX :: forall m env. Monad m+         => TyCoMapper env m          -> ( env -> Type       -> m Type             , env -> [Type]     -> m [Type]             , env -> Coercion   -> m Coercion@@ -923,6 +919,7 @@                      , tcm_hole = cohole })   = (go_ty, go_tys, go_co, go_cos)   where+    -- See Note [Use explicit recursion in mapTyCo]     go_tys !_   []       = return []     go_tys !env (ty:tys) = (:) <$> go_ty env ty <*> go_tys env tys @@ -953,12 +950,14 @@            ; inner' <- go_ty env' inner            ; return $ ForAllTy (Bndr tv' vis) inner' } +    -- See Note [Use explicit recursion in mapTyCo]     go_cos !_   []       = return []     go_cos !env (co:cos) = (:) <$> go_co env co <*> go_cos env cos      go_mco !_   MRefl    = return MRefl     go_mco !env (MCo co) = MCo <$> (go_co env co) +    go_co :: env -> Coercion -> m Coercion     go_co !env (Refl ty)                  = Refl <$> go_ty env ty     go_co !env (GRefl r ty mco)           = mkGReflCo r <$> go_ty env ty <*> go_mco env mco     go_co !env (AppCo c1 c2)              = mkAppCo <$> go_co env c1 <*> go_co env c2@@ -966,17 +965,20 @@                                            <*> go_co env c1 <*> go_co env c2     go_co !env (CoVarCo cv)               = covar env cv     go_co !env (HoleCo hole)              = cohole env hole-    go_co !env (UnivCo p r t1 t2)         = mkUnivCo <$> go_prov env p <*> pure r-                                           <*> go_ty env t1 <*> go_ty env t2+    go_co !env (UnivCo { uco_prov = p, uco_role = r+                       , uco_lty = t1, uco_rty = t2, uco_deps = deps })+                                          = mkUnivCo <$> pure p+                                                     <*> go_cos env deps+                                                     <*> pure r+                                                     <*> go_ty env t1 <*> go_ty env t2     go_co !env (SymCo co)                 = mkSymCo <$> go_co env co     go_co !env (TransCo c1 c2)            = mkTransCo <$> go_co env c1 <*> go_co env c2-    go_co !env (AxiomRuleCo r cos)        = AxiomRuleCo r <$> go_cos env cos+    go_co !env (AxiomCo r cos)            = mkAxiomCo r <$> go_cos env cos     go_co !env (SelCo i co)               = mkSelCo i <$> go_co env co     go_co !env (LRCo lr co)               = mkLRCo lr <$> go_co env co     go_co !env (InstCo co arg)            = mkInstCo <$> go_co env co <*> go_co env arg     go_co !env (KindCo co)                = mkKindCo <$> go_co env co     go_co !env (SubCo co)                 = mkSubCo <$> go_co env co-    go_co !env (AxiomInstCo ax i cos)     = mkAxiomInstCo ax i <$> go_cos env cos     go_co !env co@(TyConAppCo r tc cos)       | isTcTyCon tc       = do { tc' <- tycon tc@@ -996,11 +998,21 @@            ; return $ mkForAllCo tv' visL visR kind_co' co' }         -- See Note [Efficiency for ForAllCo case of mapTyCoX] -    go_prov !env (PhantomProv co)    = PhantomProv <$> go_co env co-    go_prov !env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co-    go_prov !_   p@(PluginProv _)    = return p +{- Note [Use explicit recursion in mapTyCo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We use explicit recursion in `mapTyCo`, rather than calling, say, `strictFoldDVarSet`,+for exactly the same reason as in Note [Use explicit recursion in foldTyCo] in+GHC.Core.TyCo.Rep. We are in a monadic context, and using too-clever higher order+functions makes the strictness analyser produce worse results. +We could probably use `foldr`, since it is inlined bodily, fairly early; but+I'm doing the simple thing and inlining it by hand.++See !12037 for performance glitches caused by using `strictFoldDVarSet` (which is+definitely not inlined bodily).+-}+ {- ********************************************************************* *                                                                      *                       TyVarTy@@ -1340,6 +1352,8 @@ funTyConAppTy_maybe af mult arg res   | Just arg_rep <- getRuntimeRep_maybe arg   , Just res_rep <- getRuntimeRep_maybe res+  -- If you're changing the lines below, you'll probably want to adapt the+  -- `fUNTyCon` case of GHC.Core.Unify.unify_ty correspondingly.   , let args | isFUNArg af = [mult, arg_rep, res_rep, arg, res]              | otherwise   = [      arg_rep, res_rep, arg, res]   = Just $ (funTyFlagTyCon af, args)@@ -1612,7 +1626,7 @@                           Just (_, tys) -> Just tys                           Nothing       -> Nothing -tyConAppArgs :: HasCallStack => Type -> [Type]+tyConAppArgs :: HasDebugCallStack => Type -> [Type] tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)  -- | Attempts to tease a type apart into a type constructor and the application@@ -1652,7 +1666,7 @@ -- -- Consequently, you may need to zonk your type before -- using this function.-tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])+tcSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) -- Defined here to avoid module loops between Unify and TcType. tcSplitTyConApp_maybe ty   = case coreFullView ty of@@ -2285,24 +2299,22 @@   = mkSynonymTyCon name binders res_kind roles rhs                    is_tau is_fam_free is_forgetful is_concrete   where+    qtvs         = mkVarSet (map binderVar binders)     is_tau       = isTauTy rhs     is_fam_free  = isFamFreeTy rhs-    is_concrete  = uniqSetAll isConcreteTyCon rhs_tycons-         -- NB: is_concrete is allowed to be conservative, returning False-         --     more often than it could.  e.g.-         --       type S a b = b-         --       type family F a-         --       type T a = S (F a) a-         -- We will mark T as not-concrete, even though (since S ignore its first-         -- argument, it could be marked concrete.--    is_forgetful = not (all ((`elemVarSet` rhs_tyvars) . binderVar) binders) ||-                   uniqSetAny isForgetfulSynTyCon rhs_tycons-         -- NB: is_forgetful is allowed to be conservative, returning True more often-         -- than it should. See comments on GHC.Core.TyCon.isForgetfulSynTyCon+    is_concrete  = isConcreteTypeWith qtvs rhs+    is_forgetful = not (qtvs `subVarSet` expanded_rhs_tyvars) -    rhs_tycons = tyConsOfType   rhs-    rhs_tyvars = tyCoVarsOfType rhs+    expanded_rhs_tyvars = tyCoVarsOfType (expandTypeSynonyms rhs)+       -- See Note [Forgetful type synonyms] in GHC.Core.TyCon+       -- To find out if this TyCon is forgetful, expand the synonyms in its RHS+       -- and check that all of the binders are free in the expanded type.+       -- We really only need to expand the /forgetful/ synonyms on the RHS,+       -- but we don't currently have a function to do that.+       -- Failing to expand the RHS led to #25094, e.g.+       --    type Bucket a b c = Key (a,b,c)+       --    type Key x = Any+       -- Here Bucket is definitely forgetful!  {- ************************************************************************@@ -2469,18 +2481,6 @@     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@@ -2848,9 +2848,17 @@ -- -- See Note [Concrete types] in GHC.Tc.Utils.Concrete. isConcreteType :: Type -> Bool-isConcreteType = go+isConcreteType = isConcreteTypeWith emptyVarSet++isConcreteTypeWith :: TyVarSet -> Type -> Bool+-- See Note [Concrete types] in GHC.Tc.Utils.Concrete.+-- For this "With" version we pass in a set of TyVars to be considered+-- concrete.  This supports mkSynonymTyCon, which needs to test the RHS+-- for concreteness, under the assumption that the binders are instantiated+-- to concrete types+isConcreteTypeWith conc_tvs = go   where-    go (TyVarTy tv)        = isConcreteTyVar tv+    go (TyVarTy tv)        = isConcreteTyVar tv || tv `elemVarSet` conc_tvs     go (AppTy ty1 ty2)     = go ty1 && go ty2     go (TyConApp tc tys)   = go_tc tc tys     go ForAllTy{}          = False@@ -3259,8 +3267,9 @@ Goal (b) is particularly useful as it makes traversals (e.g. free variable traversal, substitution, and comparison) more efficient. Comparison in particular takes special advantage of nullary type synonym-applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing-nullary type synonyms] in "GHC.Core.Type".+applications (e.g. things like @TyConApp typeTyCon []@). See+* Note [Comparing type synonyms] in "GHC.Core.TyCo.Compare"+* Note [Unifying type synonyms] in "GHC.Core.Unify"  To accomplish these we use a number of tricks, implemented by mkTyConApp.
compiler/GHC/Core/Unfold.hs view
@@ -31,27 +31,30 @@         updateVeryAggressive, updateCaseScaling,         updateCaseThreshold, updateReportPrefix, -        inlineBoringOk, calcUnfoldingGuidance+        inlineBoringOk, calcUnfoldingGuidance,+        uncondInlineJoin     ) where  import GHC.Prelude  import GHC.Core import GHC.Core.Utils-import GHC.Types.Id import GHC.Core.DataCon+import GHC.Core.Type++import GHC.Types.Id import GHC.Types.Literal-import GHC.Builtin.PrimOps import GHC.Types.Id.Info import GHC.Types.RepType ( isZeroBitTy ) import GHC.Types.Basic  ( Arity, RecFlag )-import GHC.Core.Type+import GHC.Types.ForeignCall+import GHC.Types.Tickish++import GHC.Builtin.PrimOps import GHC.Builtin.Names import GHC.Data.Bag import GHC.Utils.Misc import GHC.Utils.Outputable-import GHC.Types.ForeignCall-import GHC.Types.Tickish  import qualified Data.ByteString as BS @@ -242,16 +245,17 @@ calcUnfoldingGuidance         :: UnfoldingOpts         -> Bool          -- Definitely a top-level, bottoming binding+        -> Bool          -- True <=> join point         -> CoreExpr      -- Expression to look at         -> UnfoldingGuidance-calcUnfoldingGuidance opts is_top_bottoming (Tick t expr)+calcUnfoldingGuidance opts is_top_bottoming is_join (Tick t expr)   | not (tickishIsCode t)  -- non-code ticks don't matter for unfolding-  = calcUnfoldingGuidance opts is_top_bottoming expr-calcUnfoldingGuidance opts is_top_bottoming expr+  = calcUnfoldingGuidance opts is_top_bottoming is_join expr+calcUnfoldingGuidance opts is_top_bottoming is_join expr   = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of       TooBig -> UnfNever       SizeIs size cased_bndrs scrut_discount-        | uncondInline expr n_val_bndrs size+        | uncondInline is_join expr bndrs n_val_bndrs body size         -> UnfWhen { ug_unsat_ok = unSaturatedOk                    , ug_boring_ok =  boringCxtOk                    , ug_arity = n_val_bndrs }   -- Note [INLINE for small functions]@@ -419,14 +423,30 @@ The solution: don’t ignore coercion arguments after all. -} -uncondInline :: CoreExpr -> Arity -> Int -> Bool+uncondInline :: Bool -> CoreExpr -> [Var] -> Arity -> CoreExpr -> Int -> Bool -- Inline unconditionally if there no size increase -- Size of call is arity (+1 for the function) -- See Note [INLINE for small functions]-uncondInline rhs arity size+uncondInline is_join rhs bndrs arity body size+  | is_join   = uncondInlineJoin bndrs body   | arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1)   | otherwise = exprIsTrivial rhs        -- See Note [INLINE for small functions] (4) +uncondInlineJoin :: [Var] -> CoreExpr -> Bool+-- See Note [Duplicating join points] point (DJ3) in GHC.Core.Opt.Simplify.Iteration+uncondInlineJoin _bndrs body+  | exprIsTrivial body+  = True   -- Nullary constructors, literals++  | (Var v, args) <- collectArgs body+  , all exprIsTrivial args+  , isJoinId v   -- Indirection to another join point; always inline+  = True++  | otherwise+  = False++ sizeExpr :: UnfoldingOpts          -> Int             -- Bomb out if it gets bigger than this          -> [Id]            -- Arguments; we're interested in which of these@@ -677,7 +697,10 @@  :: Int  -- ^ number of value args  -> Int  -- ^ number of value args that are void  -> Int-jumpSize n_val_args voids = 2 * (1 + n_val_args - voids)+jumpSize _n_val_args _voids = 0   -- Jumps are small, and we don't want penalise them++  -- Old version:+  -- 2 * (1 + n_val_args - voids)   -- A jump is 20% the size of a function call. Making jumps free reopens   -- bug #6048, but making them any more expensive loses a 21% improvement in   -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a
compiler/GHC/Core/Unfold/Make.hs view
@@ -57,6 +57,7 @@   = mkUnfolding opts src                 True {- Top level -}                 (isDeadEndSig strict_sig)+                False {- Not a join point -}                 expr  -- | Same as 'mkCompulsoryUnfolding' but simplifies the unfolding first@@ -79,7 +80,7 @@  mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding mkSimpleUnfolding !opts rhs-  = mkUnfolding opts VanillaSrc False False rhs Nothing+  = mkUnfolding opts VanillaSrc False False False rhs Nothing  mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding mkDFunUnfolding bndrs con ops@@ -117,7 +118,7 @@   = mkCoreUnfolding src top_lvl new_tmpl Nothing guidance   where     new_tmpl = simpleOptExpr opts (work_fn tmpl)-    guidance = calcUnfoldingGuidance (so_uf_opts opts) False new_tmpl+    guidance = calcUnfoldingGuidance (so_uf_opts opts) False False new_tmpl  mkWorkerUnfolding _ _ _ = noUnfolding @@ -156,7 +157,7 @@  mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding mkInlinableUnfolding opts src expr-  = mkUnfolding (so_uf_opts opts) src False False expr' Nothing+  = mkUnfolding (so_uf_opts opts) src False False False expr' Nothing   where     expr' = simpleOptExpr opts expr @@ -319,16 +320,17 @@             -> Bool       -- Is top-level             -> Bool       -- Definitely a bottoming binding                           -- (only relevant for top-level bindings)+            -> Bool       -- True <=> join point             -> CoreExpr             -> Maybe UnfoldingCache             -> Unfolding -- Calculates unfolding guidance -- Occurrence-analyses the expression before capturing it-mkUnfolding opts src top_lvl is_bottoming expr cache+mkUnfolding opts src top_lvl is_bottoming is_join expr cache   = mkCoreUnfolding src top_lvl expr cache guidance   where     is_top_bottoming = top_lvl && is_bottoming-    guidance         = calcUnfoldingGuidance opts is_top_bottoming expr+    guidance         = calcUnfoldingGuidance opts is_top_bottoming is_join expr         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
compiler/GHC/Core/Unify.hs view
@@ -54,6 +54,8 @@ import Data.List ( mapAccumL ) import Control.Monad import qualified Data.Semigroup as S+import GHC.Builtin.Types.Prim (fUNTyCon)+import GHC.Core.Multiplicity  {- @@ -211,6 +213,7 @@                       False  -- Matching, not unifying                       False  -- Not an injectivity check                       match_kis+                      RespectMultiplicities                       (mkRnEnv2 in_scope) tv_env cv_env tys1 tys2 of       Unifiable (tv_env', cv_env')         -> Just $ Subst in_scope id_env tv_env' cv_env'@@ -229,6 +232,8 @@ -- See Note [Kind coercions in Unify]   = case tc_unify_tys (matchBindFun tmpl_tvs) False False                       True -- <-- this means to match the kinds+                      IgnoreMultiplicities+                        -- See Note [Rewrite rules ignore multiplicities in FunTy]                       rn_env tenv emptyCvSubstEnv [tmpl] [target] of       Unifiable (tenv', _) -> Just tenv'       _                    -> Nothing@@ -394,6 +399,40 @@ type family applications to reduce. See test case indexed-types/should_compile/Overlap14. +Note [Rewrite rules ignore multiplicities in FunTy]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the following (higher-order) rule:++m :: Bool -> Bool -> Bool+{-# RULES "m" forall f. m (f True) = f #-}++let x = m ((,) @Bool @Bool True True)++The rewrite rule expects an `f :: Bool -> Bool`, but `(,) @Bool @Bool True ::+Bool %1 -> Bool` is linear (see Note [Data constructors are linear by default]+in GHC.Core.Multiplicity) Should the rule match? Yes! According to the+principles laid out in Note [Linting linearity] in GHC.Core.Lint, optimisation+shouldn't be constrained by linearity.++However, when matching the template variable `f` to `(,) True`, we do check that+their types unify (see Note [Matching variable types] in GHC.Core.Rules). So+when unifying types for the sake of rule-matching, the unification algorithm+must be able to ignore multiplicities altogether.++How is this done?+  (1) The `um_arr_mult` field of `UMEnv` recordsw when we are doing rule-matching,+      and hence want to ignore multiplicities.+  (2) The field is set to True in by `ruleMatchTyKiX`.+  (3) It is consulted when matching `FunTy` in `unify_ty`.++Wrinkle in (3). In `unify_tc_app`, in `unify_ty`, `FunTy` is handled as if it+was a regular type constructor. In this case, and when the types being unified+are *function* arrows, but not constraint arrows, then the first argument is a+multiplicity.++We select this situation by comparing the type constructor with fUNTyCon. In+this case, and this case only, we can safely drop the first argument (using the+tail function) and unify the rest. -}  -- | Simple unification of two types; all type variables are bindable@@ -421,7 +460,7 @@ -- The code is incorporated with the standard unifier for convenience, but -- its operation should match the specification in the paper. tcUnifyTyWithTFs twoWay in_scope t1 t2-  = case tc_unify_tys alwaysBindFun twoWay True False+  = case tc_unify_tys alwaysBindFun twoWay True False RespectMultiplicities                        rn_env emptyTvSubstEnv emptyCvSubstEnv                        [t1] [t2] of       Unifiable          (tv_subst, _cv_subst) -> Just $ maybe_fix tv_subst@@ -530,7 +569,7 @@                 -> [Type] -> [Type]                 -> UnifyResult tc_unify_tys_fg match_kis bind_fn tys1 tys2-  = do { (env, _) <- tc_unify_tys bind_fn True False match_kis rn_env+  = do { (env, _) <- tc_unify_tys bind_fn True False match_kis RespectMultiplicities rn_env                                   emptyTvSubstEnv emptyCvSubstEnv                                   tys1 tys2        ; return $ niFixSubst in_scope env }@@ -544,6 +583,7 @@              -> AmIUnifying -- ^ True <=> unify; False <=> match              -> Bool        -- ^ True <=> doing an injectivity check              -> Bool        -- ^ True <=> treat the kinds as well+             -> MultiplicityFlag -- ^ see Note [Rewrite rules ignore multiplicities in FunTy] in GHC.Core.Unify              -> RnEnv2              -> TvSubstEnv  -- ^ substitution to extend              -> CvSubstEnv@@ -560,7 +600,7 @@ -- pair equal. Yet, we still don't need a separate pass to unify the kinds -- of these types, so it's appropriate to use the Ty variant of unification. -- See also Note [tcMatchTy vs tcMatchTyKi].-tc_unify_tys bind_fn unif inj_check match_kis rn_env tv_env cv_env tys1 tys2+tc_unify_tys bind_fn unif inj_check match_kis match_mults rn_env tv_env cv_env tys1 tys2   = initUM tv_env cv_env $     do { when match_kis $          unify_tys env kis1 kis2@@ -571,6 +611,7 @@                 , um_skols    = emptyVarSet                 , um_unif     = unif                 , um_inj_tf   = inj_check+                , um_arr_mult = match_mults                 , um_rn_env   = rn_env }      kis1 = map typeKind tys1@@ -1048,6 +1089,47 @@   If we couldn't decompose in the previous step, we return SurelyApart.  Afterwards, the rest of the code doesn't have to worry about type families.++Note [Unifying type synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the task of unifying two 'Type's of the form++  TyConApp tc [] ~ TyConApp tc []++where `tc` is a type synonym. A naive way to perform this comparison these+would first expand the synonym and then compare the resulting expansions.++However, this is obviously wasteful and the RHS of `tc` may be large; it is+much better to rather compare the TyCons directly. Consequently, before+expanding type synonyms in type comparisons we first look for a nullary+TyConApp and simply compare the TyCons if we find one.++Of course, if we find that the TyCons are *not* equal then we still need to+perform the expansion as their RHSs may still be unifiable.  E.g+    type T = S (a->a)+    type S a = [a]+and consider+    T Int ~ S (Int -> Int)++We can't decompose non-nullary synonyms.  E.g.+    type R a = F a    -- Where F is a type family+and consider+    R (a->a) ~ R Int+We can't conclude that  (a->) ~ Int.  (There is a currently-missed opportunity+here; if we knew that R was /injective/, perhaps we could decompose.)++We perform the nullary-type-synonym optimisation in a number of places:++ * GHC.Core.Unify.unify_ty+ * GHC.Tc.Solver.Equality.can_eq_nc'+ * GHC.Tc.Utils.Unify.uType++This optimisation is especially helpful for the ubiquitous GHC.Types.Type,+since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications+whenever possible. See Note [Using synonyms to compress types] in+GHC.Core.Type for details.++c.f. Note [Comparing type synonyms] in GHC.Core.TyCo.Compare -}  -------------- unify_ty: the main workhorse -----------@@ -1066,7 +1148,7 @@ -- Respects newtypes, PredTypes -- See Note [Computing equality on types] in GHC.Core.Type unify_ty _env (TyConApp tc1 []) (TyConApp tc2 []) _kco-  -- See Note [Comparing nullary type synonyms] in GHC.Core.TyCo.Compare+  -- See Note [Unifying type synonyms]   | tc1 == tc2   = return () @@ -1144,7 +1226,7 @@   , Just (tc2, tys2) <- mb_tc_app2   , tc1 == tc2   = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1)-       ; unify_tys env tys1 tys2+       ; unify_tc_app tc1 tys1 tys2        }    -- TYPE and CONSTRAINT are not Apart@@ -1175,6 +1257,21 @@     mb_tc_app1 = splitTyConApp_maybe ty1     mb_tc_app2 = splitTyConApp_maybe ty2 +    unify_tc_app tc tys1 tys2+      | tc == fUNTyCon+      , IgnoreMultiplicities <- um_arr_mult env+      , (_mult1 : no_mult_tys1) <- tys1+      , (_mult2 : no_mult_tys2) <- tys2+      = -- We're comparing function arrow types here (not constraint arrow+        -- types!), and they have at least one argument, which is the arrow's+        -- multiplicity annotation. The flag `um_arr_mult` instructs us to+        -- ignore multiplicities in this very case. This is a little tricky: see+        -- point (3) in Note [Rewrite rules ignore multiplicities in FunTy].+         unify_tys env no_mult_tys1 no_mult_tys2++      | otherwise+      = unify_tys env tys1 tys2+         -- Applications need a bit of care!         -- They can match FunTy and TyConApp, so use splitAppTy_maybe         -- NB: we've already dealt with type variables,@@ -1409,6 +1506,10 @@           , um_inj_tf :: Bool             -- Checking for injectivity?             -- See (end of) Note [Specification of unification]++          , um_arr_mult :: MultiplicityFlag+            -- Whether to unify multiplicity arguments when unifying arrows.+            -- See Note [Rewrite rules ignore multiplicities in FunTy]            , um_rn_env :: RnEnv2             -- Renaming InTyVars to OutTyVars; this eliminates
compiler/GHC/Core/Utils.hs view
@@ -16,7 +16,7 @@          -- * Taking expressions apart         findDefault, addDefault, findAlt, isDefaultAlt,-        mergeAlts, trimConArgs,+        mergeAlts, mergeCaseAlts, trimConArgs,         filterAlts, combineIdenticalAlts, refineDefaultAlt,         scaleAltsBy, @@ -71,8 +71,10 @@  import GHC.Core 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@@ -96,6 +98,7 @@ import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Types.Demand+import GHC.Types.RepType (isZeroBitTy)  import GHC.Data.FastString import GHC.Data.Maybe@@ -111,8 +114,8 @@ import Data.Function       ( on ) import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL ) import Data.Ord            ( comparing )+import Control.Monad       ( guard ) import qualified Data.Set as Set-import GHC.Types.RepType (isZeroBitTy)  {- ************************************************************************@@ -266,43 +269,30 @@ -- | Wrap the given expression in the coercion safely, dropping -- identity coercions and coalescing nested coercions mkCast :: HasDebugCallStack => CoreExpr -> CoercionR -> CoreExpr-mkCast e co-  | assertPpr (coercionRole co == Representational)-              (text "coercion" <+> ppr co <+> text "passed to mkCast"-               <+> ppr e <+> text "has wrong role" <+> ppr (coercionRole co)) $-    isReflCo co-  = e -mkCast (Coercion e_co) co-  | isCoVarType (coercionRKind co)-       -- The guard here checks that g has a (~#) on both sides,-       -- otherwise decomposeCo fails.  Can in principle happen-       -- with unsafeCoerce-  = Coercion (mkCoCast e_co co)--mkCast (Cast expr co2) co-  = warnPprTrace (let { from_ty = coercionLKind co;-                        to_ty2  = coercionRKind co2 } in-                     not (from_ty `eqType` to_ty2))-             "mkCast"-             (vcat ([ text "expr:" <+> ppr expr-                   , text "co2:" <+> ppr co2-                   , text "co:" <+> ppr co ])) $-    mkCast expr (mkTransCo co2 co)--mkCast (Tick t expr) co-   = Tick t (mkCast expr co)- mkCast expr co-  = let from_ty = coercionLKind co in-    warnPprTrace (not (from_ty `eqType` exprType expr))+  = assertPpr (coercionRole co == Representational)+              (text "coercion" <+> ppr co <+> text "passed to mkCast"+               <+> ppr expr <+> text "has wrong role" <+> ppr (coercionRole co)) $+    warnPprTrace (not (coercionLKind co `eqType` exprType expr))           "Trying to coerce" (text "(" <> ppr expr           $$ text "::" <+> ppr (exprType expr) <> text ")"           $$ ppr co $$ ppr (coercionType co)           $$ callStackDoc) $-    (Cast expr co)+    case expr of+      Cast expr co2 -> mkCast expr (mkTransCo co2 co)+      Tick t expr   -> Tick t (mkCast expr co) +      Coercion e_co | isCoVarType (coercionRKind co)+         -- The guard here checks that g has a (~#) on both sides,+         -- otherwise decomposeCo fails.  Can in principle happen+         -- with unsafeCoerce+                      -> Coercion (mkCoCast e_co co) +      _ | isReflCo co -> expr+        | otherwise   -> Cast expr co++ {- ********************************************************************* *                                                                      *              Attaching ticks@@ -656,6 +646,76 @@ -}  ---------------------------------+mergeCaseAlts :: Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])+-- See Note [Merge Nested Cases]+mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)+  | Just (joins, inner_alts) <- go deflt_rhs+  = Just (joins, mergeAlts outer_alts inner_alts)+                -- NB: mergeAlts gives priority to the left+                --      case x of+                --        A -> e1+                --        DEFAULT -> case x of+                --                      A -> e2+                --                      B -> e3+                -- When we merge, we must ensure that e1 takes+                -- precedence over e2 as the value for A!+  where+    go :: CoreExpr -> Maybe ([CoreBind], [CoreAlt])++    -- Whizzo: we can merge!+    go (Case (Var inner_scrut_var) inner_bndr _ inner_alts)+       | inner_scrut_var == outer_bndr+       , not (inner_bndr == outer_bndr)   -- Avoid shadowing+       , let wrap_let rhs' = Let (NonRec inner_bndr (Var outer_bndr)) rhs'+                -- inner_bndr is never dead!  It's the scrutinee!+                -- The let is OK even for unboxed binders+                -- See Note [Merge Nested Cases] wrinkle (MC2)+             do_one (Alt con bndrs rhs)+               | any (== outer_bndr) bndrs = Nothing+               | otherwise                 = Just (Alt con bndrs (wrap_let rhs))+       = do { alts' <- mapM do_one inner_alts+            ; return ([], alts') }++    -- Deal with tagToEnum# See Note [Merge Nested Cases] wrinkle (MC3)+    go (App (App (Var f) (Type type_arg)) (Var v))+      | v == outer_bndr+      , Just TagToEnumOp <- isPrimOpId_maybe f+      , Just tc  <- tyConAppTyCon_maybe type_arg+      , Just (dc1:dcs) <- tyConDataCons_maybe tc   -- At least one data constructor+      , dcs `lengthAtMost` 3  -- Arbitrary+      = return ( [], mk_alts dc1 dcs)+      where+        mk_lit dc = mkLitIntUnchecked $ toInteger $ dataConTagZ dc+        mk_rhs dc = Var (dataConWorkId dc)+        mk_alts dc1 dcs =  Alt DEFAULT              [] (mk_rhs dc1)+                        : [Alt (LitAlt (mk_lit dc)) [] (mk_rhs dc) | dc <- dcs]++    -- Float out let/join bindings+    -- See Note [Merge Nested Cases] wrinkle (MC4)+    go (Let bind body)+      | null outer_alts || isJoinBind bind+      = do { (joins, alts) <- go body++             -- Check for capture; but only if we could otherwise do a merge+           ; let capture = outer_bndr `elem` bindersOf bind+                           || outer_bndr `elemVarSet` bindFreeVars bind+           ; guard (not capture)++           ; return (bind:joins, alts ) }+      | otherwise+      = Nothing++    -- We don't want ticks to get in the way; just push them inwards.+    -- (This happens when you add SourceTicks e.g. GHC.Num.Integer.integerLt#)+    go (Tick t body)+      = do { (joins, alts) <- go body+           ; return (joins, [Alt con bs (Tick t rhs) | Alt con bs rhs <- alts]) }++    go _ = Nothing++mergeCaseAlts _ _ = Nothing++--------------------------------- mergeAlts :: [Alt a] -> [Alt a] -> [Alt a] -- ^ Merge alternatives preserving order; alternatives in -- the first argument shadow ones in the second@@ -770,7 +830,165 @@   | otherwise      -- The common case   = (False, all_alts) -{- Note [Refine DEFAULT case alternatives]+{- Note [Merge Nested Cases]+~~~~~~~~~~~~~~~~~~~~~~~~~+       case e of b {             ==>   case e of b {+         p1 -> rhs1                      p1 -> rhs1+         ...                             ...+         pm -> rhsm                      pm -> rhsm+         _  -> case b of b' {            pn -> let b'=b in rhsn+                     pn -> rhsn          ...+                     ...                 po -> let b'=b in rhso+                     po -> rhso          _  -> let b'=b in rhsd+                     _  -> rhsd+       }++which merges two cases in one case when -- the default alternative of+the outer case scrutinises the same variable as the outer case. This+transformation is called Case Merging.  It avoids that the same+variable is scrutinised multiple times.++Wrinkles++(MC1) Historical note. I tried making `mergeCaseAlts` "looks though" an inner+     single-alternative case-on-variable. For example+       case x of {+          ...outer-alts...+          DEFAULT -> case y of (a,b) ->+                     case x of { A -> rhs1; B -> rhs2 }+    ===>+       case x of+         ...outer-alts...+         a -> case y of (a,b) -> rhs1+         B -> case y of (a,b) -> rhs2++    This duplicates the `case y` but it removes the case x; so it is a win+    in terms of execution time (combining the cases on x) at the cost of+    perhaps duplicating the `case y`.  A case in point is integerEq, which+    is defined thus+        integerEq :: Integer -> Integer -> Bool+        integerEq !x !y = isTrue# (integerEq# x y)+    which becomes+        integerEq+          = \ (x :: Integer) (y_aAL :: Integer) ->+              case x of x1 { __DEFAULT ->+              case y of y1 { __DEFAULT ->+              case x1 of {+                IS x2 -> case y1 of {+                           __DEFAULT -> GHC.Types.False;+                           IS y2     -> tagToEnum# @Bool (==# x2 y2) };+                IP x2 -> ...+                IN x2 -> ...+    We want to merge the outer `case x` with the inner `case x1`.++    But (a) this is all a bit dubious: see #24251, and+        (b) it is hard to combine with (MC4)+    So I'm not doing this any more.  If we want to do it, we'll handle it+    separately: #24251.++    End of historical note++(MC2) The auxiliary bindings b'=b are annoying, because they force another+      simplifier pass, but there seems no easy way to avoid them.  See+      Note [Which transformations are innocuous] in GHC.Core.Opt.Stats.++(MC3) Consider+         case f x of (r::Int#) -> tagToEnum# r :: Bool+      `mergeCaseAlts` as a special case to treat this as if it was+         case f x of r ->+           case r of { 0# -> False; 1# -> True }+      which can be merged to+         case f x of { 0# -> False; 1# -> True }++      To see why this is important, return to+         case f x of (r::Int#) -> tagToEnum# r :: Bool+      and supppose `f` inlines to a case expression.  Then then we get+         let $j r = tagToEnum# r+         case .. of { .. jump $j 0#; ...jump $j 1# ... }+      Now if the entire expression is consumed by another case-expression,+      that outer case will only see (tagToEnum# r) which it can't do much+      with.  Whereas the result of the above case-merge generates much better+      code: no branching on Int#++(MC4) Consider+          case f x of r ->+            join $j y = <rhs> in+            case r of { ...alts ... }+      This is pretty common, and it a pity for it to defeat the case-merge+      transformation; and it makes the optimiser fragile to inlining decisions+      for join points.++      So `mergeCaseAlts` floats out any join points. It doesn't float out+      non-join-points unless the /outer/ case has just one alternative; doing+      so would risk more allocation++(MC5) See Note [Cascading case merge]++See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils+++Note [Cascading case merge]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Case merging should cascade in one sweep, because the Simplifier tries it /after/+simplifying (and hence case-merging) the inner case.  For example++      case e of a {+        DEFAULT -> case a of b+                      DEFAULT -> case b of c {+                                     DEFAULT -> e+                                     A -> ea+                      B -> eb+        C -> ec+==> {simplify inner case}+      case e of a {+        DEFAULT -> case a of b+                      DEFAULT -> let c = b in e+                      A -> let c = b in ea+                      B -> eb+        C -> ec+==> {case-merge on outer case}+      case e of a {+        DEFAULT -> let b = a in let c = b in e+        A -> let b = a in let c = b in ea+        B -> let b = a in eb+        C -> ec+++However here's a tricky case that we still don't catch, and I don't+see how to catch it in one pass:++  case x of c1 { I# a1 ->+  case a1 of c2 ->+    0 -> ...+    DEFAULT -> case x of c3 { I# a2 ->+               case a2 of ...++After occurrence analysis (and its binder-swap) we get this++  case x of c1 { I# a1 ->+  let x = c1 in         -- Binder-swap addition+  case a1 of c2 ->+    0 -> ...+    DEFAULT -> case x of c3 { I# a2 ->+               case a2 of ...++When we simplify the inner case x, we'll see that+x=c1=I# a1.  So we'll bind a2 to a1, and get++  case x of c1 { I# a1 ->+  case a1 of c2 ->+    0 -> ...+    DEFAULT -> case a1 of ...++This is correct, but we can't do a case merge in this sweep+because c2 /= a1.  Reason: the binding c1=I# a1 went inwards+without getting changed to c1=I# c2.++I don't think this is worth fixing, even if I knew how. It'll+all come out in the next pass anyway.+++Note [Refine DEFAULT case alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ refineDefaultAlt replaces the DEFAULT alt with a constructor if there is one possible value it could be.
compiler/GHC/CoreToIface.hs view
@@ -121,7 +121,7 @@ toIfaceTvBndr = toIfaceTvBndrX emptyVarSet  toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr-toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar)+toIfaceTvBndrX fr tyvar = ( mkIfLclName (occNameFS (getOccName tyvar))                           , toIfaceTypeX fr (tyVarKind tyvar)                           ) @@ -133,7 +133,7 @@  toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr toIfaceIdBndrX fr covar = ( toIfaceType (idMult covar)-                          , occNameFS (getOccName covar)+                          , mkIfLclName (occNameFS (getOccName covar))                           , toIfaceTypeX fr (varType covar)                           ) @@ -176,7 +176,7 @@ --    translates the tyvars in 'free' as IfaceFreeTyVars -- -- Synonyms are retained in the interface type-toIfaceTypeX fr (TyVarTy tv)   -- See Note [Free tyvars in IfaceType] in GHC.Iface.Type+toIfaceTypeX fr (TyVarTy tv)   -- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type   | tv `elemVarSet` fr         = IfaceFreeTyVar tv   | otherwise                  = IfaceTyVar (toIfaceTyVar tv) toIfaceTypeX fr ty@(AppTy {})  =@@ -218,11 +218,11 @@     arity = tyConArity tc     n_tys = length tys -toIfaceTyVar :: TyVar -> FastString-toIfaceTyVar = occNameFS . getOccName+toIfaceTyVar :: TyVar -> IfLclName+toIfaceTyVar = mkIfLclName . occNameFS . getOccName -toIfaceCoVar :: CoVar -> FastString-toIfaceCoVar = occNameFS . getOccName+toIfaceCoVar :: CoVar -> IfLclName+toIfaceCoVar = mkIfLclName . occNameFS . getOccName  ---------------- toIfaceTyCon :: TyCon -> IfaceTyCon@@ -264,7 +264,7 @@  toIfaceTyLit :: TyLit -> IfaceTyLit toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x-toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x+toIfaceTyLit (StrTyLit x) = IfaceStrTyLit (LexicalFastString x) toIfaceTyLit (CharTyLit x) = IfaceCharTyLit x  ----------------@@ -283,24 +283,23 @@     go (Refl ty)            = IfaceReflCo (toIfaceTypeX fr ty)     go (GRefl r ty mco)     = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)     go (CoVarCo cv)-      -- See Note [Free tyvars in IfaceType] in GHC.Iface.Type-      | cv `elemVarSet` fr  = IfaceFreeCoVar cv-      | otherwise           = IfaceCoVarCo (toIfaceCoVar cv)-    go (HoleCo h)           = IfaceHoleCo  (coHoleCoVar h)+      -- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type+      | cv `elemVarSet` fr = IfaceFreeCoVar cv+      | otherwise          = IfaceCoVarCo (toIfaceCoVar cv)+    go (HoleCo h)          = IfaceHoleCo  (coHoleCoVar h) -    go (AppCo co1 co2)      = IfaceAppCo  (go co1) (go co2)-    go (SymCo co)           = IfaceSymCo (go co)-    go (TransCo co1 co2)    = IfaceTransCo (go co1) (go co2)-    go (SelCo d co)         = IfaceSelCo d (go co)-    go (LRCo lr co)         = IfaceLRCo lr (go co)-    go (InstCo co arg)      = IfaceInstCo (go co) (go arg)-    go (KindCo c)           = IfaceKindCo (go c)-    go (SubCo co)           = IfaceSubCo (go co)-    go (AxiomRuleCo co cs)  = IfaceAxiomRuleCo (coaxrName co) (map go cs)-    go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs)-    go (UnivCo p r t1 t2)   = IfaceUnivCo (go_prov p) r-                                          (toIfaceTypeX fr t1)-                                          (toIfaceTypeX fr t2)+    go (AppCo co1 co2)     = IfaceAppCo  (go co1) (go co2)+    go (SymCo co)          = IfaceSymCo (go co)+    go (TransCo co1 co2)   = IfaceTransCo (go co1) (go co2)+    go (SelCo d co)        = IfaceSelCo d (go co)+    go (LRCo lr co)        = IfaceLRCo lr (go co)+    go (InstCo co arg)     = IfaceInstCo (go co) (go arg)+    go (KindCo c)          = IfaceKindCo (go c)+    go (SubCo co)          = IfaceSubCo (go co)+    go (AxiomCo ax cs)     = IfaceAxiomCo (toIfaceAxiomRule ax) (map go cs)+    go (UnivCo { uco_prov = p, uco_role = r, uco_lty = t1, uco_rty = t2, uco_deps = deps })+        = IfaceUnivCo p r (toIfaceTypeX fr t1) (toIfaceTypeX fr t2) (map go deps)+     go co@(TyConAppCo r tc cos)       =  assertPpr (isNothing (tyConAppFunCo_maybe r tc cos)) (ppr co) $          IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)@@ -317,10 +316,11 @@                           where                             fr' = fr `delVarSet` tv -    go_prov :: UnivCoProvenance -> IfaceUnivCoProv-    go_prov (PhantomProv co)    = IfacePhantomProv (go co)-    go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co)-    go_prov (PluginProv str)    = IfacePluginProv str+toIfaceAxiomRule :: CoAxiomRule -> IfaceAxiomRule+toIfaceAxiomRule (BuiltInFamRew  bif) = IfaceAR_X (mkIfLclName (bifrw_name bif))+toIfaceAxiomRule (BuiltInFamInj bif)  = IfaceAR_X (mkIfLclName (bifinj_name bif))+toIfaceAxiomRule (BranchedAxiom ax i) = IfaceAR_B (coAxiomName ax) i+toIfaceAxiomRule (UnbranchedAxiom ax) = IfaceAR_U (coAxiomName ax)  toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs toIfaceTcArgs = toIfaceTcArgsX emptyVarSet@@ -430,10 +430,10 @@ toIfaceBang _   (HsStrict _)         = IfStrict  toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang-toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang+toIfaceSrcBang (HsSrcBang _ (HsBang unpk bang)) = IfSrcBang unpk bang  toIfaceLetBndr :: Id -> IfaceLetBndr-toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))+toIfaceLetBndr id  = IfLetBndr (mkIfLclName (occNameFS (getOccName id)))                                (toIfaceType (idType id))                                (toIfaceIdInfo (idInfo id))                                (idJoinPointHood id)@@ -444,7 +444,7 @@ toIfaceTopBndr id   = if isExternalName name       then IfGblTopBndr name-      else IfLclTopBndr (occNameFS (getOccName id)) (toIfaceType (idType id))+      else IfLclTopBndr (mkIfLclName (occNameFS (getOccName id))) (toIfaceType (idType id))                         (toIfaceIdInfo (idInfo id)) (toIfaceIdDetails (idDetails id))   where     name = getName id@@ -555,7 +555,7 @@ toIfaceExpr (App f a)       = toIfaceApp f [a] toIfaceExpr (Case s x ty as)   | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)-  | otherwise               = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)+  | otherwise               = IfaceCase (toIfaceExpr s) (mkIfLclName (getOccFS x)) (map toIfaceAlt as) toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e) toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co) toIfaceExpr (Tick t e)      = IfaceTick (toIfaceTickish t) (toIfaceExpr e)@@ -599,7 +599,7 @@           in (top_bndr, rhs')          -- The sharing behaviour is currently disabled due to #22807, and relies on-        -- finished #220056 to be re-enabled.+        -- finished #20056 to be re-enabled.         disabledDueTo22807 = True          already_has_unfolding b = not disabledDueTo22807@@ -610,7 +610,7 @@  --------------------- toIfaceAlt :: CoreAlt -> IfaceAlt-toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map getOccFS bs) (toIfaceExpr r)+toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map (mkIfLclName . getOccFS) bs) (toIfaceExpr r)  --------------------- toIfaceCon :: AltCon -> IfaceConAlt@@ -618,7 +618,7 @@ toIfaceCon (LitAlt l)   = assertPpr (not (isLitRubbish l)) (ppr l) $                           -- assert: see Note [Rubbish literals] wrinkle (b)                           IfaceLitAlt l-toIfaceCon DEFAULT      = IfaceDefault+toIfaceCon DEFAULT      = IfaceDefaultAlt  --------------------- toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr@@ -655,7 +655,7 @@                                       -- Foreign calls have special syntax      | isExternalName name             = IfaceExt name-    | otherwise                       = IfaceLcl (occNameFS $ nameOccName name)+    | otherwise                       = IfaceLcl (mkIfLclName (occNameFS $ nameOccName name))   where     name = idName v     ty   = idType v@@ -771,8 +771,8 @@ Note [Interface File with Core: Sharing RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -IMPORTANT: This optimisation is currently disabled due to #22027, it can be-           re-enabled once #220056 is implemented.+IMPORTANT: This optimisation is currently disabled due to #22807, it can be+           re-enabled once #22056 is implemented.  In order to avoid duplicating definitions for bindings which already have unfoldings we do some minor headstands to avoid serialising the RHS of a definition if it has
compiler/GHC/Data/FastString.hs view
@@ -198,8 +198,8 @@  -- ----------------------------------------------------------------------------- -{-| A 'FastString' is a UTF-8 encoded string together with a unique ID. All-'FastString's are stored in a global hashtable to support fast O(1)+{-| A 'FastString' is a Modified UTF-8 encoded string together with a unique ID.+All 'FastString's are stored in a global hashtable to support fast O(1) comparison.  It is also associated with a lazy reference to the Z-encoding@@ -283,13 +283,16 @@ -- `lexicalCompareFS` (i.e. which compares FastStrings on their String -- representation). Hence it is deterministic from one run to the other. newtype LexicalFastString-   = LexicalFastString FastString+   = LexicalFastString { getLexicalFastString :: FastString }    deriving newtype (Eq, Show)    deriving stock Data  instance Ord LexicalFastString where    compare (LexicalFastString fs1) (LexicalFastString fs2) = lexicalCompareFS fs1 fs2 +instance NFData LexicalFastString where+  rnf (LexicalFastString f) = rnf f+ -- ----------------------------------------------------------------------------- -- Construction @@ -304,9 +307,18 @@ See Note [Updating the FastString table] on how it's updated. -} data FastStringTable = FastStringTable-  {-# UNPACK #-} !FastMutInt -- the unique ID counter shared with all buckets-  {-# UNPACK #-} !FastMutInt -- number of computed z-encodings for all buckets-  (Array# (IORef FastStringTableSegment)) -- concurrent segments+  {-# UNPACK #-} !FastMutInt+  -- ^ The unique ID counter shared with all buckets+  --+  -- We unpack the 'FastMutInt' counter as it is always consumed strictly.+  {-# NOUNPACK #-} !FastMutInt+  -- ^ Number of computed z-encodings for all buckets.+  --+  -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk+  -- in 'mkFastStringWith' and needs to be boxed any way.+  -- If this is unpacked, then we box this single 'FastMutInt' once for each+  -- allocated FastString.+  (Array# (IORef FastStringTableSegment)) -- ^  concurrent segments  data FastStringTableSegment = FastStringTableSegment   {-# UNPACK #-} !(MVar ())  -- the lock for write in each segment
compiler/GHC/Data/FlatBag.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE UnboxedTuples #-} module GHC.Data.FlatBag-  ( FlatBag+  ( FlatBag(EmptyFlatBag, UnitFlatBag, TupleFlatBag)   , emptyFlatBag   , unitFlatBag   , sizeFlatBag
compiler/GHC/Data/Maybe.hs view
@@ -33,7 +33,7 @@ import Control.Exception (SomeException(..)) import Data.Maybe import Data.Foldable ( foldlM, for_ )-import GHC.Utils.Misc (HasCallStack)+import GHC.Utils.Misc (HasDebugCallStack) import Data.List.NonEmpty ( NonEmpty ) import Control.Applicative( Alternative( (<|>) ) ) @@ -66,7 +66,7 @@   go Nothing         action  = action   go result@(Just _) _action = return result -expectJust :: HasCallStack => String -> Maybe a -> a+expectJust :: HasDebugCallStack => String -> Maybe a -> a {-# INLINE expectJust #-} expectJust _   (Just x) = x expectJust err Nothing  = error ("expectJust " ++ err)
+ compiler/GHC/Data/OsPath.hs view
@@ -0,0 +1,29 @@+module GHC.Data.OsPath+  (+  -- * OsPath initialisation and transformation+    OsPath+  , OsString+  , encodeUtf+  , decodeUtf+  , unsafeDecodeUtf+  , unsafeEncodeUtf+  , os+  -- * Common utility functions+  , (</>)+  , (<.>)+  )+  where++import GHC.Prelude++import GHC.Utils.Misc (HasCallStack)+import GHC.Utils.Panic (panic)++import System.OsPath+import System.Directory.Internal (os)++-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.+-- Prefer 'decodeUtf' and gracious error handling.+unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath+unsafeDecodeUtf p =+  either (\err -> panic $ "Failed to decodeUtf \"" ++ show p ++ "\", because: " ++ show err) id (decodeUtf p)
compiler/GHC/Data/Pair.hs view
@@ -11,8 +11,8 @@    , unPair    , toPair    , swap-   , pLiftFst-   , pLiftSnd+   , pLiftFst, pLiftSnd+   , unzipPairs    ) where @@ -58,3 +58,11 @@  pLiftSnd :: (a -> a) -> Pair a -> Pair a pLiftSnd f (Pair a b) = Pair a (f b)++unzipPairs :: [Pair a] -> ([a], [a])+unzipPairs [] = ([], [])+unzipPairs (Pair a b : prs) = (a:as, b:bs)+  where+    !(as,bs) = unzipPairs prs+    -- This makes the unzip work eagerly, building no thunks at+    -- the cost of doing all the work up-front.
compiler/GHC/Data/Stream.hs view
@@ -9,7 +9,7 @@  -- | Monadic streams module GHC.Data.Stream (-    Stream(..), StreamS(..), runStream, yield, liftIO,+    Stream(..), StreamS(..), runStream, yield, liftIO, liftEff, hoistEff,     collect,  consume, fromList,     map, mapM, mapAccumL_   ) where@@ -140,3 +140,22 @@     go c f1 h1 (Yield a p) = Effect (f c a >>= (\(c', b) -> f1 b                                            >>= \r' -> return $ Yield r' (go c' f1 h1 p)))     go c f1 h1 (Effect m) = Effect (go c f1 h1 <$> m)++-- | Lift an effect into the Stream+liftEff :: Monad m => m b -> Stream m a b+liftEff eff = Stream $ \_f g -> Effect (g <$> eff)++-- | Hoist the underlying Stream effect+-- Note this is not very efficience since, just like 'mapAccumL_', it also needs+-- to traverse and rebuild the whole stream.+hoistEff :: forall m n a b. (Applicative m, Monad n) => (forall x. m x -> n x) -> Stream m a b -> Stream n a b+hoistEff h s = Stream $ \f g -> hs f g (runStream s :: StreamS m a b) where+  hs :: (a -> n r')+     -> (b -> StreamS n r' r)+     -> StreamS m a b+     -> StreamS n r' r+  hs f g x = case x of+    Done d -> g d+    Yield a r -> Effect (f a >>= \r' -> return $ Yield r' (hs f g r))+    Effect e -> Effect (h (hs f g <$> e))+
compiler/GHC/Data/Strict.hs view
@@ -9,8 +9,8 @@ module GHC.Data.Strict (     Maybe(Nothing, Just),     fromMaybe,+    GHC.Data.Strict.maybe,     Pair(And),-     -- Not used at the moment:     --     -- Either(Left, Right),@@ -18,6 +18,7 @@   ) where  import GHC.Prelude hiding (Maybe(..), Either(..))+ import Control.Applicative import Data.Semigroup import Data.Data@@ -28,6 +29,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x++maybe :: b -> (a -> b) -> Maybe a -> b+maybe d _ Nothing = d+maybe _ f (Just x) = f x  apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x)
compiler/GHC/Data/StringBuffer.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE LambdaCase #-}  {-# OPTIONS_GHC -O2 #-} -- We always optimise this, otherwise performance of a non-optimised@@ -47,6 +48,7 @@           -- * Parsing integers         parseUnsignedInteger,+        findHashOffset,          -- * Checking for bi-directional format characters         containsBidirectionalFormatChar,@@ -417,3 +419,15 @@                '_'  -> go (i + 1) x    -- skip "_" (#14473)                char -> go (i + 1) (x * radix + toInteger (char_to_int char))   in go 0 0++-- | Find the offset of the '#' character in the StringBuffer.+--+-- Make sure that it contains one before calling this function!+findHashOffset :: StringBuffer -> Int+findHashOffset (StringBuffer buf _ cur)+  = inlinePerformIO $ withForeignPtr buf $ \ptr -> do+      let+        go p = peek p >>= \case+          (0x23 :: Word8) -> pure $! ((p `minusPtr` ptr) - cur)+          _               -> go (p `plusPtr` 1)+      go (ptr `plusPtr` cur)
compiler/GHC/Data/TrieMap.hs view
@@ -13,8 +13,6 @@    MaybeMap,    -- * Maps over 'List' values    ListMap,-   -- * Maps over 'Literal's-   LiteralMap,    -- * 'TrieMap' class    TrieMap(..), insertTM, deleteTM, foldMapTM, isEmptyTM, @@ -30,7 +28,6 @@  import GHC.Prelude -import GHC.Types.Literal import GHC.Types.Unique.DFM import GHC.Types.Unique( Uniquable ) @@ -342,16 +339,6 @@ ftList :: TrieMap m => (a -> Bool) -> ListMap m a -> ListMap m a ftList f (LM { lm_nil = mnil, lm_cons = mcons })   = LM { lm_nil = filterMaybe f mnil, lm_cons = fmap (filterTM f) mcons }--{--************************************************************************-*                                                                      *-                   Basic maps-*                                                                      *-************************************************************************--}--type LiteralMap  a = Map.Map Literal a  {- ************************************************************************
compiler/GHC/Data/Word64Set/Internal.hs view
@@ -205,7 +205,6 @@ import qualified GHC.Exts #endif -import qualified Data.Foldable as Foldable import Data.Functor.Identity (Identity(..))  infixl 9 \\{-This comment teaches CPP correct behaviour -}@@ -519,10 +518,10 @@   Union --------------------------------------------------------------------} -- | The union of a list of sets.-unions :: Foldable f => f Word64Set -> Word64Set-unions xs-  = Foldable.foldl' union empty xs +{-# INLINABLE unions #-}+unions :: [Word64Set] -> Word64Set+unions = List.foldl' union empty  -- | \(O(n+m)\). The union of two sets. union :: Word64Set -> Word64Set -> Word64Set@@ -1183,9 +1182,9 @@   -- | \(O(n \min(n,W))\). Create a set from a list of integers.+{-# INLINABLE fromList #-} fromList :: [Key] -> Word64Set-fromList xs-  = Foldable.foldl' ins empty xs+fromList = List.foldl' ins empty   where     ins t x  = insert x t
compiler/GHC/Driver/Backend.hs view
@@ -213,6 +213,7 @@          ArchPPC_64 {} -> True          ArchAArch64   -> True          ArchWasm32    -> True+         ArchRISCV64   -> True          _             -> False  -- | Is the platform supported by the JS backend?@@ -511,7 +512,7 @@ backendRespectsSpecialise (Named Interpreter) = False backendRespectsSpecialise (Named NoBackend)   = False --- | This back end wants the `mi_globals` field of a+-- | This back end wants the `mi_top_env` field of a -- `ModIface` to be populated (with the top-level bindings -- of the original source).  Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool@@ -554,12 +555,12 @@ -- `NotValid`, it carries a message that is shown to -- users. backendSimdValidity :: Backend -> Validity' String-backendSimdValidity (Named NCG)         = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."]+backendSimdValidity (Named NCG)         = IsValid backendSimdValidity (Named LLVM)        = IsValid-backendSimdValidity (Named ViaC)        = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."]-backendSimdValidity (Named JavaScript)  = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."]-backendSimdValidity (Named Interpreter) = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."]-backendSimdValidity (Named NoBackend)   = NotValid $ unlines ["SIMD vector instructions require the LLVM back-end.","Please use -fllvm."]+backendSimdValidity (Named ViaC)        = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]+backendSimdValidity (Named JavaScript)  = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]+backendSimdValidity (Named Interpreter) = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]+backendSimdValidity (Named NoBackend)   = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]  -- | This flag says whether the back end supports large -- binary blobs.  See Note [Embedding large binary blobs]
compiler/GHC/Driver/Config/Core/Lint.hs view
@@ -132,7 +132,7 @@     -- 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/Driver/DynFlags.hs view
@@ -42,6 +42,8 @@          targetProfile, +        ReexportedModule(..),+         -- ** Manipulating DynFlags         defaultDynFlags,                -- Settings -> DynFlags         initDynFlags,                   -- DynFlags -> IO DynFlags@@ -60,10 +62,6 @@         versionedAppDir, versionedFilePath,         extraGccViaCFlags, globalPackageDatabasePath, -        -- * Linker/compiler information-        LinkerInfo(..),-        CompilerInfo(..),-         -- * Include specifications         IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,         addImplicitQuoteInclude,@@ -73,6 +71,7 @@         initPromotionTickContext,          -- * Platform features+        isSse4_1Enabled,         isSse4_2Enabled,         isAvxEnabled,         isAvx2Enabled,@@ -207,6 +206,7 @@   dmdUnboxWidth         :: !Int,        -- ^ Whether DmdAnal should optimistically put an                                         --   Unboxed demand on returned products with at most                                         --   this number of fields+  ifCompression         :: Int,   specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function   specConstrRecursive   :: Int,         -- ^ Max number of specialisations for recursive types@@ -253,7 +253,7 @@   workingDirectory      :: Maybe FilePath,   thisPackageName       :: Maybe String, -- ^ What the package is called, use with multiple home units   hiddenModules         :: Set.Set ModuleName,-  reexportedModules     :: Set.Set ModuleName,+  reexportedModules     :: [ReexportedModule],    -- ways   targetWays_           :: Ways,         -- ^ Target way flags from the command line@@ -547,6 +547,7 @@         maxPmCheckModels        = 30,         simplTickFactor         = 100,         dmdUnboxWidth           = 3,      -- Default: Assume an unboxed demand on function bodies returning a triple+        ifCompression           = 2,      -- Default: Apply safe compressions         specConstrThreshold     = Just 2000,         specConstrCount         = Just 3,         specConstrRecursive     = 3,@@ -581,7 +582,7 @@         workingDirectory        = Nothing,         thisPackageName         = Nothing,         hiddenModules           = Set.empty,-        reexportedModules       = Set.empty,+        reexportedModules       = [],          objectDir               = Nothing,         dylibInstallName        = Nothing,@@ -759,31 +760,6 @@   -- | Use the specific semaphore @<sem>@ to control parallelism (@-jsem <sem>@ flag).   | ParMakeSemaphore FilePath --- -------------------------------------------------------------------------------- Linker/compiler information---- LinkerInfo contains any extra options needed by the system linker.-data LinkerInfo-  = GnuLD    [Option]-  | Mold     [Option]-  | GnuGold  [Option]-  | LlvmLLD  [Option]-  | DarwinLD [Option]-  | SolarisLD [Option]-  | AixLD    [Option]-  | UnknownLD-  deriving Eq---- CompilerInfo tells us which C compiler we're using-data CompilerInfo-   = GCC-   | Clang-   | AppleClang-   | AppleClang51-   | Emscripten-   | UnknownCC-   deriving Eq- -- | The 'GhcMode' tells us whether we're doing multi-module -- compilation (controlled via the "GHC" API) or one-shot -- (single-module) compilation.  This makes a difference primarily to@@ -988,6 +964,17 @@     includePathsQuoteImplicit specs ++     includePathsGlobal specs ++-- An argument to --reexported-module which can optionally specify a module renaming.+data ReexportedModule = ReexportedModule { reexportFrom :: ModuleName+                                         , reexportTo   :: ModuleName+                                         }++instance Outputable ReexportedModule where+  ppr (ReexportedModule from to) =+    if from == to then ppr from+                  else ppr from <+> text "as" <+> ppr to+ {- Note [Implicit include paths] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   The compile driver adds the path to the folder containing the source file being@@ -1207,6 +1194,7 @@      ++ validHoleFitDefaults +     where platform = sTargetPlatform settings  -- | These are the default settings for the display and sorting of valid hole@@ -1302,14 +1290,8 @@ --   RegsGraph suffers performance regression. See #7679 --  , ([2],     Opt_StaticArgumentTransformation) --   Static Argument Transformation needs investigation. See #9374-    , ([0,1,2], Opt_SpecEval)-    , ([0,1,2], Opt_SpecEvalDictFun)     ] -type TurnOnFlag = Bool   -- True  <=> we are turning the flag on-                         -- False <=> we are turning the flag off-turnOn  :: TurnOnFlag; turnOn  = True-turnOff :: TurnOnFlag; turnOff = False  default_PIC :: Platform -> [GeneralFlag] default_PIC platform =@@ -1329,6 +1311,7 @@     (OSDarwin,  ArchAArch64) -> [Opt_PIC]     (OSLinux,   ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]     (OSLinux,   ArchARM {})  -> [Opt_PIC, Opt_ExternalDynamicRefs]+    (OSLinux,   ArchRISCV64 {}) -> [Opt_PIC, Opt_ExternalDynamicRefs]     (OSOpenBSD, ArchX86_64)  -> [Opt_PIC] -- Due to PIE support in                                          -- OpenBSD since 5.3 release                                          -- (1 May 2013) we need to@@ -1559,6 +1542,9 @@  -- ----------------------------------------------------------------------------- -- SSE, AVX, FMA++isSse4_1Enabled :: DynFlags -> Bool+isSse4_1Enabled dflags = sseVersion dflags >= Just SSE4  isSse4_2Enabled :: DynFlags -> Bool isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
compiler/GHC/Driver/Env.hs view
@@ -86,8 +86,8 @@ import GHC.Unit.Module.Graph  runHsc :: HscEnv -> Hsc a -> IO a-runHsc hsc_env (Hsc hsc) = do-    (a, w) <- hsc hsc_env emptyMessages+runHsc hsc_env hsc = do+    (a, w) <- runHsc' hsc_env hsc     let dflags = hsc_dflags hsc_env     let !diag_opts = initDiagOpts dflags         !print_config = initPrintConfig dflags@@ -217,7 +217,7 @@ hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env))) -hptCompleteSigs :: HscEnv -> [CompleteMatch]+hptCompleteSigs :: HscEnv -> CompleteMatches hptCompleteSigs = hptAllThings  (md_complete_matches . hm_details)  -- | Find all the instance declarations (of classes and families) from@@ -260,7 +260,7 @@ hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env  hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]-hptAllThings extract hsc_env = concatMap (concatMap extract . eltsHpt . homeUnitEnv_hpt . snd)+hptAllThings extract hsc_env = concatMap (concatHpt extract . homeUnitEnv_hpt . snd)                                 (hugElts (hsc_HUG hsc_env))  -- | Get things from modules "below" this one (in the dependency sense)
compiler/GHC/Driver/Errors/Ppr.hs view
@@ -20,7 +20,10 @@ import GHC.Types.Error.Codes import GHC.Unit.Types import GHC.Utils.Outputable+import GHC.Utils.Panic import GHC.Unit.Module+import GHC.Unit.Module.Graph+import GHC.Unit.Module.ModSummary import GHC.Unit.State import GHC.Types.Hint import GHC.Types.SrcLoc@@ -32,6 +35,7 @@ import GHC.Iface.Errors.Types import GHC.Tc.Errors.Ppr () -- instance Diagnostic TcRnMessage import GHC.Iface.Errors.Ppr () -- instance Diagnostic IfaceMessage+import GHC.CmmToLlvm.Version (llvmVersionStr, supportedLlvmVersionLowerBound, supportedLlvmVersionUpperBound)  -- -- Suggestions@@ -238,7 +242,42 @@       -> mkSimpleDecorated $ text $ "unrecognised warning flag: -" ++ arg     DriverDeprecatedFlag arg msg       -> mkSimpleDecorated $ text $ arg ++ " is deprecated: " ++ msg+    DriverModuleGraphCycle path+      -> mkSimpleDecorated $ vcat+        [ text "Module graph contains a cycle:"+        , nest 2 (show_path path) ]+      where+        show_path :: [ModuleGraphNode] -> SDoc+        show_path []  = panic "show_path"+        show_path [m] = ppr_node m <+> text "imports itself"+        show_path (m1:m2:ms) = vcat ( nest 14 (ppr_node m1)+                                    : nest 6 (text "imports" <+> ppr_node m2)+                                    : go ms )+           where+             go []     = [text "which imports" <+> ppr_node m1]+             go (m:ms) = (text "which imports" <+> ppr_node m) : go ms +        ppr_node :: ModuleGraphNode -> SDoc+        ppr_node (ModuleNode _deps m) = text "module" <+> ppr_ms m+        ppr_node (InstantiationNode _uid u) = text "instantiated unit" <+> ppr u+        ppr_node (LinkNode uid _) = pprPanic "LinkNode should not be in a cycle" (ppr uid)++        ppr_ms :: ModSummary -> SDoc+        ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>+                    (parens (text (msHsFilePath ms)))+    DriverInstantiationNodeInDependencyGeneration node ->+      mkSimpleDecorated $+        vcat [ text "Unexpected backpack instantiation in dependency graph while constructing Makefile:"+             , nest 2 $ ppr node ]+    DriverNoConfiguredLLVMToolchain ->+      mkSimpleDecorated $+        text "GHC was not configured with a supported LLVM toolchain" $$+          text ("Make sure you have installed LLVM between ["+            ++ llvmVersionStr supportedLlvmVersionLowerBound+            ++ " and "+            ++ llvmVersionStr supportedLlvmVersionUpperBound+            ++ ") and reinstall GHC to make -fllvm work")+   diagnosticReason = \case     DriverUnknownMessage m       -> diagnosticReason m@@ -303,6 +342,12 @@       -> WarningWithFlag Opt_WarnUnrecognisedWarningFlags     DriverDeprecatedFlag {}       -> WarningWithFlag Opt_WarnDeprecatedFlags+    DriverModuleGraphCycle {}+      -> ErrorWithoutFlag+    DriverInstantiationNodeInDependencyGeneration {}+      -> ErrorWithoutFlag+    DriverNoConfiguredLLVMToolchain+      -> ErrorWithoutFlag    diagnosticHints = \case     DriverUnknownMessage m@@ -369,6 +414,12 @@     DriverUnrecognisedFlag {}       -> noHints     DriverDeprecatedFlag {}+      -> noHints+    DriverModuleGraphCycle {}+      -> noHints+    DriverInstantiationNodeInDependencyGeneration {}+      -> noHints+    DriverNoConfiguredLLVMToolchain       -> noHints    diagnosticCode = constructorCode
compiler/GHC/Driver/Errors/Types.hs view
@@ -24,10 +24,11 @@ import Data.Bifunctor import Data.Typeable -import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt)+import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt, ReexportedModule) import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage)) import GHC.Types.Error import GHC.Unit.Module+import GHC.Unit.Module.Graph import GHC.Unit.State  import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) )@@ -151,7 +152,7 @@   {-| DriverUnknown is a warning that arises when a user tries to       reexport a module which isn't part of that unit.   -}-  DriverUnknownReexportedModules :: UnitId -> [ModuleName] -> DriverMessage+  DriverUnknownReexportedModules :: UnitId -> [ReexportedModule] -> DriverMessage    {-| DriverUnknownHiddenModules is a warning that arises when a user tries to       hide a module which isn't part of that unit.@@ -383,6 +384,31 @@   DriverUnrecognisedFlag :: String -> DriverMessage    DriverDeprecatedFlag :: String -> String -> DriverMessage++  {-| DriverModuleGraphCycle is an error that occurs if the module graph+       contains cyclic imports.++  Test cases:+    tests/backpack/should_fail/bkpfail51+    tests/driver/T20459+    tests/driver/T24196/T24196+    tests/driver/T24275/T24275++  -}+  DriverModuleGraphCycle :: [ModuleGraphNode] -> DriverMessage++  {- | DriverInstantiationNodeInDependencyGeneration is an error that occurs+       if the module graph used for dependency generation contains+       Backpack 'InstantiationNode's. -}+  DriverInstantiationNodeInDependencyGeneration :: InstantiatedUnit -> DriverMessage++  {-| DriverNoConfiguredLLVMToolchain is an error that occurs if there is no+     LLVM toolchain configured but -fllvm is passed as an option to the compiler.++    Test cases: None.++  -}+  DriverNoConfiguredLLVMToolchain :: DriverMessage  deriving instance Generic DriverMessage
compiler/GHC/Driver/Flags.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ module GHC.Driver.Flags    ( DumpFlag(..)    , getDumpFlagFrom@@ -26,6 +28,22 @@    , minusWeverythingOpts    , minusWcompatOpts    , unusedBindsFlags++   , TurnOnFlag+   , turnOn+   , turnOff+   , impliedXFlags+   , validHoleFitsImpliedGFlags+   , impliedGFlags+   , impliedOffGFlags+   , glasgowExtsFlags++   , ExtensionDeprecation(..)+   , Deprecation(..)+   , extensionDeprecation+   , deprecation+   , extensionNames+   , extensionName    ) where @@ -39,6 +57,8 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (fromMaybe,mapMaybe) +import qualified GHC.LanguageExtensions as LangExt+ data Language = Haskell98 | Haskell2010 | GHC2021 | GHC2024    deriving (Eq, Enum, Show, Bounded) @@ -57,6 +77,334 @@ instance NFData Language where   rnf x = x `seq` () +type TurnOnFlag = Bool   -- True  <=> we are turning the flag on+                         -- False <=> we are turning the flag off+turnOn  :: TurnOnFlag; turnOn  = True+turnOff :: TurnOnFlag; turnOff = False++data Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord)++data ExtensionDeprecation+  = ExtensionNotDeprecated+  | ExtensionDeprecatedFor [LangExt.Extension]+  | ExtensionFlagDeprecatedCond TurnOnFlag String+  | ExtensionFlagDeprecated String+  deriving Eq++-- | Always returns 'Deprecated' even when the flag is+-- only conditionally deprecated.+deprecation :: ExtensionDeprecation -> Deprecation+deprecation ExtensionNotDeprecated = NotDeprecated+deprecation _ = Deprecated++extensionDeprecation :: LangExt.Extension -> ExtensionDeprecation+extensionDeprecation = \case+  LangExt.TypeInType           -> ExtensionDeprecatedFor [LangExt.DataKinds, LangExt.PolyKinds]+  LangExt.NullaryTypeClasses   -> ExtensionDeprecatedFor [LangExt.MultiParamTypeClasses]+  LangExt.RelaxedPolyRec       -> ExtensionFlagDeprecatedCond turnOff+                                    "You can't turn off RelaxedPolyRec any more"+  LangExt.DatatypeContexts     -> ExtensionFlagDeprecatedCond turnOn+                                    "It was widely considered a misfeature, and has been removed from the Haskell language."+  LangExt.AutoDeriveTypeable   -> ExtensionFlagDeprecatedCond turnOn+                                    "Typeable instances are created automatically for all types since GHC 8.2."+  LangExt.OverlappingInstances -> ExtensionFlagDeprecated+                                    "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS"+  _                            -> ExtensionNotDeprecated+++extensionName :: LangExt.Extension -> String+extensionName = \case+  LangExt.Cpp -> "CPP"+  LangExt.OverlappingInstances -> "OverlappingInstances"+  LangExt.UndecidableInstances -> "UndecidableInstances"+  LangExt.IncoherentInstances -> "IncoherentInstances"+  LangExt.UndecidableSuperClasses -> "UndecidableSuperClasses"+  LangExt.MonomorphismRestriction -> "MonomorphismRestriction"+  LangExt.MonoLocalBinds -> "MonoLocalBinds"+  LangExt.DeepSubsumption -> "DeepSubsumption"+  LangExt.RelaxedPolyRec -> "RelaxedPolyRec"           -- Deprecated+  LangExt.ExtendedDefaultRules -> "ExtendedDefaultRules"     -- Use GHC's extended rules for defaulting+  LangExt.NamedDefaults -> "NamedDefaults"+  LangExt.ForeignFunctionInterface -> "ForeignFunctionInterface"+  LangExt.UnliftedFFITypes -> "UnliftedFFITypes"+  LangExt.InterruptibleFFI -> "InterruptibleFFI"+  LangExt.CApiFFI -> "CApiFFI"+  LangExt.GHCForeignImportPrim -> "GHCForeignImportPrim"+  LangExt.JavaScriptFFI -> "JavaScriptFFI"+  LangExt.ParallelArrays -> "ParallelArrays"           -- Syntactic support for parallel arrays+  LangExt.Arrows -> "Arrows"                   -- Arrow-notation syntax+  LangExt.TemplateHaskell -> "TemplateHaskell"+  LangExt.TemplateHaskellQuotes -> "TemplateHaskellQuotes"    -- subset of TH supported by stage1, no splice+  LangExt.QualifiedDo -> "QualifiedDo"+  LangExt.QuasiQuotes -> "QuasiQuotes"+  LangExt.ImplicitParams -> "ImplicitParams"+  LangExt.ImplicitPrelude -> "ImplicitPrelude"+  LangExt.ScopedTypeVariables -> "ScopedTypeVariables"+  LangExt.AllowAmbiguousTypes -> "AllowAmbiguousTypes"+  LangExt.UnboxedTuples -> "UnboxedTuples"+  LangExt.UnboxedSums -> "UnboxedSums"+  LangExt.UnliftedNewtypes -> "UnliftedNewtypes"+  LangExt.UnliftedDatatypes -> "UnliftedDatatypes"+  LangExt.BangPatterns -> "BangPatterns"+  LangExt.TypeFamilies -> "TypeFamilies"+  LangExt.TypeFamilyDependencies -> "TypeFamilyDependencies"+  LangExt.TypeInType -> "TypeInType"               -- Deprecated+  LangExt.OverloadedStrings -> "OverloadedStrings"+  LangExt.OverloadedLists -> "OverloadedLists"+  LangExt.NumDecimals -> "NumDecimals"+  LangExt.OrPatterns -> "OrPatterns"+  LangExt.DisambiguateRecordFields -> "DisambiguateRecordFields"+  LangExt.RecordWildCards -> "RecordWildCards"+  LangExt.NamedFieldPuns -> "NamedFieldPuns"+  LangExt.ViewPatterns -> "ViewPatterns"+  LangExt.GADTs -> "GADTs"+  LangExt.GADTSyntax -> "GADTSyntax"+  LangExt.NPlusKPatterns -> "NPlusKPatterns"+  LangExt.DoAndIfThenElse -> "DoAndIfThenElse"+  LangExt.BlockArguments -> "BlockArguments"+  LangExt.RebindableSyntax -> "RebindableSyntax"+  LangExt.ConstraintKinds -> "ConstraintKinds"+  LangExt.PolyKinds -> "PolyKinds"                -- Kind polymorphism+  LangExt.DataKinds -> "DataKinds"                -- Datatype promotion+  LangExt.TypeData -> "TypeData"                 -- allow @type data@ definitions+  LangExt.InstanceSigs -> "InstanceSigs"+  LangExt.ApplicativeDo -> "ApplicativeDo"+  LangExt.LinearTypes -> "LinearTypes"+  LangExt.RequiredTypeArguments -> "RequiredTypeArguments"    -- Visible forall (VDQ) in types of terms+  LangExt.StandaloneDeriving -> "StandaloneDeriving"+  LangExt.DeriveDataTypeable -> "DeriveDataTypeable"+  LangExt.AutoDeriveTypeable -> "AutoDeriveTypeable"       -- Automatic derivation of Typeable+  LangExt.DeriveFunctor -> "DeriveFunctor"+  LangExt.DeriveTraversable -> "DeriveTraversable"+  LangExt.DeriveFoldable -> "DeriveFoldable"+  LangExt.DeriveGeneric -> "DeriveGeneric"            -- Allow deriving Generic/1+  LangExt.DefaultSignatures -> "DefaultSignatures"        -- Allow extra signatures for defmeths+  LangExt.DeriveAnyClass -> "DeriveAnyClass"           -- Allow deriving any class+  LangExt.DeriveLift -> "DeriveLift"               -- Allow deriving Lift+  LangExt.DerivingStrategies -> "DerivingStrategies"+  LangExt.DerivingVia -> "DerivingVia"              -- Derive through equal representation+  LangExt.TypeSynonymInstances -> "TypeSynonymInstances"+  LangExt.FlexibleContexts -> "FlexibleContexts"+  LangExt.FlexibleInstances -> "FlexibleInstances"+  LangExt.ConstrainedClassMethods -> "ConstrainedClassMethods"+  LangExt.MultiParamTypeClasses -> "MultiParamTypeClasses"+  LangExt.NullaryTypeClasses -> "NullaryTypeClasses"+  LangExt.FunctionalDependencies -> "FunctionalDependencies"+  LangExt.UnicodeSyntax -> "UnicodeSyntax"+  LangExt.ExistentialQuantification -> "ExistentialQuantification"+  LangExt.MagicHash -> "MagicHash"+  LangExt.EmptyDataDecls -> "EmptyDataDecls"+  LangExt.KindSignatures -> "KindSignatures"+  LangExt.RoleAnnotations -> "RoleAnnotations"+  LangExt.ParallelListComp -> "ParallelListComp"+  LangExt.TransformListComp -> "TransformListComp"+  LangExt.MonadComprehensions -> "MonadComprehensions"+  LangExt.GeneralizedNewtypeDeriving -> "GeneralizedNewtypeDeriving"+  LangExt.RecursiveDo -> "RecursiveDo"+  LangExt.PostfixOperators -> "PostfixOperators"+  LangExt.TupleSections -> "TupleSections"+  LangExt.PatternGuards -> "PatternGuards"+  LangExt.LiberalTypeSynonyms -> "LiberalTypeSynonyms"+  LangExt.RankNTypes -> "RankNTypes"+  LangExt.ImpredicativeTypes -> "ImpredicativeTypes"+  LangExt.TypeOperators -> "TypeOperators"+  LangExt.ExplicitNamespaces -> "ExplicitNamespaces"+  LangExt.PackageImports -> "PackageImports"+  LangExt.ExplicitForAll -> "ExplicitForAll"+  LangExt.AlternativeLayoutRule -> "AlternativeLayoutRule"+  LangExt.AlternativeLayoutRuleTransitional -> "AlternativeLayoutRuleTransitional"+  LangExt.DatatypeContexts -> "DatatypeContexts"+  LangExt.NondecreasingIndentation -> "NondecreasingIndentation"+  LangExt.RelaxedLayout -> "RelaxedLayout"+  LangExt.TraditionalRecordSyntax -> "TraditionalRecordSyntax"+  LangExt.LambdaCase -> "LambdaCase"+  LangExt.MultiWayIf -> "MultiWayIf"+  LangExt.BinaryLiterals -> "BinaryLiterals"+  LangExt.NegativeLiterals -> "NegativeLiterals"+  LangExt.HexFloatLiterals -> "HexFloatLiterals"+  LangExt.DuplicateRecordFields -> "DuplicateRecordFields"+  LangExt.OverloadedLabels -> "OverloadedLabels"+  LangExt.EmptyCase -> "EmptyCase"+  LangExt.PatternSynonyms -> "PatternSynonyms"+  LangExt.PartialTypeSignatures -> "PartialTypeSignatures"+  LangExt.NamedWildCards -> "NamedWildCards"+  LangExt.StaticPointers -> "StaticPointers"+  LangExt.TypeApplications -> "TypeApplications"+  LangExt.Strict -> "Strict"+  LangExt.StrictData -> "StrictData"+  LangExt.EmptyDataDeriving -> "EmptyDataDeriving"+  LangExt.NumericUnderscores -> "NumericUnderscores"+  LangExt.QuantifiedConstraints -> "QuantifiedConstraints"+  LangExt.StarIsType -> "StarIsType"+  LangExt.ImportQualifiedPost -> "ImportQualifiedPost"+  LangExt.CUSKs -> "CUSKs"+  LangExt.StandaloneKindSignatures -> "StandaloneKindSignatures"+  LangExt.LexicalNegation -> "LexicalNegation"+  LangExt.FieldSelectors -> "FieldSelectors"+  LangExt.OverloadedRecordDot -> "OverloadedRecordDot"+  LangExt.OverloadedRecordUpdate -> "OverloadedRecordUpdate"+  LangExt.TypeAbstractions -> "TypeAbstractions"+  LangExt.ExtendedLiterals -> "ExtendedLiterals"+  LangExt.ListTuplePuns -> "ListTuplePuns"+  LangExt.MultilineStrings -> "MultilineStrings"++-- | Is this extension known by any other names? For example+-- -XGeneralizedNewtypeDeriving is accepted+extensionAlternateNames :: LangExt.Extension -> [String]+extensionAlternateNames = \case+  LangExt.GeneralizedNewtypeDeriving -> ["GeneralisedNewtypeDeriving"]+  LangExt.RankNTypes                 -> ["Rank2Types", "PolymorphicComponents"]+  _ -> []++extensionDeprecatedNames :: LangExt.Extension -> [String]+extensionDeprecatedNames = \case+  LangExt.RecursiveDo         -> ["DoRec"]+  LangExt.NamedFieldPuns      -> ["RecordPuns"]+  LangExt.ScopedTypeVariables -> ["PatternSignatures"]+  _ -> []++-- | All the names by which an extension is known.+extensionNames :: LangExt.Extension -> [ (ExtensionDeprecation, String) ]+extensionNames ext = mk (extensionDeprecation ext)     (extensionName ext : extensionAlternateNames ext)+                  ++ mk (ExtensionDeprecatedFor [ext]) (extensionDeprecatedNames ext)+  where mk depr = map (\name -> (depr, name))+++impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]+impliedXFlags+-- See Note [Updating flag description in the User's Guide]+  = [ (LangExt.RankNTypes,                turnOn, LangExt.ExplicitForAll)+    , (LangExt.QuantifiedConstraints,     turnOn, LangExt.ExplicitForAll)+    , (LangExt.ScopedTypeVariables,       turnOn, LangExt.ExplicitForAll)+    , (LangExt.LiberalTypeSynonyms,       turnOn, LangExt.ExplicitForAll)+    , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)+    , (LangExt.FlexibleInstances,         turnOn, LangExt.TypeSynonymInstances)+    , (LangExt.FunctionalDependencies,    turnOn, LangExt.MultiParamTypeClasses)+    , (LangExt.MultiParamTypeClasses,     turnOn, LangExt.ConstrainedClassMethods)  -- c.f. #7854+    , (LangExt.TypeFamilyDependencies,    turnOn, LangExt.TypeFamilies)++    , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)      -- NB: turn off!++    , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)++    , (LangExt.GADTs,            turnOn, LangExt.GADTSyntax)+    , (LangExt.GADTs,            turnOn, LangExt.MonoLocalBinds)+    , (LangExt.TypeFamilies,     turnOn, LangExt.MonoLocalBinds)++    , (LangExt.TypeFamilies,     turnOn, LangExt.KindSignatures)  -- Type families use kind signatures+    , (LangExt.PolyKinds,        turnOn, LangExt.KindSignatures)  -- Ditto polymorphic kinds++    -- TypeInType is now just a synonym for a couple of other extensions.+    , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)+    , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)+    , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)++    -- Standalone kind signatures are a replacement for CUSKs.+    , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs)++    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable+    , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)++    -- We turn this on so that we can export associated type+    -- type synonyms in subordinates (e.g. MyClass(type AssocType))+    , (LangExt.TypeFamilies,     turnOn, LangExt.ExplicitNamespaces)+    , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)++    , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)++        -- Record wild-cards implies field disambiguation+        -- Otherwise if you write (C {..}) you may well get+        -- stuff like " 'a' not in scope ", which is a bit silly+        -- if the compiler has just filled in field 'a' of constructor 'C'+    , (LangExt.RecordWildCards,     turnOn, LangExt.DisambiguateRecordFields)++    , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)++    , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)++    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)+    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)++    -- Duplicate record fields require field disambiguation+    , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)++    , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)+    , (LangExt.Strict, turnOn, LangExt.StrictData)++    -- Historically only UnboxedTuples was required for unboxed sums to work.+    -- To avoid breaking code, we make UnboxedTuples imply UnboxedSums.+    , (LangExt.UnboxedTuples, turnOn, LangExt.UnboxedSums)++    -- The extensions needed to declare an H98 unlifted data type+    , (LangExt.UnliftedDatatypes, turnOn, LangExt.DataKinds)+    , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures)++    -- See Note [Non-variable pattern bindings aren't linear] in GHC.Tc.Gen.Bind+    , (LangExt.LinearTypes, turnOn, LangExt.MonoLocalBinds)+  ]+++validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+validHoleFitsImpliedGFlags+  = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)+    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)+    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)+    , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)+    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]++-- General flags that are switched on/off when other general flags are switched+-- on+impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)+                ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)+                ,(Opt_DoLinearCoreLinting, turnOn, Opt_DoCoreLinting)+                ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)+                ,(Opt_WriteIfSimplifiedCore, turnOn, Opt_WriteInterface)+                ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteIfSimplifiedCore)+                ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithStack)+                ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithFallback)+                ] ++ validHoleFitsImpliedGFlags++-- General flags that are switched on/off when other general flags are switched+-- off+impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]++-- Please keep what_glasgow_exts_does.rst up to date with this list+glasgowExtsFlags :: [LangExt.Extension]+glasgowExtsFlags = [+             LangExt.ConstrainedClassMethods+           , LangExt.DeriveDataTypeable+           , LangExt.DeriveFoldable+           , LangExt.DeriveFunctor+           , LangExt.DeriveGeneric+           , LangExt.DeriveTraversable+           , LangExt.EmptyDataDecls+           , LangExt.ExistentialQuantification+           , LangExt.ExplicitNamespaces+           , LangExt.FlexibleContexts+           , LangExt.FlexibleInstances+           , LangExt.ForeignFunctionInterface+           , LangExt.FunctionalDependencies+           , LangExt.GeneralizedNewtypeDeriving+           , LangExt.ImplicitParams+           , LangExt.KindSignatures+           , LangExt.LiberalTypeSynonyms+           , LangExt.MagicHash+           , LangExt.MultiParamTypeClasses+           , LangExt.ParallelListComp+           , LangExt.PatternGuards+           , LangExt.PostfixOperators+           , LangExt.RankNTypes+           , LangExt.RecursiveDo+           , LangExt.ScopedTypeVariables+           , LangExt.StandaloneDeriving+           , LangExt.TypeOperators+           , LangExt.TypeSynonymInstances+           , LangExt.UnboxedTuples+           , LangExt.UnicodeSyntax+           , LangExt.UnliftedFFITypes ]+ -- | Debugging flags data DumpFlag -- See Note [Updating flag description in the User's Guide] in GHC.Driver.Session@@ -299,7 +647,6 @@    | Opt_CmmElimCommonBlocks    | Opt_CmmControlFlow    | Opt_AsmShortcutting-   | Opt_InterModuleFarJumps    | Opt_OmitYields    | Opt_FunToThunk               -- deprecated    | Opt_DictsStrict                     -- be strict in argument dictionaries@@ -317,10 +664,7 @@    | Opt_NumConstantFolding    | Opt_CoreConstantFolding    | Opt_FastPAPCalls                  -- #6084-   | Opt_SpecEval-   | Opt_SpecEvalDictFun   -- See Note [Controlling Speculative Evaluation] -    -- Inference flags    | Opt_DoTagInferenceChecks @@ -332,6 +676,7 @@    | Opt_IgnoreInterfacePragmas    | Opt_OmitInterfacePragmas    | Opt_ExposeAllUnfoldings+   | Opt_ExposeOverloadedUnfoldings    | Opt_KeepAutoRules -- ^Keep auto-generated rules even if they seem to have become useless    | Opt_WriteInterface -- forces .hi files to be written even with -fno-code    | Opt_WriteHie -- generate .hie files@@ -477,6 +822,9 @@    -- Error message suppression    | Opt_ShowErrorContext +   -- Object code determinism+   | Opt_ObjectDeterminism+    -- temporary flags    | Opt_AutoLinkPackages    | Opt_ImplicitImportQualified@@ -545,7 +893,6 @@    , Opt_CmmSink    , Opt_CmmElimCommonBlocks    , Opt_AsmShortcutting-   , Opt_InterModuleFarJumps    , Opt_FunToThunk    , Opt_DmdTxDictSel    , Opt_Loopification@@ -555,8 +902,6 @@    , Opt_WorkerWrapper    , Opt_WorkerWrapperUnlift    , Opt_SolveConstantDicts-   , Opt_SpecEval-   , Opt_SpecEvalDictFun    ]  -- | The set of flags which affect code generation and can change a program's@@ -588,7 +933,9 @@       -- Flags that affect generated code    , Opt_ExposeAllUnfoldings+   , Opt_ExposeOverloadedUnfoldings    , Opt_NoTypeableBinds+   , Opt_ObjectDeterminism    , Opt_Haddock       -- Flags that affect catching of runtime errors@@ -714,6 +1061,7 @@    | Opt_WarnDataKindsTC                             -- Since 9.10    | Opt_WarnDeprecatedTypeAbstractions              -- Since 9.10    | Opt_WarnDefaultedExceptionContext               -- Since 9.10+   | Opt_WarnViewPatternSignatures                   -- Since 9.12    deriving (Eq, Ord, Show, Enum, Bounded)  -- | Return the names of a WarningFlag@@ -830,6 +1178,7 @@   Opt_WarnDataKindsTC                             -> "data-kinds-tc" :| []   Opt_WarnDeprecatedTypeAbstractions              -> "deprecated-type-abstractions" :| []   Opt_WarnDefaultedExceptionContext               -> "defaulted-exception-context" :| []+  Opt_WarnViewPatternSignatures                   -> "view-pattern-signatures" :| []  -- ----------------------------------------------------------------------------- -- Standard sets of warning options@@ -970,7 +1319,8 @@         Opt_WarnTypeEqualityRequiresOperators,         Opt_WarnInconsistentFlags,         Opt_WarnDataKindsTC,-        Opt_WarnTypeEqualityOutOfScope+        Opt_WarnTypeEqualityOutOfScope,+        Opt_WarnViewPatternSignatures       ]  -- | Things you get with -W@@ -1005,7 +1355,8 @@         Opt_WarnRedundantRecordWildcards,         Opt_WarnIncompleteUniPatterns,         Opt_WarnIncompletePatternsRecUpd,-        Opt_WarnIncompleteExportWarnings+        Opt_WarnIncompleteExportWarnings,+        Opt_WarnDerivingTypeable       ]  -- | Things you get with -Weverything, i.e. *all* known warnings flags@@ -1019,8 +1370,7 @@ -- code future compatible to fix issues before they even generate warnings. minusWcompatOpts :: [WarningFlag] minusWcompatOpts-    = [ Opt_WarnCompatUnqualifiedImports-      , Opt_WarnImplicitRhsQuantification+    = [ Opt_WarnImplicitRhsQuantification       , Opt_WarnDeprecatedTypeAbstractions       ]
compiler/GHC/Driver/Hooks.hs view
@@ -48,7 +48,6 @@ import GHC.Types.CostCentre import GHC.Types.IPE import GHC.Types.Meta-import GHC.Types.HpcInfo  import GHC.Unit.Module import GHC.Unit.Module.ModSummary@@ -61,13 +60,13 @@  import GHC.Tc.Types import GHC.Stg.Syntax+import GHC.StgToCmm.CgUtils (CgStream) import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.StgToCmm.Config import GHC.Cmm  import GHCi.RemoteTypes -import GHC.Data.Stream import GHC.Data.Bag  import qualified Data.Kind@@ -149,9 +148,9 @@                                          -> IO (Either Type (HValue, [Linkable], PkgsLoaded))))   , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle))   , stgToCmmHook           :: !(Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs-                                 -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos))-  , cmmToRawCmmHook        :: !(forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a-                                 -> IO (Stream IO RawCmmGroup a)))+                                 -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos))+  , cmmToRawCmmHook        :: !(forall a . Maybe (DynFlags -> Maybe Module -> CgStream CmmGroupSRTs a+                                 -> IO (CgStream RawCmmGroup a)))   }  class HasHooks m where
compiler/GHC/Driver/Plugins.hs view
@@ -244,6 +244,8 @@ data StaticPlugin = StaticPlugin   { spPlugin :: PluginWithArgs   -- ^ the actual plugin together with its commandline arguments+  , spInitialised :: Bool+  -- ^ has this plugin been initialised (i.e. driverPlugin has been run)   }  lpModuleName :: LoadedPlugin -> ModuleName
compiler/GHC/Driver/Session.hs view
@@ -131,6 +131,7 @@         sTargetPlatformString,         sGhcWithInterpreter,         sLibFFI,+        sTargetRTSLinkerOnlySupportsSharedLibs,         GhcNameVersion(..),         FileSettings(..),         PlatformMisc(..),@@ -216,8 +217,6 @@         isFmaEnabled,          -- * Linker/compiler information-        LinkerInfo(..),-        CompilerInfo(..),         useXLinkerRPath,          -- * Include specifications@@ -254,7 +253,10 @@ import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Data.Bool+import GHC.Data.StringBuffer (stringToStringBuffer) import GHC.Types.Error+import GHC.Types.Name.Reader (RdrName(..))+import GHC.Types.Name.Occurrence (isVarOcc, occNameString) import GHC.Utils.Monad import GHC.Types.SrcLoc import GHC.Types.SafeHaskell@@ -263,9 +265,12 @@ import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable+import GHC.Utils.Error (emptyDiagOpts) import GHC.Settings import GHC.CmmToAsm.CFG.Weight import GHC.Core.Opt.CallerCC+import GHC.Parser (parseIdentifier)+import GHC.Parser.Lexer (mkParserOpts, initParserState, P(..), ParseResult(..))  import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) @@ -290,6 +295,7 @@  import qualified GHC.LanguageExtensions as LangExt + -- Note [Updating flag description in the User's Guide] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --@@ -986,7 +992,6 @@  type FlagMaker m = String -> OptKind m -> Flag m type DynFlagMaker = FlagMaker (CmdLineP DynFlags)-data Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord)  -- Make a non-deprecated flag make_ord_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags)@@ -1712,6 +1717,9 @@   , make_ord_flag defFlag "fno-refinement-level-hole-fits"       (noArg (\d -> d { refLevelHoleFits = Nothing })) +  , make_ord_flag defFlag "fwrite-if-compression"+      (intSuffix (\n d -> d { ifCompression = n }))+   , make_dep_flag defGhcFlag "fllvm-pass-vectors-in-regs"             (noArg id)             "vectors registers are now passed in registers by default."@@ -2136,18 +2144,6 @@              -> (Deprecation, FlagSpec flag) depFlagSpec' name flag dep = depFlagSpecOp' name flag nop dep ---- | Define a new deprecated flag where the deprecation message--- is shown depending on the flag value-depFlagSpecCond :: String-                -> flag-                -> (TurnOnFlag -> Bool)-                -> String-                -> (Deprecation, FlagSpec flag)-depFlagSpecCond name flag cond dep =-    (Deprecated, FlagSpec name flag (\f -> when (cond f) $ deprecate dep)-                                                                       AllModes)- -- | Define a new flag for GHCi. flagGhciSpec :: String -> flag -> (Deprecation, FlagSpec flag) flagGhciSpec name flag = flagGhciSpec' name flag nop@@ -2332,7 +2328,8 @@   Opt_WarnPartialFields -> warnSpec x   Opt_WarnPrepositiveQualifiedModule -> warnSpec x   Opt_WarnUnusedPackages -> warnSpec x-  Opt_WarnCompatUnqualifiedImports -> warnSpec x+  Opt_WarnCompatUnqualifiedImports ->+    depWarnSpec x "This warning no longer does anything; see GHC #24904"   Opt_WarnInvalidHaddock -> warnSpec x   Opt_WarnOperatorWhitespaceExtConflict -> warnSpec x   Opt_WarnOperatorWhitespace -> warnSpec x@@ -2352,6 +2349,7 @@   Opt_WarnDataKindsTC -> warnSpec x   Opt_WarnDeprecatedTypeAbstractions -> warnSpec x   Opt_WarnDefaultedExceptionContext -> warnSpec x+  Opt_WarnViewPatternSignatures -> warnSpec x  warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] warningGroupsDeps = map mk warningGroups@@ -2438,6 +2436,7 @@   flagSpec "error-spans"                      Opt_ErrorSpans,   flagSpec "excess-precision"                 Opt_ExcessPrecision,   flagSpec "expose-all-unfoldings"            Opt_ExposeAllUnfoldings,+  flagSpec "expose-overloaded-unfoldings"     Opt_ExposeOverloadedUnfoldings,   flagSpec "keep-auto-rules"                  Opt_KeepAutoRules,   flagSpec "expose-internal-symbols"          Opt_ExposeInternalSymbols,   flagSpec "external-dynamic-refs"            Opt_ExternalDynamicRefs,@@ -2455,7 +2454,6 @@   flagSpec "gen-manifest"                     Opt_GenManifest,   flagSpec "ghci-history"                     Opt_GhciHistory,   flagSpec "ghci-leak-check"                  Opt_GhciLeakCheck,-  flagSpec "inter-module-far-jumps"               Opt_InterModuleFarJumps,   flagSpec "validate-ide-info"                Opt_ValidateHie,   flagGhciSpec "local-ghci-history"           Opt_LocalGhciHistory,   flagGhciSpec "no-it"                        Opt_NoIt,@@ -2536,8 +2534,6 @@   flagSpec "num-constant-folding"             Opt_NumConstantFolding,   flagSpec "core-constant-folding"            Opt_CoreConstantFolding,   flagSpec "fast-pap-calls"                   Opt_FastPAPCalls,-  flagSpec "spec-eval"                        Opt_SpecEval,-  flagSpec "spec-eval-dictfun"                Opt_SpecEvalDictFun,   flagSpec "cmm-control-flow"                 Opt_CmmControlFlow,   flagSpec "show-warning-groups"              Opt_ShowWarnGroups,   flagSpec "hide-source-paths"                Opt_HideSourcePaths,@@ -2547,6 +2543,7 @@   flagSpec "link-rts"                         Opt_LinkRts,   flagSpec "byte-code-and-object-code"        Opt_ByteCodeAndObjectCode,   flagSpec "prefer-byte-code"                 Opt_UseBytecodeRatherThanObjects,+  flagSpec "object-determinism"               Opt_ObjectDeterminism,   flagSpec' "compact-unwind"                  Opt_CompactUnwind       (\turn_on -> updM (\dflags -> do         unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on)@@ -2674,269 +2671,38 @@ xFlags :: [FlagSpec LangExt.Extension] xFlags = map snd xFlagsDeps -xFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]-xFlagsDeps = [--- See Note [Updating flag description in the User's Guide]--- See Note [Supporting CLI completion]--- See Note [Adding a language extension]--- Please keep the list of flags below sorted alphabetically-  flagSpec "AllowAmbiguousTypes"              LangExt.AllowAmbiguousTypes,-  flagSpec "AlternativeLayoutRule"            LangExt.AlternativeLayoutRule,-  flagSpec "AlternativeLayoutRuleTransitional"-                                              LangExt.AlternativeLayoutRuleTransitional,-  flagSpec "Arrows"                           LangExt.Arrows,-  depFlagSpecCond "AutoDeriveTypeable"        LangExt.AutoDeriveTypeable-    id-         ("Typeable instances are created automatically " ++-                     "for all types since GHC 8.2."),-  flagSpec "BangPatterns"                     LangExt.BangPatterns,-  flagSpec "BinaryLiterals"                   LangExt.BinaryLiterals,-  flagSpec "CApiFFI"                          LangExt.CApiFFI,-  flagSpec "CPP"                              LangExt.Cpp,-  flagSpec "CUSKs"                            LangExt.CUSKs,-  flagSpec "ConstrainedClassMethods"          LangExt.ConstrainedClassMethods,-  flagSpec "ConstraintKinds"                  LangExt.ConstraintKinds,-  flagSpec "DataKinds"                        LangExt.DataKinds,-  depFlagSpecCond "DatatypeContexts"          LangExt.DatatypeContexts-    id-         ("It was widely considered a misfeature, " ++-                     "and has been removed from the Haskell language."),-  flagSpec "DefaultSignatures"                LangExt.DefaultSignatures,-  flagSpec "DeriveAnyClass"                   LangExt.DeriveAnyClass,-  flagSpec "DeriveDataTypeable"               LangExt.DeriveDataTypeable,-  flagSpec "DeriveFoldable"                   LangExt.DeriveFoldable,-  flagSpec "DeriveFunctor"                    LangExt.DeriveFunctor,-  flagSpec "DeriveGeneric"                    LangExt.DeriveGeneric,-  flagSpec "DeriveLift"                       LangExt.DeriveLift,-  flagSpec "DeriveTraversable"                LangExt.DeriveTraversable,-  flagSpec "DerivingStrategies"               LangExt.DerivingStrategies,-  flagSpec' "DerivingVia"                     LangExt.DerivingVia-                                              setDeriveVia,-  flagSpec "DisambiguateRecordFields"         LangExt.DisambiguateRecordFields,-  flagSpec "DoAndIfThenElse"                  LangExt.DoAndIfThenElse,-  flagSpec "BlockArguments"                   LangExt.BlockArguments,-  depFlagSpec' "DoRec"                        LangExt.RecursiveDo-    (deprecatedForExtension "RecursiveDo"),-  flagSpec "DuplicateRecordFields"            LangExt.DuplicateRecordFields,-  flagSpec "FieldSelectors"                   LangExt.FieldSelectors,-  flagSpec "EmptyCase"                        LangExt.EmptyCase,-  flagSpec "EmptyDataDecls"                   LangExt.EmptyDataDecls,-  flagSpec "EmptyDataDeriving"                LangExt.EmptyDataDeriving,-  flagSpec "ExistentialQuantification"        LangExt.ExistentialQuantification,-  flagSpec "ExplicitForAll"                   LangExt.ExplicitForAll,-  flagSpec "ExplicitNamespaces"               LangExt.ExplicitNamespaces,-  flagSpec "ExtendedDefaultRules"             LangExt.ExtendedDefaultRules,-  flagSpec "ExtendedLiterals"                 LangExt.ExtendedLiterals,-  flagSpec "FlexibleContexts"                 LangExt.FlexibleContexts,-  flagSpec "FlexibleInstances"                LangExt.FlexibleInstances,-  flagSpec "ForeignFunctionInterface"         LangExt.ForeignFunctionInterface,-  flagSpec "FunctionalDependencies"           LangExt.FunctionalDependencies,-  flagSpec "GADTSyntax"                       LangExt.GADTSyntax,-  flagSpec "GADTs"                            LangExt.GADTs,-  flagSpec "GHCForeignImportPrim"             LangExt.GHCForeignImportPrim,-  flagSpec' "GeneralizedNewtypeDeriving"      LangExt.GeneralizedNewtypeDeriving-                                              setGenDeriving,-  flagSpec' "GeneralisedNewtypeDeriving"      LangExt.GeneralizedNewtypeDeriving-                                              setGenDeriving,-  flagSpec "ImplicitParams"                   LangExt.ImplicitParams,-  flagSpec "ImplicitPrelude"                  LangExt.ImplicitPrelude,-  flagSpec "ImportQualifiedPost"              LangExt.ImportQualifiedPost,-  flagSpec "ImpredicativeTypes"               LangExt.ImpredicativeTypes,-  flagSpec' "IncoherentInstances"             LangExt.IncoherentInstances-                                              setIncoherentInsts,-  flagSpec "TypeFamilyDependencies"           LangExt.TypeFamilyDependencies,-  flagSpec "InstanceSigs"                     LangExt.InstanceSigs,-  flagSpec "ApplicativeDo"                    LangExt.ApplicativeDo,-  flagSpec "InterruptibleFFI"                 LangExt.InterruptibleFFI,-  flagSpec "JavaScriptFFI"                    LangExt.JavaScriptFFI,-  flagSpec "KindSignatures"                   LangExt.KindSignatures,-  flagSpec "LambdaCase"                       LangExt.LambdaCase,-  flagSpec "LexicalNegation"                  LangExt.LexicalNegation,-  flagSpec "LiberalTypeSynonyms"              LangExt.LiberalTypeSynonyms,-  flagSpec "LinearTypes"                      LangExt.LinearTypes,-  flagSpec "ListTuplePuns"                    LangExt.ListTuplePuns,-  flagSpec "MagicHash"                        LangExt.MagicHash,-  flagSpec "MonadComprehensions"              LangExt.MonadComprehensions,-  flagSpec "MonoLocalBinds"                   LangExt.MonoLocalBinds,-  flagSpec "DeepSubsumption"                  LangExt.DeepSubsumption,-  flagSpec "MonomorphismRestriction"          LangExt.MonomorphismRestriction,-  flagSpec "MultiParamTypeClasses"            LangExt.MultiParamTypeClasses,-  flagSpec "MultiWayIf"                       LangExt.MultiWayIf,-  flagSpec "NumericUnderscores"               LangExt.NumericUnderscores,-  flagSpec "NPlusKPatterns"                   LangExt.NPlusKPatterns,-  flagSpec "NamedFieldPuns"                   LangExt.NamedFieldPuns,-  flagSpec "NamedWildCards"                   LangExt.NamedWildCards,-  flagSpec "NegativeLiterals"                 LangExt.NegativeLiterals,-  flagSpec "HexFloatLiterals"                 LangExt.HexFloatLiterals,-  flagSpec "NondecreasingIndentation"         LangExt.NondecreasingIndentation,-  depFlagSpec' "NullaryTypeClasses"           LangExt.NullaryTypeClasses-    (deprecatedForExtension "MultiParamTypeClasses"),-  flagSpec "NumDecimals"                      LangExt.NumDecimals,-  depFlagSpecOp "OverlappingInstances"        LangExt.OverlappingInstances-    setOverlappingInsts-    "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS",-  flagSpec "OverloadedLabels"                 LangExt.OverloadedLabels,-  flagSpec "OverloadedLists"                  LangExt.OverloadedLists,-  flagSpec "OverloadedStrings"                LangExt.OverloadedStrings,-  flagSpec "PackageImports"                   LangExt.PackageImports,-  flagSpec "ParallelArrays"                   LangExt.ParallelArrays,-  flagSpec "ParallelListComp"                 LangExt.ParallelListComp,-  flagSpec "PartialTypeSignatures"            LangExt.PartialTypeSignatures,-  flagSpec "PatternGuards"                    LangExt.PatternGuards,-  depFlagSpec' "PatternSignatures"            LangExt.ScopedTypeVariables-    (deprecatedForExtension "ScopedTypeVariables"),-  flagSpec "PatternSynonyms"                  LangExt.PatternSynonyms,-  flagSpec "PolyKinds"                        LangExt.PolyKinds,-  flagSpec "PolymorphicComponents"            LangExt.RankNTypes,-  flagSpec "QuantifiedConstraints"            LangExt.QuantifiedConstraints,-  flagSpec "PostfixOperators"                 LangExt.PostfixOperators,-  flagSpec "QuasiQuotes"                      LangExt.QuasiQuotes,-  flagSpec "QualifiedDo"                      LangExt.QualifiedDo,-  flagSpec "Rank2Types"                       LangExt.RankNTypes,-  flagSpec "RankNTypes"                       LangExt.RankNTypes,-  flagSpec "RebindableSyntax"                 LangExt.RebindableSyntax,-  flagSpec "OverloadedRecordDot"              LangExt.OverloadedRecordDot,-  flagSpec "OverloadedRecordUpdate"           LangExt.OverloadedRecordUpdate,-  depFlagSpec' "RecordPuns"                   LangExt.NamedFieldPuns-    (deprecatedForExtension "NamedFieldPuns"),-  flagSpec "RecordWildCards"                  LangExt.RecordWildCards,-  flagSpec "RecursiveDo"                      LangExt.RecursiveDo,-  flagSpec "RelaxedLayout"                    LangExt.RelaxedLayout,-  depFlagSpecCond "RelaxedPolyRec"            LangExt.RelaxedPolyRec-    not-         "You can't turn off RelaxedPolyRec any more",-  flagSpec "RequiredTypeArguments"            LangExt.RequiredTypeArguments,-  flagSpec "RoleAnnotations"                  LangExt.RoleAnnotations,-  flagSpec "ScopedTypeVariables"              LangExt.ScopedTypeVariables,-  flagSpec "StandaloneDeriving"               LangExt.StandaloneDeriving,-  flagSpec "StarIsType"                       LangExt.StarIsType,-  flagSpec "StaticPointers"                   LangExt.StaticPointers,-  flagSpec "Strict"                           LangExt.Strict,-  flagSpec "StrictData"                       LangExt.StrictData,-  flagSpec' "TemplateHaskell"                 LangExt.TemplateHaskell-                                              checkTemplateHaskellOk,-  flagSpec "TemplateHaskellQuotes"            LangExt.TemplateHaskellQuotes,-  flagSpec "StandaloneKindSignatures"         LangExt.StandaloneKindSignatures,-  flagSpec "TraditionalRecordSyntax"          LangExt.TraditionalRecordSyntax,-  flagSpec "TransformListComp"                LangExt.TransformListComp,-  flagSpec "TupleSections"                    LangExt.TupleSections,-  flagSpec "TypeAbstractions"                 LangExt.TypeAbstractions,-  flagSpec "TypeApplications"                 LangExt.TypeApplications,-  flagSpec "TypeData"                         LangExt.TypeData,-  depFlagSpec' "TypeInType"                   LangExt.TypeInType-    (deprecatedForExtensions ["DataKinds", "PolyKinds"]),-  flagSpec "TypeFamilies"                     LangExt.TypeFamilies,-  flagSpec "TypeOperators"                    LangExt.TypeOperators,-  flagSpec "TypeSynonymInstances"             LangExt.TypeSynonymInstances,-  flagSpec "UnboxedTuples"                    LangExt.UnboxedTuples,-  flagSpec "UnboxedSums"                      LangExt.UnboxedSums,-  flagSpec "UndecidableInstances"             LangExt.UndecidableInstances,-  flagSpec "UndecidableSuperClasses"          LangExt.UndecidableSuperClasses,-  flagSpec "UnicodeSyntax"                    LangExt.UnicodeSyntax,-  flagSpec "UnliftedDatatypes"                LangExt.UnliftedDatatypes,-  flagSpec "UnliftedFFITypes"                 LangExt.UnliftedFFITypes,-  flagSpec "UnliftedNewtypes"                 LangExt.UnliftedNewtypes,-  flagSpec "ViewPatterns"                     LangExt.ViewPatterns-  ]--validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]-validHoleFitsImpliedGFlags-  = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)-    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)-    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)-    , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)-    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]---- General flags that are switched on/off when other general flags are switched--- on-impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]-impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)-                ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)-                ,(Opt_DoLinearCoreLinting, turnOn, Opt_DoCoreLinting)-                ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)-                ,(Opt_WriteIfSimplifiedCore, turnOn, Opt_WriteInterface)-                ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteIfSimplifiedCore)-                ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithStack)-                ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithFallback)-                ] ++ validHoleFitsImpliedGFlags---- General flags that are switched on/off when other general flags are switched--- off-impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]-impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]--impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]-impliedXFlags--- See Note [Updating flag description in the User's Guide]-  = [ (LangExt.RankNTypes,                turnOn, LangExt.ExplicitForAll)-    , (LangExt.QuantifiedConstraints,     turnOn, LangExt.ExplicitForAll)-    , (LangExt.ScopedTypeVariables,       turnOn, LangExt.ExplicitForAll)-    , (LangExt.LiberalTypeSynonyms,       turnOn, LangExt.ExplicitForAll)-    , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)-    , (LangExt.FlexibleInstances,         turnOn, LangExt.TypeSynonymInstances)-    , (LangExt.FunctionalDependencies,    turnOn, LangExt.MultiParamTypeClasses)-    , (LangExt.MultiParamTypeClasses,     turnOn, LangExt.ConstrainedClassMethods)  -- c.f. #7854-    , (LangExt.TypeFamilyDependencies,    turnOn, LangExt.TypeFamilies)--    , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)      -- NB: turn off!--    , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)--    , (LangExt.GADTs,            turnOn, LangExt.GADTSyntax)-    , (LangExt.GADTs,            turnOn, LangExt.MonoLocalBinds)-    , (LangExt.TypeFamilies,     turnOn, LangExt.MonoLocalBinds)--    , (LangExt.TypeFamilies,     turnOn, LangExt.KindSignatures)  -- Type families use kind signatures-    , (LangExt.PolyKinds,        turnOn, LangExt.KindSignatures)  -- Ditto polymorphic kinds--    -- TypeInType is now just a synonym for a couple of other extensions.-    , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)-    , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)-    , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)--    -- Standalone kind signatures are a replacement for CUSKs.-    , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs)--    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable-    , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)--    -- We turn this on so that we can export associated type-    -- type synonyms in subordinates (e.g. MyClass(type AssocType))-    , (LangExt.TypeFamilies,     turnOn, LangExt.ExplicitNamespaces)-    , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)--    , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)--        -- Record wild-cards implies field disambiguation-        -- Otherwise if you write (C {..}) you may well get-        -- stuff like " 'a' not in scope ", which is a bit silly-        -- if the compiler has just filled in field 'a' of constructor 'C'-    , (LangExt.RecordWildCards,     turnOn, LangExt.DisambiguateRecordFields)--    , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)--    , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)--    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)-    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)--    -- Duplicate record fields require field disambiguation-    , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)--    , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)-    , (LangExt.Strict, turnOn, LangExt.StrictData)+makeExtensionFlags :: LangExt.Extension -> [(Deprecation, FlagSpec LangExt.Extension)]+makeExtensionFlags ext = [ makeExtensionFlag name depr ext | (depr, name) <- extensionNames ext ] -    -- Historically only UnboxedTuples was required for unboxed sums to work.-    -- To avoid breaking code, we make UnboxedTuples imply UnboxedSums.-    , (LangExt.UnboxedTuples, turnOn, LangExt.UnboxedSums)+xFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]+xFlagsDeps = concatMap makeExtensionFlags [minBound .. maxBound] -    -- The extensions needed to declare an H98 unlifted data type-    , (LangExt.UnliftedDatatypes, turnOn, LangExt.DataKinds)-    , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures)+makeExtensionFlag :: String -> ExtensionDeprecation -> LangExt.Extension -> (Deprecation, FlagSpec LangExt.Extension)+makeExtensionFlag name depr ext = (deprecation depr, spec)+  where effect = extensionEffect ext+        spec = FlagSpec name ext (\f -> effect f >> act f) AllModes+        act = case depr of+                ExtensionNotDeprecated -> nop+                ExtensionDeprecatedFor xs+                  -> deprecate . deprecatedForExtensions (map extensionName xs)+                ExtensionFlagDeprecatedCond cond str+                  -> \f -> when (f == cond) (deprecate str)+                ExtensionFlagDeprecated str+                  -> const (deprecate str) -    -- See Note [Non-variable pattern bindings aren't linear] in GHC.Tc.Gen.Bind-    , (LangExt.LinearTypes, turnOn, LangExt.MonoLocalBinds)-  ]+extensionEffect :: LangExt.Extension -> (TurnOnFlag -> DynP ())+extensionEffect = \case+  LangExt.TemplateHaskell+    -> checkTemplateHaskellOk+  LangExt.OverlappingInstances+    -> setOverlappingInsts+  LangExt.GeneralizedNewtypeDeriving+    -> setGenDeriving+  LangExt.IncoherentInstances+    -> setIncoherentInsts+  LangExt.DerivingVia+    -> setDeriveVia+  _ -> nop  -- | Things you get with `-dlint`. enableDLint :: DynP ()@@ -2962,40 +2728,6 @@ disableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls                         mapM_ unSetExtensionFlag glasgowExtsFlags --- Please keep what_glasgow_exts_does.rst up to date with this list-glasgowExtsFlags :: [LangExt.Extension]-glasgowExtsFlags = [-             LangExt.ConstrainedClassMethods-           , LangExt.DeriveDataTypeable-           , LangExt.DeriveFoldable-           , LangExt.DeriveFunctor-           , LangExt.DeriveGeneric-           , LangExt.DeriveTraversable-           , LangExt.EmptyDataDecls-           , LangExt.ExistentialQuantification-           , LangExt.ExplicitNamespaces-           , LangExt.FlexibleContexts-           , LangExt.FlexibleInstances-           , LangExt.ForeignFunctionInterface-           , LangExt.FunctionalDependencies-           , LangExt.GeneralizedNewtypeDeriving-           , LangExt.ImplicitParams-           , LangExt.KindSignatures-           , LangExt.LiberalTypeSynonyms-           , LangExt.MagicHash-           , LangExt.MultiParamTypeClasses-           , LangExt.ParallelListComp-           , LangExt.PatternGuards-           , LangExt.PostfixOperators-           , LangExt.RankNTypes-           , LangExt.RecursiveDo-           , LangExt.ScopedTypeVariables-           , LangExt.StandaloneDeriving-           , LangExt.TypeOperators-           , LangExt.TypeSynonymInstances-           , LangExt.UnboxedTuples-           , LangExt.UnicodeSyntax-           , LangExt.UnliftedFFITypes ]  setWarnSafe :: Bool -> DynP () setWarnSafe True  = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })@@ -3362,9 +3094,26 @@  addReexportedModule :: String -> DynP () addReexportedModule p =-  upd (\s -> s{ reexportedModules  = Set.insert (mkModuleName p) (reexportedModules s) })+  upd (\s -> s{ reexportedModules  = (parseReexportedModule p) : (reexportedModules s) }) +parseReexportedModule :: String                 -- string to parse+                      -> ReexportedModule+parseReexportedModule str+ = case filter ((=="").snd) (readP_to_S parseItem str) of+    [(r, "")] -> r+    _ -> throwGhcException $ CmdLineError ("Can't parse reexported module flag: " ++ str)+  where+        parseItem = do+            orig <- tok $ parseModuleName+            (do _ <- tok $ string "as"+                new <- tok $ parseModuleName+                return (ReexportedModule orig new))+              ++++             return (ReexportedModule orig orig) +        tok m = m >>= \x -> skipSpaces >> return x++ -- If we're linking a binary, then only backends that produce object -- code are allowed (requests for other target types are ignored). setBackend :: Backend -> DynP ()@@ -3395,19 +3144,33 @@     Left err -> addErr err  setMainIs :: String -> DynP ()-setMainIs arg-  | x:_ <- main_fn, isLower x  -- The arg looked like "Foo.Bar.baz"-  = upd $ \d -> d { mainFunIs = Just main_fn,-                    mainModuleNameIs = mkModuleName main_mod }+setMainIs arg = parse parse_main_f arg+  where+    parse callback str = case unP parseIdentifier (p_state str) of+      PFailed _      -> addErr $ "Can't parse -main-is \"" ++ arg ++ "\" as an identifier or module."+      POk _ (L _ re) -> callback re -  | x:_ <- arg, isUpper x  -- The arg looked like "Foo" or "Foo.Bar"-  = upd $ \d -> d { mainModuleNameIs = mkModuleName arg }+    -- dummy parser state.+    p_state str = initParserState+              (mkParserOpts mempty emptyDiagOpts [] False False False True)+              (stringToStringBuffer str)+              (mkRealSrcLoc (mkFastString []) 1 1) -  | otherwise                   -- The arg looked like "baz"-  = upd $ \d -> d { mainFunIs = Just arg }-  where-    (main_mod, main_fn) = splitLongestPrefix arg (== '.')+    parse_main_f (Unqual occ)+      | isVarOcc occ = upd $ \d -> d { mainFunIs = main_f occ }+    parse_main_f (Qual (ModuleName mod) occ)+      | isVarOcc occ = upd $ \d -> d { mainModuleNameIs = mkModuleNameFS mod+                                     , mainFunIs = main_f occ }+    -- append dummy "function" to parse A.B as the module A.B+    -- and not the Data constructor B from the module A+    parse_main_f _ = parse parse_mod (arg ++ ".main") +    main_f = Just . occNameString++    parse_mod (Qual (ModuleName mod) _) = upd $ \d -> d { mainModuleNameIs = mkModuleNameFS mod }+    -- we appended ".m" and any parse error was caught. We are Qual or something went very wrong+    parse_mod _ = error "unreachable"+ addLdInputs :: Option -> DynFlags -> DynFlags addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]} @@ -3578,7 +3341,17 @@       -- objects, but can't without -fPIC.  See       -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/position-independent-code        | gopt Opt_PIC dflags || ways dflags `hasWay` WayDyn ->-          ["-fPIC", "-U__PIC__", "-D__PIC__"]+          ["-fPIC", "-U__PIC__", "-D__PIC__"] +++          -- Clang defaults to -fvisibility=hidden for wasm targets,+          -- but we need these compile-time flags to generate PIC+          -- objects that can be properly linked by wasm-ld using+          -- --export-dynamic; without these flags we would need+          -- -Wl,--export-all at .so link-time which will export+          -- internal symbols as well, and that severely pollutes the+          -- global symbol namespace.+          (if platformArch (targetPlatform dflags) == ArchWasm32+            then [ "-fvisibility=default", "-fvisibility-inlines-hidden" ]+            else [])       -- gcc may be configured to have PIC on by default, let's be       -- explicit here, see #15847        | otherwise -> ["-fno-PIC"]@@ -3664,7 +3437,8 @@        ("GHC Profiled",                showBool hostIsProfiled),        ("Debug on",                    showBool debugIsOn),        ("LibDir",                      topDir dflags),-       -- The path of the global package database used by GHC+       -- This is always an absolute path, unlike "Relative Global Package DB" which is+       -- in the settings file.        ("Global Package DB",           globalPackageDatabasePath dflags)       ]   where@@ -3787,6 +3561,13 @@     = loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)}          "Enabling -prof, because -fobject-code is enabled and GHCi is profiled" + | gopt Opt_ByteCode dflags || gopt Opt_ByteCodeAndObjectCode dflags+ , not (gopt Opt_ExternalInterpreter dflags)+ , hostIsProfiled+ , ways dflags `hasNotWay` WayProf+    = loop (gopt_set dflags Opt_ExternalInterpreter)+         "Enabling external interpreter, because GHC is profiled and bytecode is being used for TH"+  | LinkMergedObj <- ghcLink dflags  , Nothing <- outputFile dflags  = pgmError "--output must be specified when using --merge-objs"@@ -3829,6 +3610,9 @@ -- | Should we use `-XLinker -rpath` when linking or not? -- See Note [-fno-use-rpaths] useXLinkerRPath :: DynFlags -> OS -> Bool+-- wasm shared libs don't have RPATH at all and wasm-ld doesn't accept+-- any RPATH-related flags+useXLinkerRPath dflags _ | ArchWasm32 <- platformArch $ targetPlatform dflags = False useXLinkerRPath _ OSDarwin = False -- See Note [Dynamic linking on macOS] useXLinkerRPath dflags _ = gopt Opt_RPath dflags
compiler/GHC/Hs.hs view
@@ -19,6 +19,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data+{-# LANGUAGE DataKinds #-}  module GHC.Hs (         module Language.Haskell.Syntax,@@ -74,19 +75,8 @@         -- For incomplete modules (e.g. the output of parseHeader), it is EpNoLayout.       hsmodDeprecMessage :: Maybe (LWarningTxt GhcPs),         -- ^ reason\/explanation for warning/deprecation of this module-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'-        --                                   ,'GHC.Parser.Annotation.AnnClose'-        ----        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation       hsmodHaddockModHeader :: Maybe (LHsDoc GhcPs)         -- ^ Haddock module info and description, unparsed-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'-        --                                   ,'GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation    }    deriving Data @@ -95,13 +85,13 @@ type instance XCModule GhcTc = DataConCantHappen type instance XXModule p = DataConCantHappen -type instance Anno ModuleName = SrcSpanAnnA- deriving instance Data (HsModule GhcPs)  data AnnsModule   = AnnsModule {-    am_main :: [AddEpAnn],+    am_sig :: EpToken "signature",+    am_mod :: EpToken "module",+    am_where :: EpToken "where",     am_decls :: [TrailingAnn],                 -- ^ Semis before the start of top decls     am_cs :: [LEpaComment],                    -- ^ Comments before start of top decl,                                                --   used in exact printing only@@ -109,7 +99,7 @@     } deriving (Data, Eq)  instance NoAnn AnnsModule where-  noAnn = AnnsModule [] [] [] Nothing+  noAnn = AnnsModule NoEpTok NoEpTok NoEpTok [] [] Nothing  instance Outputable (HsModule GhcPs) where     ppr (HsModule { hsmodExt = XModulePs { hsmodHaddockModHeader = mbDoc }
+ compiler/GHC/Hs/Basic.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- | Fixity+module GHC.Hs.Basic+   ( module Language.Haskell.Syntax.Basic+   ) where++import GHC.Prelude++import GHC.Utils.Outputable+import GHC.Utils.Binary++import Data.Data ()++import Language.Haskell.Syntax.Basic++instance Outputable LexicalFixity where+  ppr Prefix = text "Prefix"+  ppr Infix  = text "Infix"++instance Outputable FixityDirection where+    ppr InfixL = text "infixl"+    ppr InfixR = text "infixr"+    ppr InfixN = text "infix"++instance Outputable Fixity where+    ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]+++instance Binary Fixity where+    put_ bh (Fixity aa ab) = do+            put_ bh aa+            put_ bh ab+    get bh = do+          aa <- get bh+          ab <- get bh+          return (Fixity aa ab)++------------------------++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
compiler/GHC/Hs/Binds.hs view
@@ -47,9 +47,7 @@ import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var-import GHC.Data.Bag import GHC.Data.BooleanFormula (LBooleanFormula)-import GHC.Types.Name.Reader import GHC.Types.Name  import GHC.Utils.Outputable@@ -73,8 +71,8 @@ -- the ...LR datatypes are parameterized by two id types, -- one for the left and one for the right. -type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = EpAnn AnnList-type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = EpAnn AnnList+type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = EpAnn (AnnList (EpToken "where"))+type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = EpAnn (AnnList (EpToken "where")) type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = DataConCantHappen @@ -134,7 +132,7 @@ type instance XXHsBindsLR GhcRn pR = DataConCantHappen type instance XXHsBindsLR GhcTc pR = AbsBinds -type instance XPSB         (GhcPass idL) GhcPs = [AddEpAnn]+type instance XPSB         (GhcPass idL) GhcPs = AnnPSB type instance XPSB         (GhcPass idL) GhcRn = NameSet -- Post renaming, FVs. See Note [Bind free vars] type instance XPSB         (GhcPass idL) GhcTc = NameSet @@ -154,6 +152,18 @@  type instance XXMultAnn  (GhcPass _) = DataConCantHappen +data AnnPSB+  = AnnPSB {+      ap_pattern :: EpToken "pattern",+      ap_openc   :: Maybe (EpToken "{"),+      ap_closec  :: Maybe (EpToken "}"),+      ap_larrow  :: Maybe (EpUniToken "<-" "←"),+      ap_equal   :: Maybe (EpToken "=")+    } deriving Data++instance NoAnn AnnPSB where+  noAnn = AnnPSB noAnn noAnn noAnn noAnn noAnn+ setTcMultAnn :: Mult -> HsMultAnn GhcRn -> HsMultAnn GhcTc setTcMultAnn mult (HsPct1Ann _)   = HsPct1Ann mult setTcMultAnn mult (HsMultAnn _ p) = HsMultAnn mult p@@ -458,7 +468,7 @@     = getPprDebug $ \case         -- Print with sccs showing         True  -> vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)-        False -> pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)+        False -> pprDeclList (pprLHsBindsForUser (concat (map snd sccs)) sigs)    where      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds      pp_rec Recursive    = text "rec"@@ -468,7 +478,7 @@             => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc pprLHsBinds binds   | isEmptyLHsBinds binds = empty-  | otherwise = pprDeclList (map ppr (bagToList binds))+  | otherwise = pprDeclList (map ppr binds)  pprLHsBindsForUser :: (OutputableBndrId idL,                        OutputableBndrId idR,@@ -486,7 +496,7 @@      decls :: [(SrcSpan, SDoc)]     decls = [(locA loc, ppr sig)  | L loc sig <- sigs] ++-            [(locA loc, ppr bind) | L loc bind <- bagToList binds]+            [(locA loc, ppr bind) | L loc bind <- binds]      sort_by_loc decls = sortBy (SrcLoc.leftmost_smallest `on` fst) decls @@ -514,20 +524,20 @@ isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs  emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)-emptyValBindsIn  = ValBinds NoAnnSortKey emptyBag []+emptyValBindsIn  = ValBinds NoAnnSortKey [] [] emptyValBindsOut = XValBindsLR (NValBinds [] [])  emptyLHsBinds :: LHsBindsLR (GhcPass idL) idR-emptyLHsBinds = emptyBag+emptyLHsBinds = []  isEmptyLHsBinds :: LHsBindsLR (GhcPass idL) idR -> Bool-isEmptyLHsBinds = isEmptyBag+isEmptyLHsBinds = null  ------------ plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)                -> HsValBinds(GhcPass a) plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)-  = ValBinds NoAnnSortKey (ds1 `unionBags` ds2) (sigs1 ++ sigs2)+  = ValBinds NoAnnSortKey (ds1 ++ ds2) (sigs1 ++ sigs2) plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))                (XValBindsLR (NValBinds ds2 sigs2))   = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))@@ -653,7 +663,7 @@          then pp_when_debug          else pp_no_debug -instance Outputable (XRec a RdrName) => Outputable (RecordPatSynField a) where+instance Outputable (XRec pass (IdP pass)) => Outputable (RecordPatSynField pass) where     ppr (RecordPatSynField { recordPatSynField = v }) = ppr v  @@ -680,7 +690,7 @@ isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds  -- EPA annotations in GhcPs, dictionary Id in GhcTc-type instance XCIPBind GhcPs = [AddEpAnn]+type instance XCIPBind GhcPs = EpToken "=" type instance XCIPBind GhcRn = NoExtField type instance XCIPBind GhcTc = Id type instance XXIPBind    (GhcPass p) = DataConCantHappen@@ -708,14 +718,14 @@ type instance XTypeSig          (GhcPass p) = AnnSig type instance XPatSynSig        (GhcPass p) = AnnSig type instance XClassOpSig       (GhcPass p) = AnnSig-type instance XFixSig           (GhcPass p) = [AddEpAnn]-type instance XInlineSig        (GhcPass p) = [AddEpAnn]-type instance XSpecSig          (GhcPass p) = [AddEpAnn]-type instance XSpecInstSig      (GhcPass p) = ([AddEpAnn], SourceText)-type instance XMinimalSig       (GhcPass p) = ([AddEpAnn], SourceText)-type instance XSCCFunSig        (GhcPass p) = ([AddEpAnn], SourceText)-type instance XCompleteMatchSig (GhcPass p) = ([AddEpAnn], SourceText)-    -- SourceText: Note [Pragma source text] in "GHC.Types.SourceText"+type instance XFixSig           (GhcPass p) = ((EpaLocation, Maybe EpaLocation), SourceText)+type instance XInlineSig        (GhcPass p) = (EpaLocation, EpToken "#-}", ActivationAnn)+type instance XSpecSig          (GhcPass p) = AnnSpecSig+type instance XSpecInstSig      (GhcPass p) = ((EpaLocation, EpToken "instance", EpToken "#-}"), SourceText)+type instance XMinimalSig       (GhcPass p) = ((EpaLocation, EpToken "#-}"), SourceText)+type instance XSCCFunSig        (GhcPass p) = ((EpaLocation, EpToken "#-}"), SourceText)+type instance XCompleteMatchSig (GhcPass p) = ((EpaLocation, Maybe TokDcolon, EpToken "#-}"), SourceText)+    -- SourceText: See Note [Pragma source text] in "GHC.Types.SourceText" type instance XXSig             GhcPs = DataConCantHappen type instance XXSig             GhcRn = IdSig type instance XXSig             GhcTc = IdSig@@ -725,6 +735,29 @@ type instance XFixitySig  GhcTc = NoExtField type instance XXFixitySig (GhcPass p) = DataConCantHappen +data AnnSpecSig+  = AnnSpecSig {+      ass_open   :: EpaLocation,+      ass_close  :: EpToken "#-}",+      ass_dcolon :: TokDcolon,+      ass_act    :: ActivationAnn+    } deriving Data++instance NoAnn AnnSpecSig where+  noAnn = AnnSpecSig noAnn noAnn noAnn noAnn++data ActivationAnn+  = ActivationAnn {+      aa_openc  :: EpToken "[",+      aa_closec :: EpToken "]",+      aa_tilde  :: Maybe (EpToken "~"),+      aa_val    :: Maybe EpaLocation+    } deriving (Data, Eq)++instance NoAnn ActivationAnn where+  noAnn = ActivationAnn noAnn noAnn noAnn noAnn++ -- | Optional namespace specifier for fixity signatures, --  WARNINIG and DEPRECATED pragmas. --@@ -775,12 +808,13 @@  data AnnSig   = AnnSig {-      asDcolon :: AddEpAnn, -- Not an EpaAnchor to capture unicode option-      asRest   :: [AddEpAnn]+      asDcolon  :: EpUniToken "::" "∷",+      asPattern :: Maybe (EpToken "pattern"),+      asDefault :: Maybe (EpToken "default")       } deriving Data  instance NoAnn AnnSig where-  noAnn = AnnSig noAnn noAnn+  noAnn = AnnSig noAnn noAnn noAnn  -- | Type checker Specialisation Pragmas --@@ -898,8 +932,13 @@  instance OutputableBndrId p        => Outputable (FixitySig (GhcPass p)) where-  ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]+  ppr (FixitySig ns_spec names fixity) = sep [ppr fixity, ppr_ns_spec, pprops]     where+      ppr_ns_spec =+        case ghcPass @p of+          GhcPs -> ppr ns_spec+          GhcRn -> ppr ns_spec+          GhcTc -> empty       pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)  pragBrackets :: SDoc -> SDoc
compiler/GHC/Hs/Decls.hs view
@@ -31,6 +31,11 @@    -- ** Class or type declarations   TyClDecl(..), LTyClDecl, DataDeclRn(..),+  AnnDataDefn(..),+  AnnClassDecl(..),+  AnnSynDecl(..),+  AnnFamilyDecl(..),+  AnnClsInstDecl(..),   TyClGroup(..),   tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,   tyClGroupKindSigs,@@ -55,14 +60,14 @@   LClsInstDecl, ClsInstDecl(..),    -- ** Standalone deriving declarations-  DerivDecl(..), LDerivDecl,+  DerivDecl(..), LDerivDecl, AnnDerivDecl,   -- ** Deriving strategies   DerivStrategy(..), LDerivStrategy,   derivStrategyName, foldDerivStrategy, mapDerivStrategy,   XViaStrategyPs(..),   -- ** @RULE@ declarations   LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),-  HsRuleAnn(..),+  HsRuleAnn(..), ActivationAnn(..),   RuleBndr(..),LRuleBndr,   collectRuleBndrSigTys,   flattenRuleDecls, pprFullRuleName,@@ -76,7 +81,9 @@   CImportSpec(..),   -- ** Data-constructor declarations   ConDecl(..), LConDecl,-  HsConDeclH98Details, HsConDeclGADTDetails(..), hsConDeclTheta,+  HsConDeclH98Details, HsConDeclGADTDetails(..),+  AnnConDeclH98(..), AnnConDeclGADT(..),+  hsConDeclTheta,   getConNames, getRecConArgs_maybe,   -- ** Document comments   DocDecl(..), LDocDecl, docDeclDoc,@@ -129,7 +136,6 @@ import GHC.Types.ForeignCall import GHC.Unit.Module.Warnings -import GHC.Data.Bag import GHC.Data.Maybe import Data.Data (Data) import Data.Foldable (toList)@@ -172,12 +178,12 @@       [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs]) partitionBindsAndSigs = go   where-    go [] = (emptyBag, [], [], [], [], [])+    go [] = ([], [], [], [], [], [])     go ((L l decl) : ds) =       let (bs, ss, ts, tfis, dfis, docs) = go ds in       case decl of         ValD _ b-          -> (L l b `consBag` bs, ss, ts, tfis, dfis, docs)+          -> (L l b : bs, ss, ts, tfis, dfis, docs)         SigD _ s           -> (bs, L l s : ss, ts, tfis, dfis, docs)         TyClD _ (FamDecl _ t)@@ -338,11 +344,11 @@  type instance XFamDecl      (GhcPass _) = NoExtField -type instance XSynDecl      GhcPs = [AddEpAnn]+type instance XSynDecl      GhcPs = AnnSynDecl type instance XSynDecl      GhcRn = NameSet -- FVs type instance XSynDecl      GhcTc = NameSet -- FVs -type instance XDataDecl     GhcPs = [AddEpAnn]+type instance XDataDecl     GhcPs = NoExtField type instance XDataDecl     GhcRn = DataDeclRn type instance XDataDecl     GhcTc = DataDeclRn @@ -353,7 +359,7 @@   deriving Data  type instance XClassDecl    GhcPs =-  ( [AddEpAnn]+  ( AnnClassDecl   , EpLayout              -- See Note [Class EpLayout]   , AnnSortKey DeclTag )  -- TODO:AZ:tidy up AnnSortKey @@ -362,9 +368,53 @@  type instance XXTyClDecl    (GhcPass _) = DataConCantHappen -type instance XCTyFamInstDecl (GhcPass _) = [AddEpAnn]+type instance XCTyFamInstDecl (GhcPass _) = (EpToken "type", EpToken "instance") type instance XXTyFamInstDecl (GhcPass _) = DataConCantHappen +data AnnDataDefn+  = AnnDataDefn {+      andd_openp    :: [EpToken "("],+      andd_closep   :: [EpToken ")"],+      andd_type     :: EpToken "type",+      andd_newtype  :: EpToken "newtype",+      andd_data     :: EpToken "data",+      andd_instance :: EpToken "instance",+      andd_dcolon   :: TokDcolon,+      andd_where    :: EpToken "where",+      andd_openc    :: EpToken "{",+      andd_closec   :: EpToken "}",+      andd_equal    :: EpToken "="+  } deriving Data++instance NoAnn AnnDataDefn where+  noAnn = AnnDataDefn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn++data AnnClassDecl+  = AnnClassDecl {+      acd_class  :: EpToken "class",+      acd_openp  :: [EpToken "("],+      acd_closep :: [EpToken ")"],+      acd_vbar   :: EpToken "|",+      acd_where  :: EpToken "where",+      acd_openc  :: EpToken "{",+      acd_closec :: EpToken "}",+      acd_semis  :: [EpToken ";"]+  } deriving Data++instance NoAnn AnnClassDecl where+  noAnn = AnnClassDecl noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn++data AnnSynDecl+  = AnnSynDecl {+    asd_opens  :: [EpToken "("],+    asd_closes :: [EpToken ")"],+    asd_type   :: EpToken "type",+    asd_equal  :: EpToken "="+  } deriving Data++instance NoAnn AnnSynDecl where+  noAnn = AnnSynDecl noAnn noAnn noAnn noAnn+ ------------- Pretty printing FamilyDecls -----------  pprFlavour :: FamilyInfo pass -> SDoc@@ -452,7 +502,7 @@                     tcdFDs  = fds,                     tcdSigs = sigs, tcdMeths = methods,                     tcdATs = ats, tcdATDefs = at_defs})-      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part+      | null sigs && null methods && null ats && null at_defs -- No "where" part       = top_matter        | otherwise       -- Laid out@@ -512,7 +562,7 @@ instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where   ppr = pprFunDep -type instance XCFunDep    (GhcPass _) = [AddEpAnn]+type instance XCFunDep    (GhcPass _) = TokRarrow type instance XXFunDep    (GhcPass _) = DataConCantHappen  pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc@@ -546,10 +596,28 @@ type instance XTyVarSig         (GhcPass _) = NoExtField type instance XXFamilyResultSig (GhcPass _) = DataConCantHappen -type instance XCFamilyDecl    (GhcPass _) = [AddEpAnn]+type instance XCFamilyDecl    (GhcPass _) = AnnFamilyDecl type instance XXFamilyDecl    (GhcPass _) = DataConCantHappen +data AnnFamilyDecl+  = AnnFamilyDecl {+      afd_openp  :: [EpToken "("],+      afd_closep :: [EpToken ")"],+      afd_type   :: EpToken "type",+      afd_data   :: EpToken "data",+      afd_family :: EpToken "family",+      afd_dcolon :: TokDcolon,+      afd_equal  :: EpToken "=",+      afd_vbar   :: EpToken "|",+      afd_where  :: EpToken "where",+      afd_openc  :: EpToken "{",+      afd_dotdot :: EpToken "..",+      afd_closec :: EpToken "}"+  } deriving Data +instance NoAnn AnnFamilyDecl where+  noAnn = AnnFamilyDecl noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn+ ------------- Functions over FamilyDecls -----------  familyDeclLName :: FamilyDecl (GhcPass p) -> XRec (GhcPass p) (IdP (GhcPass p))@@ -562,18 +630,18 @@ famResultKindSignature (NoSig _) = Nothing famResultKindSignature (KindSig _ ki) = Just ki famResultKindSignature (TyVarSig _ bndr) =-  case unLoc bndr of-    UserTyVar _ _ _ -> Nothing-    KindedTyVar _ _ _ ki -> Just ki+  case hsBndrKind (unLoc bndr) of+    HsBndrNoKind _  -> Nothing+    HsBndrKind _ ki -> Just ki  -- | Maybe return name of the result type variable resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))-resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig+resultVariableName (TyVarSig _ sig) = hsLTyVarName sig resultVariableName _                = Nothing  ------------- Pretty printing FamilyDecls ----------- -type instance XCInjectivityAnn  (GhcPass _) = [AddEpAnn]+type instance XCInjectivityAnn  (GhcPass _) = TokRarrow type instance XXInjectivityAnn  (GhcPass _) = DataConCantHappen  instance OutputableBndrId p@@ -617,10 +685,10 @@ *                                                                      * ********************************************************************* -} -type instance XCHsDataDefn    (GhcPass _) = NoExtField+type instance XCHsDataDefn    (GhcPass _) = AnnDataDefn type instance XXHsDataDefn    (GhcPass _) = DataConCantHappen -type instance XCHsDerivingClause    (GhcPass _) = [AddEpAnn]+type instance XCHsDerivingClause    (GhcPass _) = EpToken "deriving" type instance XXHsDerivingClause    (GhcPass _) = DataConCantHappen  instance OutputableBndrId p@@ -656,7 +724,7 @@   ppr (DctSingle _ ty) = ppr ty   ppr (DctMulti _ tys) = parens (interpp'SP tys) -type instance XStandaloneKindSig GhcPs = [AddEpAnn]+type instance XStandaloneKindSig GhcPs = (EpToken "type", TokDcolon) type instance XStandaloneKindSig GhcRn = NoExtField type instance XStandaloneKindSig GhcTc = NoExtField @@ -665,11 +733,11 @@ standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p) standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname -type instance XConDeclGADT GhcPs = (EpUniToken "::" "∷", [AddEpAnn])+type instance XConDeclGADT GhcPs = AnnConDeclGADT type instance XConDeclGADT GhcRn = NoExtField type instance XConDeclGADT GhcTc = NoExtField -type instance XConDeclH98  GhcPs = [AddEpAnn]+type instance XConDeclH98  GhcPs = AnnConDeclH98 type instance XConDeclH98  GhcRn = NoExtField type instance XConDeclH98  GhcTc = NoExtField @@ -677,12 +745,32 @@  type instance XPrefixConGADT       (GhcPass _) = NoExtField -type instance XRecConGADT          GhcPs = EpUniToken "->" "→"+type instance XRecConGADT          GhcPs = TokRarrow type instance XRecConGADT          GhcRn = NoExtField type instance XRecConGADT          GhcTc = NoExtField  type instance XXConDeclGADTDetails (GhcPass _) = DataConCantHappen +data AnnConDeclH98+  = AnnConDeclH98 {+    acdh_forall  :: TokForall,+    acdh_dot :: EpToken ".",+    acdh_darrow :: TokDarrow+  } deriving Data++instance NoAnn AnnConDeclH98 where+  noAnn = AnnConDeclH98 noAnn noAnn noAnn++data AnnConDeclGADT+  = AnnConDeclGADT {+    acdg_openp  :: [EpToken "("],+    acdg_closep :: [EpToken ")"],+    acdg_dcolon :: TokDcolon+  } deriving Data++instance NoAnn AnnConDeclGADT where+  noAnn = AnnConDeclGADT noAnn noAnn noAnn+ -- Codomain could be 'NonEmpty', but at the moment all users need a list. getConNames :: ConDecl GhcRn -> [LocatedN Name] getConNames ConDeclH98  {con_name  = name}  = [name]@@ -807,18 +895,16 @@ ************************************************************************ -} -type instance XCFamEqn    (GhcPass _) r = [AddEpAnn]+type instance XCFamEqn    (GhcPass _) r = ([EpToken "("], [EpToken ")"], EpToken "=") type instance XXFamEqn    (GhcPass _) r = DataConCantHappen -type instance Anno (FamEqn (GhcPass p) _) = SrcSpanAnnA- ----------------- Class instances -------------  type instance XCClsInstDecl    GhcPs = ( Maybe (LWarningTxt GhcPs)                                              -- The warning of the deprecated instance                                              -- See Note [Implementation of deprecated instances]                                              -- in GHC.Tc.Solver.Dict-                                       , [AddEpAnn]+                                       , AnnClsInstDecl                                        , AnnSortKey DeclTag) -- For sorting the additional annotations                                         -- TODO:AZ:tidy up type instance XCClsInstDecl    GhcRn = Maybe (LWarningTxt GhcRn)@@ -841,6 +927,18 @@  type instance XXInstDecl    (GhcPass _) = DataConCantHappen +data AnnClsInstDecl+  = AnnClsInstDecl {+    acid_instance :: EpToken "instance",+    acid_where    :: EpToken "where",+    acid_openc    :: EpToken "{",+    acid_semis    :: [EpToken ";"],+    acid_closec   :: EpToken "}"+  } deriving Data++instance NoAnn AnnClsInstDecl where+  noAnn = AnnClsInstDecl noAnn noAnn noAnn noAnn noAnn+ cidDeprecation :: forall p. IsPass p                => ClsInstDecl (GhcPass p)                -> Maybe (WarningTxt (GhcPass p))@@ -921,7 +1019,7 @@                          , cid_sigs = sigs, cid_tyfam_insts = ats                          , cid_overlap_mode = mbOverlap                          , cid_datafam_insts = adts })-      | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part+      | null sigs, null ats, null adts, null binds  -- No "where" part       = top_matter        | otherwise       -- Laid out@@ -1003,15 +1101,17 @@                                            -- The warning of the deprecated derivation                                            -- See Note [Implementation of deprecated instances]                                            -- in GHC.Tc.Solver.Dict-                                     , [AddEpAnn] )+                                     , AnnDerivDecl ) type instance XCDerivDecl    GhcRn = ( Maybe (LWarningTxt GhcRn)                                            -- The warning of the deprecated derivation                                            -- See Note [Implementation of deprecated instances]                                            -- in GHC.Tc.Solver.Dict-                                     , [AddEpAnn] )-type instance XCDerivDecl    GhcTc = [AddEpAnn]+                                     , AnnDerivDecl )+type instance XCDerivDecl    GhcTc = AnnDerivDecl type instance XXDerivDecl    (GhcPass _) = DataConCantHappen +type AnnDerivDecl = (EpToken "deriving", EpToken "instance")+ derivDeprecation :: forall p. IsPass p                => DerivDecl (GhcPass p)                -> Maybe (WarningTxt (GhcPass p))@@ -1025,8 +1125,6 @@       = depr     decl_deprecation _ _ = Nothing -type instance Anno OverlapMode = SrcSpanAnnP- instance OutputableBndrId p        => Outputable (DerivDecl (GhcPass p)) where     ppr (deriv@DerivDecl { deriv_type = ty@@ -1047,15 +1145,15 @@ ************************************************************************ -} -type instance XStockStrategy    GhcPs = [AddEpAnn]+type instance XStockStrategy    GhcPs = EpToken "stock" type instance XStockStrategy    GhcRn = NoExtField type instance XStockStrategy    GhcTc = NoExtField -type instance XAnyClassStrategy GhcPs = [AddEpAnn]+type instance XAnyClassStrategy GhcPs = EpToken "anyclass" type instance XAnyClassStrategy GhcRn = NoExtField type instance XAnyClassStrategy GhcTc = NoExtField -type instance XNewtypeStrategy  GhcPs = [AddEpAnn]+type instance XNewtypeStrategy  GhcPs = EpToken "newtype" type instance XNewtypeStrategy  GhcRn = NoExtField type instance XNewtypeStrategy  GhcTc = NoExtField @@ -1063,7 +1161,7 @@ type instance XViaStrategy GhcRn = LHsSigType GhcRn type instance XViaStrategy GhcTc = Type -data XViaStrategyPs = XViaStrategyPs [AddEpAnn] (LHsSigType GhcPs)+data XViaStrategyPs = XViaStrategyPs (EpToken "via") (LHsSigType GhcPs)  instance OutputableBndrId p         => Outputable (DerivStrategy (GhcPass p)) where@@ -1102,7 +1200,7 @@ ************************************************************************ -} -type instance XCDefaultDecl    GhcPs = [AddEpAnn]+type instance XCDefaultDecl    GhcPs = (EpToken "default", EpToken "(", EpToken ")") type instance XCDefaultDecl    GhcRn = NoExtField type instance XCDefaultDecl    GhcTc = NoExtField @@ -1110,8 +1208,8 @@  instance OutputableBndrId p        => Outputable (DefaultDecl (GhcPass p)) where-    ppr (DefaultDecl _ tys)-      = text "default" <+> parens (interpp'SP tys)+    ppr (DefaultDecl _ cl tys)+      = text "default" <+> maybe id ((<+>) . ppr) cl (parens (interpp'SP tys))  {- ************************************************************************@@ -1121,11 +1219,11 @@ ************************************************************************ -} -type instance XForeignImport   GhcPs = [AddEpAnn]+type instance XForeignImport   GhcPs = (EpToken "foreign", EpToken "import", TokDcolon) type instance XForeignImport   GhcRn = NoExtField type instance XForeignImport   GhcTc = Coercion -type instance XForeignExport   GhcPs = [AddEpAnn]+type instance XForeignExport   GhcPs = (EpToken "foreign", EpToken "export", TokDcolon) type instance XForeignExport   GhcRn = NoExtField type instance XForeignExport   GhcTc = Coercion @@ -1137,6 +1235,7 @@ type instance XCExport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignExport  (GhcPass _) = DataConCantHappen + -- pretty printing of foreign declarations  instance OutputableBndrId p@@ -1190,7 +1289,7 @@ ************************************************************************ -} -type instance XCRuleDecls    GhcPs = ([AddEpAnn], SourceText)+type instance XCRuleDecls    GhcPs = ((EpaLocation, EpToken "#-}"), SourceText) type instance XCRuleDecls    GhcRn = SourceText type instance XCRuleDecls    GhcTc = SourceText @@ -1207,23 +1306,20 @@  data HsRuleAnn   = HsRuleAnn-       { ra_tyanns :: Maybe (AddEpAnn, AddEpAnn)-                 -- ^ The locations of 'forall' and '.' for forall'd type vars-                 -- Using AddEpAnn to capture possible unicode variants-       , ra_tmanns :: Maybe (AddEpAnn, AddEpAnn)-                 -- ^ The locations of 'forall' and '.' for forall'd term vars-                 -- Using AddEpAnn to capture possible unicode variants-       , ra_rest :: [AddEpAnn]+       { ra_tyanns :: Maybe (TokForall, EpToken ".")+       , ra_tmanns :: Maybe (TokForall, EpToken ".")+       , ra_equal  :: EpToken "="+       , ra_rest :: ActivationAnn        } deriving (Data, Eq)  instance NoAnn HsRuleAnn where-  noAnn = HsRuleAnn Nothing Nothing []+  noAnn = HsRuleAnn Nothing Nothing noAnn noAnn  flattenRuleDecls :: [LRuleDecls (GhcPass p)] -> [LRuleDecl (GhcPass p)] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls -type instance XCRuleBndr    (GhcPass _) = [AddEpAnn]-type instance XRuleBndrSig  (GhcPass _) = [AddEpAnn]+type instance XCRuleBndr    (GhcPass _) = AnnTyVarBndr+type instance XRuleBndrSig  (GhcPass _) = AnnTyVarBndr type instance XXRuleBndr    (GhcPass _) = DataConCantHappen  instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where@@ -1274,13 +1370,13 @@ ************************************************************************ -} -type instance XWarnings      GhcPs = ([AddEpAnn], SourceText)+type instance XWarnings      GhcPs = ((EpaLocation, EpToken "#-}"), SourceText) type instance XWarnings      GhcRn = SourceText type instance XWarnings      GhcTc = SourceText  type instance XXWarnDecls    (GhcPass _) = DataConCantHappen -type instance XWarning      (GhcPass _) = (NamespaceSpecifier, [AddEpAnn])+type instance XWarning      (GhcPass _) = (NamespaceSpecifier, (EpToken "[", EpToken "]")) type instance XXWarnDecl    (GhcPass _) = DataConCantHappen  @@ -1336,13 +1432,11 @@ ************************************************************************ -} -type instance XCRoleAnnotDecl GhcPs = [AddEpAnn]+type instance XCRoleAnnotDecl GhcPs = (EpToken "type", EpToken "role") type instance XCRoleAnnotDecl GhcRn = NoExtField type instance XCRoleAnnotDecl GhcTc = NoExtField  type instance XXRoleAnnotDecl (GhcPass _) = DataConCantHappen--type instance Anno (Maybe Role) = EpAnnCO  instance OutputableBndr (IdP (GhcPass p))        => Outputable (RoleAnnotDecl (GhcPass p)) where
compiler/GHC/Hs/Doc.hs view
@@ -124,7 +124,7 @@   = DsiSectionHeading !Int !(HsDoc GhcRn)   | DsiDocChunk !(HsDoc GhcRn)   | DsiNamedChunkRef !String-  | DsiExports !Avails+  | DsiExports !DetOrdAvails   | DsiModExport       !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple                             -- modules with a single export declaration. E.g.@@ -133,7 +133,12 @@                             -- > module M (module X) where                             -- > import R0 as X                             -- > import R1 as X-      !Avails+                            --+                            -- Invariant: This list of ModuleNames must be+                            -- sorted to guarantee interface file determinism.+      !DetOrdAvails+                            -- ^ Invariant: This list of Avails must be sorted+                            -- to guarantee interface file determinism.  instance Binary DocStructureItem where   put_ bh = \case
compiler/GHC/Hs/Dump.hs view
@@ -4,6 +4,7 @@ -} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}  -- | Contains a debug function to dump parts of the GHC.Hs AST. It uses a syb -- traversal which falls back to displaying based on the constructor name, so@@ -34,6 +35,7 @@  import Data.Data hiding (Fixity) import qualified Data.ByteString as B+import GHC.TypeLits  -- | Should source spans be removed from output. data BlankSrcSpan = BlankSrcSpan | BlankSrcSpanFile | NoBlankSrcSpan@@ -57,30 +59,39 @@     showAstData' =       generic               `ext1Q` list-              `extQ` list_addEpAnn+              `extQ` list_epaLocation+              `extQ` list_epTokenOpenP+              `extQ` list_epTokenCloseP               `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan-              `extQ` annotation               `extQ` annotationModule-              `extQ` annotationAddEpAnn               `extQ` annotationGrhsAnn-              `extQ` annotationEpAnnHsCase               `extQ` annotationAnnList+              `extQ` annotationAnnListWhere+              `extQ` annotationAnnListCommas+              `extQ` annotationAnnListIE               `extQ` annotationEpAnnImportDecl-              `extQ` annotationAnnParen-              `extQ` annotationTrailingAnn-              `extQ` annotationEpaLocation               `extQ` annotationNoEpAnns-              `extQ` addEpAnn+              `extQ` annotationExprBracket+              `extQ` annotationTypedBracket+              `extQ` epTokenOC+              `extQ` epTokenCC+              `extQ` epTokenInstance+              `extQ` epTokenForall               `extQ` annParen+              `extQ` annClassDecl+              `extQ` annSynDecl+              `extQ` annDataDefn+              `extQ` annFamilyDecl+              `extQ` annClsInstDecl               `extQ` lit `extQ` litr `extQ` litt               `extQ` sourceText               `extQ` deltaPos-              `extQ` epaAnchor+              `extQ` epaLocation+              `extQ` maybe_epaLocation               `extQ` bytestring               `extQ` name `extQ` occName `extQ` moduleName `extQ` var               `extQ` dataCon               `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet-              `extQ` fixity               `ext2Q` located               `extQ` srcSpanAnnA               `extQ` srcSpanAnnL@@ -103,12 +114,24 @@             bytestring :: B.ByteString -> SDoc             bytestring = text . normalize_newlines . show -            list_addEpAnn :: [AddEpAnn] -> SDoc-            list_addEpAnn ls = case ba of+            list_epaLocation :: [EpaLocation] -> SDoc+            list_epaLocation ls = case ba of               BlankEpAnnotations -> parens-                                       $ text "blanked:" <+> text "[AddEpAnn]"+                                       $ text "blanked:" <+> text "[EpaLocation]"               NoBlankEpAnnotations -> list ls +            list_epTokenOpenP :: [EpToken "("] -> SDoc+            list_epTokenOpenP ls = case ba of+              BlankEpAnnotations -> parens+                                       $ text "blanked:" <+> text "[EpToken \"(\"]"+              NoBlankEpAnnotations -> list ls++            list_epTokenCloseP :: [EpToken ")"] -> SDoc+            list_epTokenCloseP ls = case ba of+              BlankEpAnnotations -> parens+                                       $ text "blanked:" <+> text "[EpToken \"(\"]"+              NoBlankEpAnnotations -> list ls+             list []    = brackets empty             list [x]   = brackets (showAstData' x)             list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)@@ -145,18 +168,26 @@                                                , generic s ]              sourceText :: SourceText -> SDoc-            sourceText NoSourceText = parens $ text "NoSourceText"+            sourceText NoSourceText = case bs of+              BlankSrcSpan -> parens $ text "SourceText" <+> text "blanked"+              _            -> parens $ text "NoSourceText"             sourceText (SourceText src) = case bs of-              NoBlankSrcSpan   -> parens $ text "SourceText" <+> ftext src-              BlankSrcSpanFile -> parens $ text "SourceText" <+> ftext src-              _                -> parens $ text "SourceText" <+> text "blanked"+              BlankSrcSpan     -> parens $ text "SourceText" <+> text "blanked"+              _                -> parens $ text "SourceText" <+> ftext src -            epaAnchor :: EpaLocation -> SDoc-            epaAnchor (EpaSpan s) = parens $ text "EpaSpan" <+> srcSpan s-            epaAnchor (EpaDelta d cs) = case ba of-              NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> showAstData' cs-              BlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> text "blanked"+            epaLocation :: EpaLocation -> SDoc+            epaLocation (EpaSpan s) = parens $ text "EpaSpan" <+> srcSpan s+            epaLocation (EpaDelta s d cs) = case ba of+              NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> srcSpan s <+> deltaPos d <+> showAstData' cs+              BlankEpAnnotations -> parens $ text "EpaDelta" <+> srcSpan s <+> deltaPos d <+> text "blanked" +            maybe_epaLocation :: Maybe EpaLocation -> SDoc+            maybe_epaLocation ml = case ba of+              NoBlankEpAnnotations -> case ml of+                Nothing -> parens $ text "Nothing"+                Just l -> parens (text "Just" $$ showAstData' l)+              BlankEpAnnotations -> parens $ text "Maybe EpaLocation:" <+> text "blanked"+             deltaPos :: DeltaPos -> SDoc             deltaPos (SameLine c) = parens $ text "SameLine" <+> ppr c             deltaPos (DifferentLine l c) = parens $ text "DifferentLine" <+> ppr l <+> ppr c@@ -184,19 +215,113 @@              BlankSrcSpanFile -> braces $ char ' ' <> (pprUserRealSpan False ss) <> char ' '              annParen :: AnnParen -> SDoc-            annParen (AnnParen a o c) = case ba of+            annParen ap = case ba of              BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnParen"+             NoBlankEpAnnotations -> parens (case ap of+                                      (AnnParens       o c) -> text "AnnParens"       $$ vcat [showAstData' o, showAstData' c]+                                      (AnnParensHash   o c) -> text "AnnParensHash"   $$ vcat [showAstData' o, showAstData' c]+                                      (AnnParensSquare o c) -> text "AnnParensSquare" $$ vcat [showAstData' o, showAstData' c]+                                      )++            annClassDecl :: AnnClassDecl -> SDoc+            annClassDecl (AnnClassDecl c ops cps v w oc cc s) = case ba of+             BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnClassDecl"              NoBlankEpAnnotations ->-              parens $ text "AnnParen"-                        $$ vcat [ppr a, epaAnchor o, epaAnchor c]+              parens $ text "AnnClassDecl"+                        $$ vcat [showAstData' c, showAstData' ops, showAstData' cps,+                                 showAstData' v, showAstData' w, showAstData' oc,+                                 showAstData' cc, showAstData' s] -            addEpAnn :: AddEpAnn -> SDoc-            addEpAnn (AddEpAnn a s) = case ba of+            annSynDecl :: AnnSynDecl -> SDoc+            annSynDecl (AnnSynDecl ops cps t e) = case ba of+             BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnSynDecl"+             NoBlankEpAnnotations ->+              parens $ text "AnnSynDecl"+                        $$ vcat [showAstData' ops, showAstData' cps,+                                 showAstData' t, showAstData' e]++            annDataDefn :: AnnDataDefn -> SDoc+            annDataDefn (AnnDataDefn a b c d e f g h i j k) = case ba of+             BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnDataDefn"+             NoBlankEpAnnotations ->+              parens $ text "AnnDataDefn"+                        $$ vcat [showAstData' a, showAstData' b, showAstData' c,+                                 showAstData' d, showAstData' e, showAstData' f,+                                 showAstData' g, showAstData' h, showAstData' i,+                                 showAstData' j, showAstData' k]++            annFamilyDecl :: AnnFamilyDecl -> SDoc+            annFamilyDecl (AnnFamilyDecl a b c d e f g h i j k l) = case ba of+             BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnFamilyDecl"+             NoBlankEpAnnotations ->+              parens $ text "AnnFamilyDecl"+                        $$ vcat [showAstData' a, showAstData' b, showAstData' c,+                                 showAstData' d, showAstData' e, showAstData' f,+                                 showAstData' g, showAstData' h, showAstData' i,+                                 showAstData' j, showAstData' k, showAstData' l]++            annClsInstDecl :: AnnClsInstDecl -> SDoc+            annClsInstDecl (AnnClsInstDecl a b c d e) = case ba of+             BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnFamilyDecl"+             NoBlankEpAnnotations ->+              parens $ text "AnnClsInstDecl"+                        $$ vcat [showAstData' a, showAstData' b, showAstData' c,+                                 showAstData' d, showAstData' e]+++            annotationExprBracket :: BracketAnn (EpUniToken "[|" "⟦") (EpToken "[e|") -> SDoc+            annotationExprBracket = annotationBracket++            annotationTypedBracket :: BracketAnn (EpToken "[||") (EpToken "[e||") -> SDoc+            annotationTypedBracket = annotationBracket++            annotationBracket ::forall n h .(Data n, Data h, Typeable n, Typeable h)+              => BracketAnn n h -> SDoc+            annotationBracket a = case ba of              BlankEpAnnotations -> parens-                                      $ text "blanked:" <+> text "AddEpAnn"+                                      $ text "blanked:" <+> text "BracketAnn"              NoBlankEpAnnotations ->-              parens $ text "AddEpAnn" <+> ppr a <+> epaAnchor s+              parens $ case a of+                BracketNoE  t -> text "BracketNoE"  <+> showAstData' t+                BracketHasE t -> text "BracketHasE" <+> showAstData' t +            epTokenOC :: EpToken "{" -> SDoc+            epTokenOC  = epToken'++            epTokenCC :: EpToken "}" -> SDoc+            epTokenCC = epToken'++            epTokenInstance :: EpToken "instance" -> SDoc+            epTokenInstance = epToken'++            epTokenForall :: TokForall -> SDoc+            epTokenForall = epUniToken'++            epToken' :: KnownSymbol sym => EpToken sym -> SDoc+            epToken' (EpTok s) = case ba of+             BlankEpAnnotations -> parens+                                      $ text "blanked:" <+> text "EpToken"+             NoBlankEpAnnotations ->+              parens $ text "EpTok" <+> epaLocation s+            epToken' NoEpTok = case ba of+             BlankEpAnnotations -> parens+                                      $ text "blanked:" <+> text "EpToken"+             NoBlankEpAnnotations ->+              parens $ text "NoEpTok"++            epUniToken' :: EpUniToken sym1 sym2 -> SDoc+            epUniToken' (EpUniTok s f) = case ba of+             BlankEpAnnotations -> parens+                                      $ text "blanked:" <+> text "EpUniToken"+             NoBlankEpAnnotations ->+              parens $ text "EpUniTok" <+> epaLocation s <+> ppr f+            epUniToken' NoEpUniTok = case ba of+             BlankEpAnnotations -> parens+                                      $ text "blanked:" <+> text "EpUniToken"+             NoBlankEpAnnotations ->+              parens $ text "NoEpUniTok"++             var  :: Var -> SDoc             var v      = braces $ text "Var:" <+> ppr v @@ -222,11 +347,6 @@                           text "NameSet:"                        $$ (list . nameSetElemsStable $ ns) -            fixity :: Fixity -> SDoc-            fixity fx =  braces $-                         text "Fixity:"-                     <+> ppr fx-             located :: (Data a, Data b) => GenLocated a b -> SDoc             located (L ss a)               = parens (text "L"@@ -235,35 +355,26 @@              -- ------------------------- -            annotation :: EpAnn [AddEpAnn] -> SDoc-            annotation = annotation' (text "EpAnn [AddEpAnn]")-             annotationModule :: EpAnn AnnsModule -> SDoc             annotationModule = annotation' (text "EpAnn AnnsModule") -            annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc-            annotationAddEpAnn = annotation' (text "EpAnn AddEpAnn")-             annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc             annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn") -            annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc-            annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase")--            annotationAnnList :: EpAnn AnnList -> SDoc-            annotationAnnList = annotation' (text "EpAnn AnnList")+            annotationAnnList :: EpAnn (AnnList ()) -> SDoc+            annotationAnnList = annotation' (text "EpAnn (AnnList ())") -            annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc-            annotationEpAnnImportDecl = annotation' (text "EpAnn EpAnnImportDecl")+            annotationAnnListWhere :: EpAnn (AnnList (EpToken "where")) -> SDoc+            annotationAnnListWhere = annotation' (text "EpAnn (AnnList (EpToken \"where\"))") -            annotationAnnParen :: EpAnn AnnParen -> SDoc-            annotationAnnParen = annotation' (text "EpAnn AnnParen")+            annotationAnnListCommas :: EpAnn (AnnList [EpToken ","]) -> SDoc+            annotationAnnListCommas = annotation' (text "EpAnn (AnnList [EpToken \",\"])") -            annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc-            annotationTrailingAnn = annotation' (text "EpAnn TrailingAnn")+            annotationAnnListIE :: EpAnn (AnnList (EpToken "hiding", [EpToken ","])) -> SDoc+            annotationAnnListIE = annotation' (text "EpAnn (AnnList (EpToken \"hiding\", [EpToken \",\"]))") -            annotationEpaLocation :: EpAnn EpaLocation -> SDoc-            annotationEpaLocation = annotation' (text "EpAnn EpaLocation")+            annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc+            annotationEpAnnImportDecl = annotation' (text "EpAnn EpAnnImportDecl")              annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc             annotationNoEpAnns = annotation' (text "EpAnn NoEpAnns")@@ -280,7 +391,7 @@             srcSpanAnnA :: EpAnn AnnListItem -> SDoc             srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA") -            srcSpanAnnL :: EpAnn AnnList -> SDoc+            srcSpanAnnL :: EpAnn (AnnList ()) -> SDoc             srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL")              srcSpanAnnP :: EpAnn AnnPragma -> SDoc
compiler/GHC/Hs/Expr.hs view
@@ -32,6 +32,7 @@ -- friends: import GHC.Prelude +import GHC.Hs.Basic() -- import instances import GHC.Hs.Decls() -- import instances import GHC.Hs.Pat import GHC.Hs.Lit@@ -66,7 +67,7 @@ import {-# SOURCE #-} GHC.Tc.Types.LclEnv (TcLclEnv)  import GHCi.RemoteTypes ( ForeignRef )-import qualified Language.Haskell.TH as TH (Q)+import qualified GHC.Internal.TH.Syntax as TH (Q)  -- libraries: import Data.Data hiding (Fixity(..))@@ -185,31 +186,48 @@                                         -- pasted back in by the desugarer   } -type instance XTypedBracket GhcPs = [AddEpAnn]+type instance XTypedBracket GhcPs = (BracketAnn (EpToken "[||") (EpToken "[e||"), EpToken "||]") type instance XTypedBracket GhcRn = NoExtField type instance XTypedBracket GhcTc = HsBracketTc-type instance XUntypedBracket GhcPs = [AddEpAnn]+type instance XUntypedBracket GhcPs = NoExtField type instance XUntypedBracket GhcRn = [PendingRnSplice] -- See Note [Pending Splices]                                                         -- Output of the renamer is the *original* renamed expression,                                                         -- plus _renamed_ splices to be type checked type instance XUntypedBracket GhcTc = HsBracketTc +data BracketAnn noE hasE+  = BracketNoE noE+  | BracketHasE hasE+  deriving Data++instance (NoAnn n, NoAnn h) => NoAnn (BracketAnn n h) where+  noAnn = BracketNoE noAnn+ -- ---------------------------------------------------------------------  -- API Annotations types  data EpAnnHsCase = EpAnnHsCase-      { hsCaseAnnCase :: EpaLocation-      , hsCaseAnnOf   :: EpaLocation-      , hsCaseAnnsRest :: [AddEpAnn]+      { hsCaseAnnCase :: EpToken "case"+      , hsCaseAnnOf   :: EpToken "of"       } deriving Data  instance NoAnn EpAnnHsCase where-  noAnn = EpAnnHsCase noAnn noAnn noAnn+  noAnn = EpAnnHsCase noAnn noAnn +data EpAnnLam = EpAnnLam+      { epl_lambda :: EpToken "\\"      -- ^ Location of '\' keyword+      , epl_case   :: Maybe EpaLocation -- ^ Location of 'case' or+                                        -- 'cases' keyword, depending+                                        -- on related 'HsLamVariant'.+      } deriving Data++instance NoAnn EpAnnLam where+  noAnn = EpAnnLam noAnn noAnn+ data EpAnnUnboundVar = EpAnnUnboundVar-     { hsUnboundBackquotes :: (EpaLocation, EpaLocation)-     , hsUnboundHole       :: EpaLocation+     { hsUnboundBackquotes :: (EpToken "`", EpToken "`")+     , hsUnboundHole       :: EpToken "_"      } deriving Data  -- Record selectors at parse time are HsVar; they convert to HsRecSel@@ -220,8 +238,8 @@  -- OverLabel not present in GhcTc pass; see GHC.Rename.Expr -- Note [Handling overloaded and rebindable constructs]-type instance XOverLabel     GhcPs = NoExtField-type instance XOverLabel     GhcRn = NoExtField+type instance XOverLabel     GhcPs = SourceText+type instance XOverLabel     GhcRn = SourceText type instance XOverLabel     GhcTc = DataConCantHappen  -- ---------------------------------------------------------------------@@ -241,7 +259,7 @@ type instance XIPVar         GhcTc = DataConCantHappen type instance XOverLitE      (GhcPass _) = NoExtField type instance XLitE          (GhcPass _) = NoExtField-type instance XLam           (GhcPass _) = [AddEpAnn]+type instance XLam           (GhcPass _) = EpAnnLam type instance XApp           (GhcPass _) = NoExtField  type instance XAppTypeE      GhcPs = EpToken "@"@@ -250,7 +268,7 @@  -- OpApp not present in GhcTc pass; see GHC.Rename.Expr -- Note [Handling overloaded and rebindable constructs]-type instance XOpApp         GhcPs = [AddEpAnn]+type instance XOpApp         GhcPs = NoExtField type instance XOpApp         GhcRn = Fixity type instance XOpApp         GhcTc = DataConCantHappen @@ -264,7 +282,7 @@ type instance XSectionR      GhcTc = DataConCantHappen  -type instance XNegApp        GhcPs = [AddEpAnn]+type instance XNegApp        GhcPs = EpToken "-" type instance XNegApp        GhcRn = NoExtField type instance XNegApp        GhcTc = NoExtField @@ -272,7 +290,7 @@ type instance XPar           GhcRn = NoExtField type instance XPar           GhcTc = NoExtField -type instance XExplicitTuple GhcPs = [AddEpAnn]+type instance XExplicitTuple GhcPs = (EpaLocation, EpaLocation) type instance XExplicitTuple GhcRn = NoExtField type instance XExplicitTuple GhcTc = NoExtField @@ -288,7 +306,7 @@ type instance XIf            GhcRn = NoExtField type instance XIf            GhcTc = NoExtField -type instance XMultiIf       GhcPs = [AddEpAnn]+type instance XMultiIf       GhcPs = (EpToken "if", EpToken "{", EpToken "}") type instance XMultiIf       GhcRn = NoExtField type instance XMultiIf       GhcTc = Type @@ -296,11 +314,11 @@ type instance XLet           GhcRn = NoExtField type instance XLet           GhcTc = NoExtField -type instance XDo            GhcPs = AnnList+type instance XDo            GhcPs = AnnList EpaLocation type instance XDo            GhcRn = NoExtField type instance XDo            GhcTc = Type -type instance XExplicitList  GhcPs = AnnList+type instance XExplicitList  GhcPs = AnnList () type instance XExplicitList  GhcRn = NoExtField type instance XExplicitList  GhcTc = Type -- GhcPs: ExplicitList includes all source-level@@ -311,11 +329,11 @@ -- See Note [Handling overloaded and rebindable constructs] -- in  GHC.Rename.Expr -type instance XRecordCon     GhcPs = [AddEpAnn]+type instance XRecordCon     GhcPs = (Maybe (EpToken "{"), Maybe (EpToken "}")) type instance XRecordCon     GhcRn = NoExtField type instance XRecordCon     GhcTc = PostTcExpr   -- Instantiated constructor function -type instance XRecordUpd     GhcPs = [AddEpAnn]+type instance XRecordUpd     GhcPs = (Maybe (EpToken "{"), Maybe (EpToken "}")) type instance XRecordUpd     GhcRn = NoExtField type instance XRecordUpd     GhcTc = DataConCantHappen   -- We desugar record updates in the typechecker.@@ -359,17 +377,17 @@ -- HsProjection is eliminated by the renamer. See [Handling overloaded -- and rebindable constructs]. -type instance XExprWithTySig GhcPs = [AddEpAnn]+type instance XExprWithTySig GhcPs = TokDcolon type instance XExprWithTySig GhcRn = NoExtField type instance XExprWithTySig GhcTc = NoExtField -type instance XArithSeq      GhcPs = [AddEpAnn]+type instance XArithSeq      GhcPs = AnnArithSeq type instance XArithSeq      GhcRn = NoExtField type instance XArithSeq      GhcTc = PostTcExpr -type instance XProc          (GhcPass _) = [AddEpAnn]+type instance XProc          (GhcPass _) = (EpToken "proc", TokRarrow) -type instance XStatic        GhcPs = [AddEpAnn]+type instance XStatic        GhcPs = EpToken "static" type instance XStatic        GhcRn = NameSet type instance XStatic        GhcTc = (NameSet, Type)   -- Free variables and type of expression, this is stored for convenience as wiring in@@ -381,16 +399,33 @@   -- A free-standing HsEmbTy is an error.   -- Valid usages are immediately desugared into Type. +type instance XForAll        GhcPs = NoExtField+type instance XForAll        GhcRn = NoExtField+type instance XForAll        GhcTc = DataConCantHappen++type instance XQual          GhcPs = NoExtField+type instance XQual          GhcRn = NoExtField+type instance XQual          GhcTc = DataConCantHappen++type instance XFunArr        GhcPs = NoExtField+type instance XFunArr        GhcRn = NoExtField+type instance XFunArr        GhcTc = DataConCantHappen+ type instance XPragE         (GhcPass _) = NoExtField -type instance Anno [LocatedA ((StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr)))))] = SrcSpanAnnL+type instance XFunRhs  = AnnFunRhs++type instance Anno [LocatedA ((StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr)))))] = SrcSpanAnnLW type instance Anno (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))) = SrcSpanAnnA +arrowToHsExpr :: HsArrowOf (LocatedA (HsExpr GhcRn)) GhcRn -> LocatedA (HsExpr GhcRn)+arrowToHsExpr = expandHsArrow (HsVar noExtField)+ data AnnExplicitSum   = AnnExplicitSum {       aesOpen       :: EpaLocation,-      aesBarsBefore :: [EpaLocation],-      aesBarsAfter  :: [EpaLocation],+      aesBarsBefore :: [EpToken "|"],+      aesBarsAfter  :: [EpToken "|"],       aesClose      :: EpaLocation       } deriving Data @@ -399,7 +434,7 @@  data AnnFieldLabel   = AnnFieldLabel {-      afDot :: Maybe EpaLocation+      afDot :: Maybe (EpToken ".")       } deriving Data  instance NoAnn AnnFieldLabel where@@ -407,25 +442,46 @@  data AnnProjection   = AnnProjection {-      apOpen  :: EpaLocation, -- ^ '('-      apClose :: EpaLocation  -- ^ ')'+      apOpen  :: EpToken "(",+      apClose :: EpToken ")"       } deriving Data  instance NoAnn AnnProjection where   noAnn = AnnProjection noAnn noAnn +data AnnArithSeq+  = AnnArithSeq {+      aas_open   :: EpToken "[",+      aas_comma  :: Maybe (EpToken ","),+      aas_dotdot :: EpToken "..",+      aas_close  :: EpToken "]"+      } deriving Data++instance NoAnn AnnArithSeq where+  noAnn = AnnArithSeq noAnn noAnn noAnn noAnn+ data AnnsIf   = AnnsIf {-      aiIf       :: EpaLocation,-      aiThen     :: EpaLocation,-      aiElse     :: EpaLocation,-      aiThenSemi :: Maybe EpaLocation,-      aiElseSemi :: Maybe EpaLocation+      aiIf       :: EpToken "if",+      aiThen     :: EpToken "then",+      aiElse     :: EpToken "else",+      aiThenSemi :: Maybe (EpToken ";"),+      aiElseSemi :: Maybe (EpToken ";")       } deriving Data  instance NoAnn AnnsIf where   noAnn = AnnsIf noAnn noAnn noAnn Nothing Nothing +data AnnFunRhs+  = AnnFunRhs {+       afr_strict :: EpToken "!",+       afr_opens  :: [EpToken "("],+       afr_closes :: [EpToken ")"]+  } deriving Data++instance NoAnn AnnFunRhs where+  noAnn = AnnFunRhs noAnn noAnn noAnn+ -- ---------------------------------------------------------------------  type instance XSCC           (GhcPass _) = (AnnPragma, SourceText)@@ -498,8 +554,12 @@                                                    -- Does not presist post renaming phase                                                    -- See Part 3. of Note [Expanding HsDo with XXExprGhcRn]                                                    -- in `GHC.Tc.Gen.Do`+  | HsRecSelRn  (FieldOcc GhcRn)   -- ^ Variable pointing to record selector+                           -- See Note [Non-overloaded record field selectors] and+                           -- Note [Record selectors in the AST]  + -- | Wrap a located expression with a `PopErrCtxt` mkPopErrCtxtExpr :: LHsExpr GhcRn -> HsExpr GhcRn mkPopErrCtxtExpr a = XExpr (PopErrCtxt a)@@ -553,7 +613,7 @@  data XXExprGhcTc   = WrapExpr        -- Type and evidence application and abstractions-      {-# UNPACK #-} !(HsWrap HsExpr)+      HsWrapper (HsExpr GhcTc)    | ExpandedThingTc                         -- See Note [Rebindable syntax and XXExprGhcRn]                                             -- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`@@ -579,6 +639,11 @@      Int                                -- module-local tick number for False      (LHsExpr GhcTc)                    -- sub-expression +  | HsRecSelTc  (FieldOcc GhcTc) -- ^ Variable pointing to record selector+                             -- See Note [Non-overloaded record field selectors] and+                             -- Note [Record selectors in the AST]++ -- | Build a 'XXExprGhcRn' out of an extension constructor, --   and the two components of the expansion: original and --   expanded typechecked expressions.@@ -639,11 +704,15 @@          => HsExpr (GhcPass p) -> SDoc ppr_expr (HsVar _ (L _ v))   = pprPrefixOcc v ppr_expr (HsUnboundVar _ uv) = pprPrefixOcc uv-ppr_expr (HsRecSel _ f)      = pprPrefixOcc f ppr_expr (HsIPVar _ v)       = ppr v-ppr_expr (HsOverLabel _ s l) = char '#' <> case s of-                                             NoSourceText -> ppr l-                                             SourceText src -> ftext src+ppr_expr (HsOverLabel s l) = case ghcPass @p of+               GhcPs -> helper s+               GhcRn -> helper s+               GhcTc -> dataConCantHappen s+    where helper s =+            char '#' <> case s of+                          NoSourceText -> ppr l+                          SourceText src -> ftext src ppr_expr (HsLit _ lit)       = ppr lit ppr_expr (HsOverLit _ lit)   = ppr lit ppr_expr (HsPar _ e)         = parens (ppr_lexpr e)@@ -828,6 +897,21 @@ ppr_expr (HsEmbTy _ ty)   = hsep [text "type", ppr ty] +ppr_expr (HsQual _ ctxt ty)+  = sep [ppr_context ctxt, ppr_lexpr ty]+  where+    ppr_context (L _ ctxt) =+      case ctxt of+        []       -> parens empty             <+> darrow+        [L _ ty] -> ppr_expr ty              <+> darrow+        _        -> parens (interpp'SP ctxt) <+> darrow++ppr_expr (HsForAll _ tele ty)+  = sep [pprHsForAll tele Nothing, ppr_lexpr ty]++ppr_expr (HsFunArr _ arr arg res)+  = sep [ppr_lexpr arg, pprHsArrow arr <+> ppr_lexpr res]+ ppr_expr (XExpr x) = case ghcPass @p of   GhcRn -> ppr x   GhcTc -> ppr x@@ -838,14 +922,16 @@         OrigExpr x -> ppr_builder "<OrigExpr>:" x         OrigStmt x -> ppr_builder "<OrigStmt>:" x         OrigPat x  -> ppr_builder "<OrigPat>:" x+     where ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens (ppr x))) (ppr x)  instance Outputable XXExprGhcRn where   ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [ppr o, ppr e]) (ppr o)   ppr (PopErrCtxt e)        = ifPprDebug (braces (text "<PopErrCtxt>" <+> ppr e)) (ppr e)+  ppr (HsRecSelRn f)        = pprPrefixOcc f  instance Outputable XXExprGhcTc where-  ppr (WrapExpr (HsWrap co_fn e))+  ppr (WrapExpr co_fn e)     = pprHsWrapper co_fn (\_parens -> pprExpr e)    ppr (ExpandedThingTc o e)@@ -871,10 +957,11 @@             ppr tickIdFalse,             text ">(",             ppr exp, text ")"]+  ppr (HsRecSelTc f)      = pprPrefixOcc f + ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc ppr_infix_expr (HsVar _ (L _ v))    = Just (pprInfixOcc v)-ppr_infix_expr (HsRecSel _ f)       = Just (pprInfixOcc f) ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ) ppr_infix_expr (XExpr x)            = case ghcPass @p of                                         GhcRn -> ppr_infix_expr_rn x@@ -883,15 +970,18 @@  ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc ppr_infix_expr_rn (ExpandedThingRn thing _) = ppr_infix_hs_expansion thing-ppr_infix_expr_rn (PopErrCtxt (L _ a)) = ppr_infix_expr a+ppr_infix_expr_rn (PopErrCtxt (L _ a))      = ppr_infix_expr a+ppr_infix_expr_rn (HsRecSelRn f)            = Just (pprInfixOcc f)  ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc-ppr_infix_expr_tc (WrapExpr (HsWrap _ e))    = ppr_infix_expr e+ppr_infix_expr_tc (WrapExpr _ e)    = ppr_infix_expr e ppr_infix_expr_tc (ExpandedThingTc thing _)  = ppr_infix_hs_expansion thing ppr_infix_expr_tc (ConLikeTc {})             = Nothing ppr_infix_expr_tc (HsTick {})                = Nothing ppr_infix_expr_tc (HsBinTick {})             = Nothing+ppr_infix_expr_tc (HsRecSelTc f)            = Just (pprInfixOcc f) + ppr_infix_hs_expansion :: HsThingRn -> Maybe SDoc ppr_infix_hs_expansion (OrigExpr e) = ppr_infix_expr e ppr_infix_hs_expansion _            = Nothing@@ -977,24 +1067,28 @@     go (HsProc{})                     = prec > topPrec     go (HsStatic{})                   = prec >= appPrec     go (RecordCon{})                  = False-    go (HsRecSel{})                   = False     go (HsProjection{})               = True     go (HsGetField{})                 = False     go (HsEmbTy{})                    = prec > topPrec+    go (HsForAll{})                   = prec >= funPrec+    go (HsQual{})                     = prec >= funPrec+    go (HsFunArr{})                   = prec >= funPrec     go (XExpr x) = case ghcPass @p of                      GhcTc -> go_x_tc x                      GhcRn -> go_x_rn x      go_x_tc :: XXExprGhcTc -> Bool-    go_x_tc (WrapExpr (HsWrap _ e))          = hsExprNeedsParens prec e+    go_x_tc (WrapExpr _ e)                   = hsExprNeedsParens prec e     go_x_tc (ExpandedThingTc thing _)        = hsExpandedNeedsParens thing     go_x_tc (ConLikeTc {})                   = False     go_x_tc (HsTick _ (L _ e))               = hsExprNeedsParens prec e     go_x_tc (HsBinTick _ _ (L _ e))          = hsExprNeedsParens prec e+    go_x_tc (HsRecSelTc{})                   = False      go_x_rn :: XXExprGhcRn -> Bool     go_x_rn (ExpandedThingRn thing _)    = hsExpandedNeedsParens thing     go_x_rn (PopErrCtxt (L _ a))         = hsExprNeedsParens prec a+    go_x_rn (HsRecSelRn{})               = False      hsExpandedNeedsParens :: HsThingRn -> Bool     hsExpandedNeedsParens (OrigExpr e) = hsExprNeedsParens prec e@@ -1032,21 +1126,22 @@ isAtomicHsExpr (HsIPVar {})      = True isAtomicHsExpr (HsOverLabel {})  = True isAtomicHsExpr (HsUnboundVar {}) = True-isAtomicHsExpr (HsRecSel{})      = True isAtomicHsExpr (XExpr x)   | GhcTc <- ghcPass @p          = go_x_tc x   | GhcRn <- ghcPass @p          = go_x_rn x   where     go_x_tc :: XXExprGhcTc -> Bool-    go_x_tc (WrapExpr      (HsWrap _ e))     = isAtomicHsExpr e-    go_x_tc (ExpandedThingTc thing _)        = isAtomicExpandedThingRn thing-    go_x_tc (ConLikeTc {})                   = True-    go_x_tc (HsTick {}) = False-    go_x_tc (HsBinTick {}) = False+    go_x_tc (WrapExpr _ e)            = isAtomicHsExpr e+    go_x_tc (ExpandedThingTc thing _) = isAtomicExpandedThingRn thing+    go_x_tc (ConLikeTc {})            = True+    go_x_tc (HsTick {})               = False+    go_x_tc (HsBinTick {})            = False+    go_x_tc (HsRecSelTc{})            = True      go_x_rn :: XXExprGhcRn -> Bool-    go_x_rn (ExpandedThingRn thing _)    = isAtomicExpandedThingRn thing-    go_x_rn (PopErrCtxt (L _ a))         = isAtomicHsExpr a+    go_x_rn (ExpandedThingRn thing _) = isAtomicExpandedThingRn thing+    go_x_rn (PopErrCtxt (L _ a))      = isAtomicHsExpr a+    go_x_rn (HsRecSelRn{})            = True      isAtomicExpandedThingRn :: HsThingRn -> Bool     isAtomicExpandedThingRn (OrigExpr e) = isAtomicHsExpr e@@ -1240,13 +1335,15 @@ ************************************************************************ -} -type instance XCmdArrApp  GhcPs = AddEpAnn+type instance XCmdArrApp  GhcPs = (IsUnicodeSyntax, EpaLocation) 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+type instance XCmdArrForm GhcPs = AnnList ()+-- | 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@@ -1259,7 +1356,7 @@ type instance XCmdCase    GhcRn = NoExtField type instance XCmdCase    GhcTc = NoExtField -type instance XCmdLamCase (GhcPass _) = [AddEpAnn]+type instance XCmdLamCase (GhcPass _) = EpAnnLam  type instance XCmdIf      GhcPs = AnnsIf type instance XCmdIf      GhcRn = NoExtField@@ -1269,7 +1366,7 @@ type instance XCmdLet     GhcRn = NoExtField type instance XCmdLet     GhcTc = NoExtField -type instance XCmdDo      GhcPs = AnnList+type instance XCmdDo      GhcPs = AnnList EpaLocation type instance XCmdDo      GhcRn = NoExtField type instance XCmdDo      GhcTc = Type @@ -1279,9 +1376,6 @@ type instance XXCmd       GhcRn = DataConCantHappen type instance XXCmd       GhcTc = HsWrap HsCmd -type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))]-  = SrcSpanAnnL-     -- If   cmd :: arg1 --> res     --      wrap :: arg1 "->" arg2     -- Then (XCmd (HsWrap wrap cmd)) :: arg2 --> res@@ -1410,7 +1504,7 @@ 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 +1519,10 @@     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 -> ps_fix == Infix+          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@@ -1463,7 +1560,7 @@  type instance XXMatchGroup (GhcPass _) b = DataConCantHappen -type instance XCMatch (GhcPass _) b = [AddEpAnn]+type instance XCMatch (GhcPass _) b = NoExtField type instance XXMatch (GhcPass _) b = DataConCantHappen  instance (OutputableBndrId pr, Outputable body)@@ -1491,7 +1588,7 @@   hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)]-hsLMatchPats (L _ (Match { m_pats = pats })) = pats+hsLMatchPats (L _ (Match { m_pats = L _ pats })) = pats  -- We keep the type checker happy by providing EpAnnComments.  They -- can only be used if they follow a `where` keyword with no binds,@@ -1503,8 +1600,8 @@  data GrhsAnn   = GrhsAnn {-      ga_vbar :: Maybe EpaLocation, -- TODO:AZ do we need this?-      ga_sep  :: AddEpAnn -- ^ Match separator location+      ga_vbar :: Maybe (EpToken "|"),+      ga_sep  :: Either (EpToken "=") TokRarrow -- ^ Match separator location, `=` or `->`       } deriving (Data)  instance NoAnn GrhsAnn where@@ -1537,7 +1634,7 @@  pprMatch :: (OutputableBndrId idR, Outputable body)          => Match (GhcPass idR) body -> SDoc-pprMatch (Match { m_pats = pats, m_ctxt = ctxt, m_grhss = grhss })+pprMatch (Match { m_pats = L _ pats, m_ctxt = ctxt, m_grhss = grhss })   = sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)         , nest 2 (pprGRHSs ctxt grhss) ]   where@@ -1650,7 +1747,7 @@  type instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExtField -type instance XBindStmt        (GhcPass _) GhcPs b = [AddEpAnn]+type instance XBindStmt        (GhcPass _) GhcPs b = EpUniToken "<-" "←" type instance XBindStmt        (GhcPass _) GhcRn b = XBindStmtRn type instance XBindStmt        (GhcPass _) GhcTc b = XBindStmtTc @@ -1666,30 +1763,97 @@   , xbstc_failOp :: FailOperator GhcTc   } -type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExtField-type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExtField-type instance XApplicativeStmt (GhcPass _) GhcTc b = Type+type instance XApplicativeStmt (GhcPass _) GhcPs = NoExtField+type instance XApplicativeStmt (GhcPass _) GhcRn = NoExtField+type instance XApplicativeStmt (GhcPass _) GhcTc = Type  type instance XBodyStmt        (GhcPass _) GhcPs b = NoExtField type instance XBodyStmt        (GhcPass _) GhcRn b = NoExtField type instance XBodyStmt        (GhcPass _) GhcTc b = Type -type instance XLetStmt         (GhcPass _) (GhcPass _) b = [AddEpAnn]+type instance XLetStmt         (GhcPass _) (GhcPass _) b = EpToken "let"  type instance XParStmt         (GhcPass _) GhcPs b = NoExtField type instance XParStmt         (GhcPass _) GhcRn b = NoExtField type instance XParStmt         (GhcPass _) GhcTc b = Type -type instance XTransStmt       (GhcPass _) GhcPs b = [AddEpAnn]+type instance XTransStmt       (GhcPass _) GhcPs b = AnnTransStmt type instance XTransStmt       (GhcPass _) GhcRn b = NoExtField type instance XTransStmt       (GhcPass _) GhcTc b = Type -type instance XRecStmt         (GhcPass _) GhcPs b = AnnList+type instance XRecStmt         (GhcPass _) GhcPs b = AnnList (EpToken "rec") type instance XRecStmt         (GhcPass _) GhcRn b = NoExtField type instance XRecStmt         (GhcPass _) GhcTc b = RecStmtTc -type instance XXStmtLR         (GhcPass _) (GhcPass _) b = DataConCantHappen+type instance XXStmtLR         (GhcPass _) GhcPs b = DataConCantHappen+type instance XXStmtLR         (GhcPass x) GhcRn b = ApplicativeStmt (GhcPass x) GhcRn+type instance XXStmtLR         (GhcPass x) GhcTc b = ApplicativeStmt (GhcPass x) GhcTc +data AnnTransStmt+  = AnnTransStmt {+      ats_then  :: EpToken "then",+      ats_group :: Maybe (EpToken "group"),+      ats_by    :: Maybe (EpToken "by"),+      ats_using :: Maybe (EpToken "using")+      } deriving Data++instance NoAnn AnnTransStmt where+  noAnn = AnnTransStmt noAnn noAnn noAnn noAnn+++-- | 'ApplicativeStmt' represents an applicative expression built with+-- '<$>' and '<*>'.  It is generated by the renamer, and is desugared into the+-- appropriate applicative expression by the desugarer, but it is intended+-- to be invisible in error messages.+--+-- For full details, see Note [ApplicativeDo] in "GHC.Rename.Expr"+--+data ApplicativeStmt idL idR+  = ApplicativeStmt+             (XApplicativeStmt idL idR) -- Post typecheck, Type of the body+             [ ( SyntaxExpr idR+               , ApplicativeArg idL) ]+                      -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]+             (Maybe (SyntaxExpr idR))  -- 'join', if necessary++-- | Applicative Argument+data ApplicativeArg idL+  = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)+    { xarg_app_arg_one  :: XApplicativeArgOne idL+      -- ^ The fail operator, after renaming+      --+      -- The fail operator is needed if this is a BindStmt+      -- where the pattern can fail. E.g.:+      -- (Just a) <- stmt+      -- The fail operator will be invoked if the pattern+      -- match fails.+      -- It is also used for guards in MonadComprehensions.+      -- The fail operator is Nothing+      -- if the pattern match can't fail+    , app_arg_pattern   :: LPat idL -- WildPat if it was a BodyStmt (see below)+    , arg_expr          :: LHsExpr idL+    , is_body_stmt      :: Bool+      -- ^ True <=> was a BodyStmt,+      -- False <=> was a BindStmt.+      -- See Note [Applicative BodyStmt]+    }+  | ApplicativeArgMany     -- do { stmts; return vars }+    { xarg_app_arg_many :: XApplicativeArgMany idL+    , app_stmts         :: [ExprLStmt idL] -- stmts+    , final_expr        :: HsExpr idL    -- return (v1,..,vn), or just (v1,..,vn)+    , bv_pattern        :: LPat idL      -- (v1,...,vn)+    , stmt_context      :: HsDoFlavour+      -- ^ context of the do expression, used in pprArg+    }+  | XApplicativeArg !(XXApplicativeArg idL)++type family XApplicativeStmt x x'++-- ApplicativeArg type families+type family XApplicativeArgOne   x+type family XApplicativeArgMany  x+type family XXApplicativeArg     x+ type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExtField type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = DataConCantHappen @@ -1739,40 +1903,48 @@          , whenPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids                             , text "later_ids=" <> ppr later_ids])] -pprStmt (ApplicativeStmt _ args mb_join)-  = getPprStyle $ \style ->-      if userStyle style-         then pp_for_user-         else pp_debug+pprStmt (XStmtLR x) = case ghcPass :: GhcPass idR of+    GhcRn -> pprApplicativeStmt x+    GhcTc -> pprApplicativeStmt x+   where-  -- make all the Applicative stuff invisible in error messages by-  -- flattening the whole ApplicativeStmt nest back to a sequence-  -- of statements.-   pp_for_user = vcat $ concatMap flattenArg args+    pprApplicativeStmt :: (OutputableBndrId idL, OutputableBndrId idR) => ApplicativeStmt (GhcPass idL) (GhcPass idR) -> SDoc+    pprApplicativeStmt (ApplicativeStmt _ args mb_join) =+      getPprStyle $ \style ->+          if userStyle style+             then pp_for_user+             else pp_debug+      where+        -- make all the Applicative stuff invisible in error messages by+        -- flattening the whole ApplicativeStmt nest back to a sequence+        -- of statements.+        pp_for_user = vcat $ concatMap flattenArg args -   -- ppr directly rather than transforming here, because we need to-   -- inject a "return" which is hard when we're polymorphic in the id-   -- type.-   flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]-   flattenStmt (L _ (ApplicativeStmt _ args _)) = concatMap flattenArg args-   flattenStmt stmt = [ppr stmt]+        -- ppr directly rather than transforming here, because we need to+        -- inject a "return" which is hard when we're polymorphic in the id+        -- type.+        flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]+        flattenStmt (L _ (XStmtLR x)) = case ghcPass :: GhcPass idL of+            GhcRn | (ApplicativeStmt _ args _) <- x -> concatMap flattenArg args+            GhcTc | (ApplicativeStmt _ args _) <- x -> concatMap flattenArg args+        flattenStmt stmt = [ppr stmt] -   flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]-   flattenArg (_, ApplicativeArgOne _ pat expr isBody)-     | isBody =  [ppr expr] -- See Note [Applicative BodyStmt]-     | otherwise = [pprBindStmt pat expr]-   flattenArg (_, ApplicativeArgMany _ stmts _ _ _) =-     concatMap flattenStmt stmts+        flattenArg :: (a, ApplicativeArg (GhcPass idL)) -> [SDoc]+        flattenArg (_, ApplicativeArgOne _ pat expr isBody)+          | isBody =  [ppr expr] -- See Note [Applicative BodyStmt]+          | otherwise = [pprBindStmt pat expr]+        flattenArg (_, ApplicativeArgMany _ stmts _ _ _) =+          concatMap flattenStmt stmts -   pp_debug =-     let-         ap_expr = sep (punctuate (text " |") (map pp_arg args))-     in-       whenPprDebug (if isJust mb_join then text "[join]" else empty) <+>-       (if lengthAtLeast args 2 then parens else id) ap_expr+        pp_debug =+          let+              ap_expr = sep (punctuate (text " |") (map pp_arg args))+          in+            whenPprDebug (if isJust mb_join then text "[join]" else empty) <+>+            (if lengthAtLeast args 2 then parens else id) ap_expr -   pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc-   pp_arg (_, applicativeArg) = ppr applicativeArg+        pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc+        pp_arg (_, applicativeArg) = ppr applicativeArg  pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr]@@ -1893,7 +2065,7 @@       }   | HsUntypedSpliceNested SplicePointName -- A unique name to identify this splice point -type instance XTypedSplice   GhcPs = [AddEpAnn]+type instance XTypedSplice   GhcPs = EpToken "$$" type instance XTypedSplice   GhcRn = SplicePointName type instance XTypedSplice   GhcTc = DelayedSplice @@ -1902,8 +2074,8 @@ type instance XUntypedSplice GhcTc = DataConCantHappen  -- HsUntypedSplice-type instance XUntypedSpliceExpr GhcPs = [AddEpAnn]-type instance XUntypedSpliceExpr GhcRn = [AddEpAnn]+type instance XUntypedSpliceExpr GhcPs = EpToken "$"+type instance XUntypedSpliceExpr GhcRn = EpToken "$" type instance XUntypedSpliceExpr GhcTc = DataConCantHappen  type instance XQuasiQuote        p = NoExtField@@ -1977,12 +2149,12 @@     <> ppr e  -type instance XExpBr  GhcPs       = NoExtField-type instance XPatBr  GhcPs       = NoExtField-type instance XDecBrL GhcPs       = NoExtField+type instance XExpBr  GhcPs       = (BracketAnn (EpUniToken "[|" "⟦") (EpToken "[e|"), EpUniToken "|]" "⟧")+type instance XPatBr  GhcPs       = (EpToken "[p|", EpUniToken "|]" "⟧")+type instance XDecBrL GhcPs       = (EpToken "[d|", EpUniToken "|]" "⟧", (EpToken "{", EpToken "}")) type instance XDecBrG GhcPs       = NoExtField-type instance XTypBr  GhcPs       = NoExtField-type instance XVarBr  GhcPs       = NoExtField+type instance XTypBr  GhcPs       = (EpToken "[t|", EpUniToken "|]" "⟧")+type instance XVarBr  GhcPs       = EpaLocation type instance XXQuote GhcPs       = DataConCantHappen  type instance XExpBr  GhcRn       = NoExtField@@ -2247,7 +2419,7 @@   ifPprDebug (sep [text "transformed branch of", pprAStmtContext c])              (pprStmtContext c) -pprStmtCat :: Stmt (GhcPass p) body -> SDoc+pprStmtCat :: forall p body . IsPass p => Stmt (GhcPass p) body -> SDoc pprStmtCat (TransStmt {})       = text "transform" pprStmtCat (LastStmt {})        = text "return expression" pprStmtCat (BodyStmt {})        = text "body"@@ -2255,7 +2427,7 @@ pprStmtCat (LetStmt {})         = text "let" pprStmtCat (RecStmt {})         = text "rec" pprStmtCat (ParStmt {})         = text "parallel"-pprStmtCat (ApplicativeStmt {}) = text "applicative"+pprStmtCat (XStmtLR _)          = text "applicative"  pprAHsDoFlavour, pprHsDoFlavour :: HsDoFlavour -> SDoc pprAHsDoFlavour flavour = article <+> pprHsDoFlavour flavour@@ -2316,25 +2488,25 @@ -}  type instance Anno (HsExpr (GhcPass p)) = SrcSpanAnnA-type instance Anno [LocatedA ((StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr)))))] = SrcSpanAnnL-type instance Anno [LocatedA ((StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr)))))] = SrcSpanAnnL+type instance Anno [LocatedA (HsExpr (GhcPass p))] = SrcSpanAnnC+type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr))))] = SrcSpanAnnLW+type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnLW  type instance Anno (HsCmd (GhcPass p)) = SrcSpanAnnA -type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))]-  = SrcSpanAnnL type instance Anno (HsCmdTop (GhcPass p)) = EpAnnCO-type instance Anno [LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))] = SrcSpanAnnL-type instance Anno [LocatedA (Match (GhcPass p) (LocatedA (HsCmd  (GhcPass p))))] = SrcSpanAnnL+type instance Anno [LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))] = SrcSpanAnnLW+type instance Anno [LocatedA (Match (GhcPass p) (LocatedA (HsCmd  (GhcPass p))))] = SrcSpanAnnLW type instance Anno (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) = SrcSpanAnnA type instance Anno (Match (GhcPass p) (LocatedA (HsCmd  (GhcPass p)))) = SrcSpanAnnA+type instance Anno [LocatedA (Pat (GhcPass p))] = EpaLocation type instance Anno (GRHS (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) = EpAnnCO type instance Anno (GRHS (GhcPass p) (LocatedA (HsCmd  (GhcPass p)))) = EpAnnCO type instance Anno (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr)))) = SrcSpanAnnA  type instance Anno (HsUntypedSplice (GhcPass p)) = SrcSpanAnnA -type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr))))] = SrcSpanAnnL+type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr))))] = SrcSpanAnnLW  type instance Anno (FieldLabelStrings (GhcPass p)) = EpAnnCO type instance Anno FieldLabelString                = SrcSpanAnnN
compiler/GHC/Hs/Extension.hs view
@@ -172,11 +172,15 @@  -- | Allows us to check what phase we're in at GHC's runtime. -- For example, this class allows us to write--- >  f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah--- >  f e = case ghcPass @p of--- >          GhcPs ->    ... in this RHS we have HsExpr GhcPs...--- >          GhcRn ->    ... in this RHS we have HsExpr GhcRn...--- >          GhcTc ->    ... in this RHS we have HsExpr GhcTc...+--+-- @+-- f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah+-- f e = case ghcPass @p of+--         GhcPs ->    ... in this RHS we have HsExpr GhcPs...+--         GhcRn ->    ... in this RHS we have HsExpr GhcRn...+--         GhcTc ->    ... in this RHS we have HsExpr GhcTc...+-- @+-- -- which is very useful, for example, when pretty-printing. -- See Note [IsPass]. class ( NoGhcTcPass (NoGhcTcPass p) ~ NoGhcTcPass p
compiler/GHC/Hs/ImpExp.hs view
@@ -60,9 +60,9 @@ -- | Given two possible located 'qualified' tokens, compute a style -- (in a conforming Haskell program only one of the two can be not -- 'Nothing'). This is called from "GHC.Parser".-importDeclQualifiedStyle :: Maybe EpaLocation-                         -> Maybe EpaLocation-                         -> (Maybe EpaLocation, ImportDeclQualifiedStyle)+importDeclQualifiedStyle :: Maybe (EpToken "qualified")+                         -> Maybe (EpToken "qualified")+                         -> (Maybe (EpToken "qualified"), ImportDeclQualifiedStyle) importDeclQualifiedStyle mPre mPost =   if isJust mPre then (mPre, QualifiedPre)   else if isJust mPost then (mPost,QualifiedPost) else (Nothing, NotQualified)@@ -81,11 +81,10 @@ type instance XCImportDecl  GhcPs = XImportDeclPass type instance XCImportDecl  GhcRn = XImportDeclPass type instance XCImportDecl  GhcTc = DataConCantHappen-                                 -- Note [Pragma source text] in "GHC.Types.SourceText"  data XImportDeclPass = XImportDeclPass     { ideclAnn        :: EpAnn EpAnnImportDecl-    , ideclSourceText :: SourceText+    , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"     , ideclImplicit   :: Bool         -- ^ GHC generates an `ImportDecl` to represent the invisible `import Prelude`         -- that appears in any file that omits `import Prelude`, setting@@ -97,7 +96,7 @@ type instance XXImportDecl  (GhcPass _) = DataConCantHappen  type instance Anno ModuleName = SrcSpanAnnA-type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnL+type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnLI  deriving instance Data (IEWrappedName GhcPs) deriving instance Data (IEWrappedName GhcRn)@@ -112,12 +111,12 @@ -- API Annotations types  data EpAnnImportDecl = EpAnnImportDecl-  { importDeclAnnImport    :: EpaLocation-  , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation)-  , importDeclAnnSafe      :: Maybe EpaLocation-  , importDeclAnnQualified :: Maybe EpaLocation-  , importDeclAnnPackage   :: Maybe EpaLocation-  , importDeclAnnAs        :: Maybe EpaLocation+  { importDeclAnnImport    :: EpToken "import" -- ^ The location of the @import@ keyword+  , importDeclAnnPragma    :: Maybe (EpaLocation, EpToken "#-}") -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively+  , importDeclAnnSafe      :: Maybe (EpToken "safe") -- ^ The location of the @safe@ keyword+  , importDeclAnnQualified :: Maybe (EpToken "qualified") -- ^ The location of the @qualified@ keyword+  , importDeclAnnPackage   :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@)+  , importDeclAnnAs        :: Maybe (EpToken "as") -- ^ The location of the @as@ keyword   } deriving (Data)  instance NoAnn EpAnnImportDecl where@@ -195,8 +194,9 @@ -}  type instance XIEName    (GhcPass _) = NoExtField-type instance XIEPattern (GhcPass _) = EpaLocation-type instance XIEType    (GhcPass _) = EpaLocation+type instance XIEDefault (GhcPass _) = EpToken "default"+type instance XIEPattern (GhcPass _) = EpToken "pattern"+type instance XIEType    (GhcPass _) = EpToken "type" type instance XXIEWrappedName (GhcPass _) = DataConCantHappen  type instance Anno (IEWrappedName (GhcPass _)) = SrcSpanAnnA@@ -213,28 +213,30 @@ -- The additional field of type 'Maybe (WarningTxt pass)' holds information -- about export deprecation annotations and is thus set to Nothing when `IE` -- is used in an import list (since export deprecation can only be used in exports)-type instance XIEThingAbs  GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])-type instance XIEThingAbs  GhcRn = (Maybe (LWarningTxt GhcRn), [AddEpAnn])-type instance XIEThingAbs  GhcTc = [AddEpAnn]+type instance XIEThingAbs  GhcPs = Maybe (LWarningTxt GhcPs)+type instance XIEThingAbs  GhcRn = Maybe (LWarningTxt GhcRn)+type instance XIEThingAbs  GhcTc = ()  -- The additional field of type 'Maybe (WarningTxt pass)' holds information -- about export deprecation annotations and is thus set to Nothing when `IE` -- is used in an import list (since export deprecation can only be used in exports)-type instance XIEThingAll  GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])-type instance XIEThingAll  GhcRn = (Maybe (LWarningTxt GhcRn), [AddEpAnn])-type instance XIEThingAll  GhcTc = [AddEpAnn]+type instance XIEThingAll  GhcPs = (Maybe (LWarningTxt GhcPs), (EpToken "(", EpToken "..", EpToken ")"))+type instance XIEThingAll  GhcRn = (Maybe (LWarningTxt GhcRn), (EpToken "(", EpToken "..", EpToken ")"))+type instance XIEThingAll  GhcTc = (EpToken "(", EpToken "..", EpToken ")")  -- The additional field of type 'Maybe (WarningTxt pass)' holds information -- about export deprecation annotations and is thus set to Nothing when `IE` -- is used in an import list (since export deprecation can only be used in exports)-type instance XIEThingWith GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])-type instance XIEThingWith GhcRn = (Maybe (LWarningTxt GhcRn), [AddEpAnn])-type instance XIEThingWith GhcTc = [AddEpAnn]+type instance XIEThingWith GhcPs = (Maybe (LWarningTxt GhcPs), IEThingWithAnns)+type instance XIEThingWith GhcRn = (Maybe (LWarningTxt GhcRn), IEThingWithAnns)+type instance XIEThingWith GhcTc = IEThingWithAnns +type IEThingWithAnns = (EpToken "(", EpToken "..", EpToken ",", EpToken ")")+ -- The additional field of type 'Maybe (WarningTxt pass)' holds information -- about export deprecation annotations and is thus set to Nothing when `IE` -- is used in an import list (since export deprecation can only be used in exports)-type instance XIEModuleContents  GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])+type instance XIEModuleContents  GhcPs = (Maybe (LWarningTxt GhcPs), EpToken "module") type instance XIEModuleContents  GhcRn = Maybe (LWarningTxt GhcRn) type instance XIEModuleContents  GhcTc = NoExtField @@ -257,6 +259,7 @@ ieNames (IEThingAbs  _ (L _ n) _)      = [ieWrappedName n] ieNames (IEThingAll  _ (L _ n) _)      = [ieWrappedName n] ieNames (IEThingWith _ (L _ n) _ ns _) = ieWrappedName n : map (ieWrappedName . unLoc) ns+-- NB the above case does not include names of field selectors ieNames (IEModuleContents {})     = [] ieNames (IEGroup          {})     = [] ieNames (IEDoc            {})     = []@@ -267,18 +270,19 @@   where     ie_deprecation :: GhcPass p -> IE (GhcPass p) -> Maybe (LWarningTxt (GhcPass p))     ie_deprecation GhcPs (IEVar xie _ _) = xie-    ie_deprecation GhcPs (IEThingAbs (xie, _) _ _) = xie+    ie_deprecation GhcPs (IEThingAbs xie _ _) = xie     ie_deprecation GhcPs (IEThingAll (xie, _) _ _) = xie     ie_deprecation GhcPs (IEThingWith (xie, _) _ _ _ _) = xie     ie_deprecation GhcPs (IEModuleContents (xie, _) _) = xie     ie_deprecation GhcRn (IEVar xie _ _) = xie-    ie_deprecation GhcRn (IEThingAbs (xie, _) _ _) = xie+    ie_deprecation GhcRn (IEThingAbs xie _ _) = xie     ie_deprecation GhcRn (IEThingAll (xie, _) _ _) = xie     ie_deprecation GhcRn (IEThingWith (xie, _) _ _ _ _) = xie     ie_deprecation GhcRn (IEModuleContents xie _) = xie     ie_deprecation _ _ = Nothing  ieWrappedLName :: IEWrappedName (GhcPass p) -> LIdP (GhcPass p)+ieWrappedLName (IEDefault _ (L l n)) = L l n ieWrappedLName (IEName    _ (L l n)) = L l n ieWrappedLName (IEPattern _ (L l n)) = L l n ieWrappedLName (IEType    _ (L l n)) = L l n@@ -294,6 +298,7 @@ ieLWrappedName (L _ n) = ieWrappedLName n  replaceWrappedName :: IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn+replaceWrappedName (IEDefault r (L l _)) n = IEDefault r (L l n) replaceWrappedName (IEName    x (L l _)) n = IEName    x (L l n) replaceWrappedName (IEPattern r (L l _)) n = IEPattern r (L l n) replaceWrappedName (IEType    r (L l _)) n = IEType    r (L l n)@@ -349,6 +354,7 @@   pprInfixOcc  w = pprInfixOcc  (ieWrappedName w)  instance OutputableBndrId p => Outputable (IEWrappedName (GhcPass p)) where+  ppr (IEDefault _ (L _ n)) = text "default" <+> pprPrefixOcc n   ppr (IEName    _ (L _ n)) = pprPrefixOcc n   ppr (IEPattern _ (L _ n)) = text "pattern" <+> pprPrefixOcc n   ppr (IEType    _ (L _ n)) = text "type"    <+> pprPrefixOcc n
compiler/GHC/Hs/Instances.hs view
@@ -377,6 +377,17 @@ deriving instance Data (ParStmtBlock GhcRn GhcRn) deriving instance Data (ParStmtBlock GhcTc GhcTc) +-- deriving instance (DataIdLR p p) => Data (ApplicativeStmt p p)+deriving instance Data (ApplicativeStmt GhcPs GhcPs)+deriving instance Data (ApplicativeStmt GhcPs GhcRn)+deriving instance Data (ApplicativeStmt GhcPs GhcTc)+deriving instance Data (ApplicativeStmt GhcRn GhcPs)+deriving instance Data (ApplicativeStmt GhcRn GhcRn)+deriving instance Data (ApplicativeStmt GhcRn GhcTc)+deriving instance Data (ApplicativeStmt GhcTc GhcPs)+deriving instance Data (ApplicativeStmt GhcTc GhcRn)+deriving instance Data (ApplicativeStmt GhcTc GhcTc)+ -- deriving instance (DataIdLR p p) => Data (ApplicativeArg p) deriving instance Data (ApplicativeArg GhcPs) deriving instance Data (ApplicativeArg GhcRn)@@ -499,6 +510,16 @@ deriving instance (Data flag) => Data (HsTyVarBndr flag GhcRn) deriving instance (Data flag) => Data (HsTyVarBndr flag GhcTc) +-- deriving instance Data (HsBndrVar p)+deriving instance Data (HsBndrVar GhcPs)+deriving instance Data (HsBndrVar GhcRn)+deriving instance Data (HsBndrVar GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsBndrKind p)+deriving instance Data (HsBndrKind GhcPs)+deriving instance Data (HsBndrKind GhcRn)+deriving instance Data (HsBndrKind GhcTc)+ -- deriving instance (DataIdLR p p) => Data (HsType p) deriving instance Data (HsType GhcPs) deriving instance Data (HsType GhcRn)@@ -509,10 +530,13 @@ deriving instance Data (HsTyLit GhcRn) deriving instance Data (HsTyLit GhcTc) --- deriving instance (DataIdLR p p) => Data (HsArrow p)-deriving instance Data (HsArrow GhcPs)-deriving instance Data (HsArrow GhcRn)-deriving instance Data (HsArrow GhcTc)+-- deriving instance (Data mult, DataIdLR p p) => Data (HsArrowOf mult p)+deriving instance Data (HsArrowOf (LocatedA (HsType GhcPs)) GhcPs)+deriving instance Data (HsArrowOf (LocatedA (HsType GhcRn)) GhcRn)+deriving instance Data (HsArrowOf (LocatedA (HsType GhcTc)) GhcTc)+deriving instance Data (HsArrowOf (LocatedA (HsExpr GhcPs)) GhcPs)+deriving instance Data (HsArrowOf (LocatedA (HsExpr GhcRn)) GhcRn)+deriving instance Data (HsArrowOf (LocatedA (HsExpr GhcTc)) GhcTc)  -- deriving instance (DataIdLR p p) => Data (HsScaled p a) deriving instance Data thing => Data (HsScaled GhcPs thing)@@ -534,12 +558,6 @@ deriving instance Data (FieldOcc GhcRn) deriving instance Data (FieldOcc GhcTc) --- deriving instance DataId p       => Data (AmbiguousFieldOcc p)-deriving instance Data (AmbiguousFieldOcc GhcPs)-deriving instance Data (AmbiguousFieldOcc GhcRn)-deriving instance Data (AmbiguousFieldOcc GhcTc)-- -- deriving instance (DataId name) => Data (ImportDecl name) deriving instance Data (ImportDecl GhcPs) deriving instance Data (ImportDecl GhcRn)@@ -559,6 +577,9 @@  deriving instance Data HsThingRn deriving instance Data XXExprGhcRn++-- ---------------------------------------------------------------------+ deriving instance Data XXExprGhcTc deriving instance Data XXPatGhcTc
compiler/GHC/Hs/Lit.hs view
@@ -25,11 +25,14 @@  import {-# SOURCE #-} GHC.Hs.Expr( pprExpr ) +import GHC.Data.FastString (unpackFS) import GHC.Types.Basic (PprPrec(..), topPrec ) import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) import GHC.Types.SourceText import GHC.Core.Type+import GHC.Utils.Misc (split) import GHC.Utils.Outputable+import GHC.Utils.Panic (panic) import GHC.Hs.Extension import Language.Haskell.Syntax.Expr ( HsExpr ) import Language.Haskell.Syntax.Extension@@ -46,6 +49,7 @@ type instance XHsChar       (GhcPass _) = SourceText type instance XHsCharPrim   (GhcPass _) = SourceText type instance XHsString     (GhcPass _) = SourceText+type instance XHsMultilineString (GhcPass _) = SourceText type instance XHsStringPrim (GhcPass _) = SourceText type instance XHsInt        (GhcPass _) = NoExtField type instance XHsIntPrim    (GhcPass _) = SourceText@@ -132,6 +136,7 @@     go (HsChar {})        = False     go (HsCharPrim {})    = False     go (HsString {})      = False+    go (HsMultilineString {}) = False     go (HsStringPrim {})  = False     go (HsInt _ x)        = p > topPrec && il_neg x     go (HsInteger _ x _)  = p > topPrec && x < 0@@ -155,6 +160,7 @@ convertLit (HsChar a x)       = HsChar a x convertLit (HsCharPrim a x)   = HsCharPrim a x convertLit (HsString a x)     = HsString a x+convertLit (HsMultilineString a x) = HsMultilineString a x convertLit (HsStringPrim a x) = HsStringPrim a x convertLit (HsInt a x)        = HsInt a x convertLit (HsIntPrim a x)    = HsIntPrim a x@@ -192,6 +198,10 @@     ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)     ppr (HsCharPrim st c)   = pprWithSourceText st (pprPrimChar c)     ppr (HsString st s)     = pprWithSourceText st (pprHsString s)+    ppr (HsMultilineString st s) =+      case st of+        NoSourceText -> pprHsString s+        SourceText src -> vcat $ map text $ split '\n' (unpackFS src)     ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)     ppr (HsInt _ i)       = pprWithSourceText (il_text i) (integer (il_value i))@@ -231,6 +241,7 @@ pmPprHsLit (HsChar _ c)       = pprHsChar c pmPprHsLit (HsCharPrim _ c)   = pprHsChar c pmPprHsLit (HsString st s)    = pprWithSourceText st (pprHsString s)+pmPprHsLit (HsMultilineString st s) = pprWithSourceText st (pprHsString s) pmPprHsLit (HsStringPrim _ s) = pprHsBytes s pmPprHsLit (HsInt _ i)        = integer (il_value i) pmPprHsLit (HsIntPrim _ i)    = integer i@@ -248,3 +259,19 @@ pmPprHsLit (HsFloatPrim _ f)  = ppr f pmPprHsLit (HsDoublePrim _ d) = ppr d +negateOverLitVal :: OverLitVal -> OverLitVal+negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)+negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)+negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"++instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where+  compare (OverLit _ val1)  (OverLit _ val2) = val1 `compare` val2+  compare (XOverLit  val1)  (XOverLit  val2) = val1 `compare` val2+  compare _ _ = panic "Ord HsOverLit"++-- Comparison operations are needed when grouping literals+-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)+instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where+  (OverLit _ val1) == (OverLit _ val2) = val1 == val2+  (XOverLit  val1) == (XOverLit  val2) = val1 == val2+  _ == _ = panic "Eq HsOverLit"
compiler/GHC/Hs/Pat.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -37,7 +38,6 @@         HsRecUpdField, LHsRecUpdField,         RecFieldsDotDot(..),         hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,-        hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,          mkPrefixConPat, mkCharLitPat, mkNilPat, @@ -45,8 +45,10 @@         looksLazyPatBind,         isBangedLPat,         gParPat, patNeedsParens, parenthesizePat,-        isIrrefutableHsPatHelper, isIrrefutableHsPatHelperM, isBoringHsPat,+        isIrrefutableHsPat, +        isBoringHsPat,+         collectEvVarsPat, collectEvVarsPats,          pprParendLPat, pprConArgs,@@ -74,19 +76,17 @@ import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) import GHC.Builtin.Types import GHC.Types.Var-import GHC.Types.Name.Reader ( RdrName )+import GHC.Types.Name.Reader import GHC.Core.ConLike import GHC.Core.DataCon-import GHC.Core.TyCon import GHC.Utils.Outputable import GHC.Core.Type 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.Types.Name import Data.Data -import Data.Functor.Identity+import qualified Data.List.NonEmpty as NE  type instance XWildPat GhcPs = NoExtField type instance XWildPat GhcRn = NoExtField@@ -94,7 +94,7 @@  type instance XVarPat  (GhcPass _) = NoExtField -type instance XLazyPat GhcPs = [AddEpAnn] -- For '~'+type instance XLazyPat GhcPs = EpToken "~" type instance XLazyPat GhcRn = NoExtField type instance XLazyPat GhcTc = NoExtField @@ -106,11 +106,11 @@ type instance XParPat  GhcRn = NoExtField type instance XParPat  GhcTc = NoExtField -type instance XBangPat GhcPs = [AddEpAnn] -- For '!'+type instance XBangPat GhcPs = EpToken "!" type instance XBangPat GhcRn = NoExtField type instance XBangPat GhcTc = NoExtField -type instance XListPat GhcPs = AnnList+type instance XListPat GhcPs = AnnList ()   -- After parsing, ListPat can refer to a built-in Haskell list pattern   -- or an overloaded list pattern. type instance XListPat GhcRn = NoExtField@@ -120,19 +120,23 @@ type instance XListPat GhcTc = Type   -- List element type, for use in hsPatType. -type instance XTuplePat GhcPs = [AddEpAnn]+type instance XTuplePat GhcPs = (EpaLocation, EpaLocation) type instance XTuplePat GhcRn = NoExtField type instance XTuplePat GhcTc = [Type] +type instance XOrPat GhcPs = NoExtField+type instance XOrPat GhcRn = NoExtField+type instance XOrPat GhcTc = Type+ type instance XSumPat GhcPs = EpAnnSumPat type instance XSumPat GhcRn = NoExtField type instance XSumPat GhcTc = [Type] -type instance XConPat GhcPs = [AddEpAnn]+type instance XConPat GhcPs = (Maybe (EpToken "{"), Maybe (EpToken "}")) type instance XConPat GhcRn = NoExtField type instance XConPat GhcTc = ConPatTc -type instance XViewPat GhcPs = [AddEpAnn]+type instance XViewPat GhcPs = TokRarrow type instance XViewPat GhcRn = Maybe (HsExpr GhcRn)   -- The @HsExpr GhcRn@ gives an inverse to the view function.   -- This is used for overloaded lists in particular.@@ -148,15 +152,15 @@  type instance XLitPat    (GhcPass _) = NoExtField -type instance XNPat GhcPs = [AddEpAnn]-type instance XNPat GhcRn = [AddEpAnn]+type instance XNPat GhcPs = EpToken "-"+type instance XNPat GhcRn = EpToken "-" type instance XNPat GhcTc = Type -type instance XNPlusKPat GhcPs = EpaLocation -- Of the "+"+type instance XNPlusKPat GhcPs = EpToken "+" type instance XNPlusKPat GhcRn = NoExtField type instance XNPlusKPat GhcTc = Type -type instance XSigPat GhcPs = [AddEpAnn]+type instance XSigPat GhcPs = TokDcolon type instance XSigPat GhcRn = NoExtField type instance XSigPat GhcTc = Type @@ -181,10 +185,17 @@ type instance XConPatTyArg GhcRn = NoExtField type instance XConPatTyArg GhcTc = NoExtField -type instance XHsFieldBind _ = [AddEpAnn]+type instance XHsRecFields GhcPs = NoExtField+type instance XHsRecFields GhcRn = NoExtField+type instance XHsRecFields GhcTc = MultiplicityCheckCoercions -type instance XInvisPat GhcPs = EpToken "@"-type instance XInvisPat GhcRn = NoExtField+type instance XHsFieldBind _ = Maybe (EpToken "=")++-- The specificity of an invisible pattern from the parser is always+-- SpecifiedSpec. The specificity field supports code generated when deriving+-- newtype or via; see Note [Inferred invisible patterns].+type instance XInvisPat GhcPs = (EpToken "@", Specificity)+type instance XInvisPat GhcRn = Specificity type instance XInvisPat GhcTc = Type  @@ -259,13 +270,13 @@ -- API Annotations types  data EpAnnSumPat = EpAnnSumPat-      { sumPatParens      :: [AddEpAnn]-      , sumPatVbarsBefore :: [EpaLocation]-      , sumPatVbarsAfter  :: [EpaLocation]+      { sumPatParens      :: (EpaLocation, EpaLocation)+      , sumPatVbarsBefore :: [EpToken "|"]+      , sumPatVbarsAfter  :: [EpToken "|"]       } deriving Data  instance NoAnn EpAnnSumPat where-  noAnn = EpAnnSumPat [] [] []+  noAnn = EpAnnSumPat (noAnn, noAnn) [] []  -- --------------------------------------------------------------------- @@ -329,16 +340,6 @@ hsRecFieldId :: HsRecField GhcTc arg -> Id hsRecFieldId = hsRecFieldSel -hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) q -> Located RdrName-hsRecUpdFieldRdr = fmap ambiguousFieldOccRdrName . reLoc . hfbLHS--hsRecUpdFieldId :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> Located Id-hsRecUpdFieldId = fmap foExt . reLoc . hsRecUpdFieldOcc--hsRecUpdFieldOcc :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc-hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS-- {- ************************************************************************ *                                                                      *@@ -433,6 +434,7 @@       GhcTc -> dataConCantHappen ext pprPat (SigPat _ pat ty)        = ppr pat <+> dcolon <+> ppr ty pprPat (ListPat _ pats)         = brackets (interpp'SP pats)+pprPat (OrPat _ pats)           = pprWithSemis ppr (NE.toList pats) pprPat (TuplePat _ pats bx)     -- Special-case unary boxed tuples so that they are pretty-printed as     -- `MkSolo x`, not `(x)`@@ -464,7 +466,17 @@                        , cpt_binds = binds                        } = ext pprPat (EmbTyPat _ tp) = text "type" <+> ppr tp-pprPat (InvisPat _ tp) = char '@' <> ppr tp+pprPat (InvisPat x tp) = char '@' <> delimit (ppr tp)+  where+    delimit+      | inferred     = braces+      | needs_parens = parens+      | otherwise    = id+    inferred = case ghcPass @p of+      GhcPs -> snd x == InferredSpec+      GhcRn -> x == InferredSpec+      GhcTc -> False+    needs_parens = hsTypeNeedsParens appPrec $ unLoc $ hstp_body tp  pprPat (XPat ext) = case ghcPass @p of   GhcRn -> case ext of@@ -571,7 +583,7 @@ looksLazyPatBind (PatBind { pat_lhs = p })   = looksLazyLPat p looksLazyPatBind (XHsBindsLR (AbsBinds { abs_binds = binds }))-  = anyBag (looksLazyPatBind . unLoc) binds+  = any (looksLazyPatBind . unLoc) binds looksLazyPatBind _   = False @@ -612,96 +624,67 @@ See also Note [decideBangHood] in GHC.HsToCore.Utils. -} -type ConLikePIrrefutableCheck m p-  = Bool                       -- ^ Are we in a @-XStrict@ context?-                               -- See Note [-XStrict and irrefutability]-    -> XRec p (ConLikeP p)     -- ^ ConLikeThing-    -> HsConPatDetails p       -- ^ ConPattern details-    -> m Bool                  -- ^ is it Irrefutable?--type LPatIrrefutableCheck m p-  = Bool                              -- ^ Are we in a @-XStrict@ context?-                                      -- See Note [-XStrict and irrefutability]-    -> ConLikePIrrefutableCheck m p   -- How should I check ConLikeP things-    -> LPat p                         -- The LPat thing-    -> m Bool                         -- Is it irrefutable?---- | (isIrrefutableHsPat p) is true if matching against p cannot fail+-- | @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.+-- If isIrrefutableHsPat returns 'True', the pattern is definitely irrefutable. ----- But if it returns True, the pattern is definitely irrefutable--- Instantiates `isIrrefutableHsPatHelperM` with a trivial identity monad-isIrrefutableHsPatHelper :: forall p. (OutputableBndrId p)-                         => Bool -- ^ Are we in a @-XStrict@ context?-                                 -- See Note [-XStrict and irrefutability]-                         -> LPat (GhcPass p) -> Bool-isIrrefutableHsPatHelper is_strict pat = runIdentity $ doWork is_strict pat-  where-  doWork :: forall p. (OutputableBndrId p) => Bool -> LPat (GhcPass p) -> Identity Bool-  doWork is_strict = isIrrefutableHsPatHelperM is_strict isConLikeIrr--  isConLikeIrr :: forall p. (OutputableBndrId p) => ConLikePIrrefutableCheck Identity (GhcPass p)-  isConLikeIrr is_strict con details-    = case ghcPass @p of-        GhcPs -> return False                   -- Conservative-        GhcRn -> return False                   -- Conservative-        GhcTc -> case con of-          L _ (PatSynCon _pat)  -> return False -- Conservative-          L _ (RealDataCon con) ->-            do let b = isJust (tyConSingleDataCon_maybe (dataConTyCon con))-               bs <- mapM (doWork is_strict) (hsConPatArgs details)-               return $ b && and bs----- This function abstracts 2 things--- 1. How to compute irrefutability for a `ConLikeP` thing--- 2. The wrapper monad-isIrrefutableHsPatHelperM :: forall m p. (Monad m, OutputableBndrId p)-                          => LPatIrrefutableCheck m (GhcPass p)-isIrrefutableHsPatHelperM is_strict isConLikeIrr pat = go (unLoc pat)+-- However, isIrrefutableHsPat returns 'False' if it's in doubt. It's a+-- best effort guess with the information we have available:+--+--  - we sometimes call 'isIrrefutableHsPat' from the renamer, in which case+--    we don't have type information to hand. This means we can't properly+--    handle GADTs, nor the result TyCon of COMPLETE pragmas.+--  - even when calling 'isIrrefutableHsPat' in the typechecker, we don't keep+--    track of any long distance information like the pattern-match checker does.+isIrrefutableHsPat+  :: forall p+  .  IsPass p+  => Bool                           -- ^ Are we in a @-XStrict@ context?+                                    -- See Note [-XStrict and irrefutability]+  -> (ConLikeP (GhcPass p) -> Bool) -- ^ How to check whether the 'ConLike' in a+                                    -- 'ConPat' pattern is irrefutable+  -> LPat (GhcPass p)               -- ^ The (located) pattern to check+  -> Bool                           -- Is it irrefutable?+isIrrefutableHsPat is_strict irref_conLike pat = go (unLoc pat)   where-    goL = isIrrefutableHsPatHelperM is_strict isConLikeIrr+    goL (L _ p) = go p -    go :: Pat (GhcPass p) -> m Bool-    go (WildPat {})        = return True-    go (VarPat {})         = return True+    go :: Pat (GhcPass p) -> Bool+    go (WildPat {})        = True+    go (VarPat {})         = True     go (LazyPat _ p')       | is_strict-      = isIrrefutableHsPatHelperM False isConLikeIrr p'-      | otherwise          = return True+      = isIrrefutableHsPat False irref_conLike p'+      | otherwise          = True     go (BangPat _ pat)     = goL pat     go (ParPat _ pat)      = goL pat     go (AsPat _ _ pat)     = goL pat     go (ViewPat _ _ pat)   = goL pat     go (SigPat _ pat _)    = goL pat-    go (TuplePat _ pats _) = do { bs <- mapM goL pats; return $ and bs }-    go (SumPat {})         = return False-                    -- See Note [Unboxed sum patterns aren't irrefutable]-    go (ListPat {})        = return False+    go (TuplePat _ pats _) = all goL pats+    go (OrPat _ pats)      = any goL pats -- This is simplistic; see Note [Irrefutable or-patterns]+    go (SumPat {})         = False -- See Note [Unboxed sum patterns aren't irrefutable]+    go (ListPat {})        = False -    go (ConPat-        { pat_con  = con-        , pat_args = details }) = isConLikeIrr is_strict con details-    go (LitPat {})         = return False-    go (NPat {})           = return False-    go (NPlusKPat {})      = return False+    -- See Note [Irrefutability of ConPat]+    go (ConPat { pat_con = L _ con, pat_args = details })+                           =  irref_conLike con+                           && all goL (hsConPatArgs details)+    go (LitPat {})         = False+    go (NPat {})           = False+    go (NPlusKPat {})      = False      -- We conservatively assume that no TH splices are irrefutable     -- since we cannot know until the splice is evaluated.-    go (SplicePat {})      = return False+    go (SplicePat {})      = False      -- The behavior of this case is unimportant, as GHC will throw an error shortly     -- after reaching this case for other reasons (see TcRnIllegalTypePattern).-    go (EmbTyPat {})       = return True-    go (InvisPat {})       = return True+    go (EmbTyPat {})       = True+    go (InvisPat {})       = True      go (XPat ext)          = case ghcPass @p of       GhcRn -> case ext of@@ -764,6 +747,7 @@               -- A pattern match on a GADT constructor can introduce               -- type-level information (for example, T18572).               -> False+      OrPat _ pats  -> all goL pats       LitPat {}     -> True       NPat {}       -> True       NPlusKPat {}  -> True@@ -782,8 +766,93 @@ isPatSyn (L _ (ConPat {pat_con = L _ (PatSynCon{})})) = True isPatSyn _ = False -{- Note [Unboxed sum patterns aren't irrefutable]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+{- Note [Irrefutability of ConPat]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A constructor pattern `ConPat { pat_con, pat_args }` is irrefutable under two+conditions:++  Irref-ConLike: the constructor, pat_con, is itself irrefutable.+  Irref-args   : all of the argument patterns, pat_args, are irrefutable.++The (Irref-ConLike) condition can be stated as follows:++  Irref-DataCon: a DataCon is irrefutable iff it is the only constructor of its+                 parent type constructor.+  Irref-PatSyn:  a PatSyn is irrefutable iff there is a COMPLETE pragma+                 containing this PatSyn as its sole member.++To understand this, let's consider some simple examples:++  data A = MkA Int Bool+  data BC = B Int | C++  pattern P :: Maybe Int -> BC+  pattern P mb_i <- ( ( \ case { B i -> Just i; C -> Nothing } ) -> mb_i )+  {-# COMPLETE P #-}++In this case:++  - the pattern 'A p1 p2' (for patterns 'p1 :: Int', 'p2 :: Bool') is irrefutable+    precisely when both 'p1' and 'p2' are irrefutable (this is the same as+    irrefutability of tuple patterns);+  - neither of the patterns 'B p' (for any pattern 'p :: Int') or 'C' are irrefutable,+    because the parent type constructor 'BC' contains more than one data constructor,+  - the pattern 'P q', for a pattern 'q :: Maybe Int', is irrefutable precisely+    when 'q' is irrefutable, due to the COMPLETE pragma on 'P'.++Wrinkle [Irrefutability and COMPLETE pragma result TyCons]++  There is one subtlety in the Irref-PatSyn condition: COMPLETE pragmas may+  optionally specify a result TyCon, as explained in Note [Implementation of COMPLETE pragmas]+  in GHC.HsToCore.Pmc.Solver.++  So, for a COMPLETE pragma with a result TyCon, we would need to compute+  'completeMatchAppliesAtType' to ensure that the COMPLETE pragma is indeed+  applicable. Doing so is not so straightforward in 'isIrrefutableHsPat', for+  a couple of reasons:++    1. 'isIrrefutableHsPat' is called from within the renamer, which means+       we don't have the appropriate 'Type' to hand,+    2. Even when 'isIrrefutableHsPat' is called from within the typechecker,+       computing 'completeMatchAppliesAtType' for a 'ConPat' which might be+       nested deep inside the top-level call, such as++          ( ( _ , P (x :: Int) ) :: ( Int, Int )++        would require keeping track of types as we recur in 'isIrrefutableHsPat',+        which would be much more involved and require duplicating code from+        the pattern match checker (it performs this check using the notion+        of "match variables", which we don't have in the typechecker).++Note [Irrefutable or-patterns]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When is an or-pattern ( p_1 ; ... ; p_n ) irrefutable? It certainly suffices+that individual pattern p_i is irrefutable, but it isn't necessary.++For example, with the datatype definition++  data ABC = A | B | C++the or-pattern ( B ; C ; A ) is irrefutable. Similarly, one can take into+account COMPLETE pragmas, e.g. (P ; R ; Q) is irrefutable in the presence of+{-# COMPLETE P, Q, R #-}. This would extend Note [Irrefutability of ConPat] to+the case of disjunctions of constructor patterns.++For now, the function 'isIrrefutableHsPat' does not take into account these+additional complications, and considers an or-pattern irrefutable precisely when+any of the summands are irrefutable. This pessimistic behaviour is OK: the contract+of 'isIrrefutableHsPat' is that it can only return 'True' for definitely irrefutable+patterns, but may conservatively return 'False' in other cases.++The justification for this design choice is as follows:++  1. Producing the correct answer in all cases would be rather difficult,+     for example for a complex pattern such as ( P ; !( R ; S ; ( Q :: Ty ) ) ).+  2. Irrefutable or-patterns aren't particularly common or useful, given that+     (currently) or-patterns aren't allowed to bind variables.++Note [Unboxed sum patterns aren't irrefutable]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as patterns. A simple example that demonstrates this is from #14228: @@ -854,8 +923,130 @@ incomplete pattern-match, as incompleteness inside do-notation is handled using MonadFail. However, we still want to propagate the fact that x is headed by the 'Just' constructor, to avoid a pattern-match warning on the last line.++Note [Implementation of OrPatterns]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This Note describes the implementation of the extension -XOrPatterns.++* Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0522-or-patterns.rst+* Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/522 and others++Parser+------+We parse an or-pattern `pat_1; ...; pat_k` into `OrPat [pat_1, ..., pat_k]`,+where `OrPat` is a constructor of `Pat` in Language.Haskell.Syntax.Pat.+We occasionally refer to any of the `pat_k` as "pattern alternatives" below.+The changes to the parser are as outlined in Section 8.1 of the proposal.+The main productions are++  orpats -> exp | exp ';' orpats+  aexp2 -> '(' orpats ')'+  pat -> orpats++Renamer and typechecker+-----------------------+The typing rule for or-patterns in terms of pattern types is++                   Γ0, Σ0 ⊢ pat_i : τ ⤳ Γ0,Σi,Ψi+            --------------------------------------------+            Γ0, Σ0 ⊢ ( pat_1; ...; pat_n ) : τ ⤳ Γ0,Σ0,∅++(See the proposal for what a pattern type `Γ, Σ ⊢ pat : τ ⤳ Γ,Σ,Ψ` is.)+The main points++  * None of the patterns may bind any variables, hence the same Γ0 in both input+    and output.+  * Any Given constraints bound by the pattern are discarded: the rule discards+    the Σi returned by each pattern.+  * Similarly any existentials Ψi bound by the pattern are discarded.++In GHC.Rename.Pat.rnPatAndThen, we reject visible term and type binders (i.e.+concerning Γ0).++Regarding the Givens Σi and existenials Ψi (i.e. invisible type binders)+introduced by the pattern alternatives `pat_i`, we discard them in+GHC.Tc.Gen.Pats.tc_pat in a manner similar to LazyPats;+see Note [Hopping the LIE in lazy patterns].++Why is it useful to allow Σi and Ψi only to discard them immediately after?+Consider++  data T a where MkT :: forall a x. Num a => x -> T a+  foo :: T a -> a+  foo (MkT{}; MkT{}) = 3++We do want to allow matching on MkT{} in or-patterns, despite them invisibly+binding an existential type variable `x` and a new Given constraint `Num a`.+Clearly, `x` must be dead in the RHS of foo, because there is no field binder+that brings it to life, so no harm done.+But we must be careful not to solve the `Num a` Wanted constraint in the RHS of+foo with the Given constraint from the pattern alternatives, hence we are+Hopping the LIE.++Desugarer+---------+The desugaring of or-patterns is complicated by the fact that we have to avoid+exponential code blowup. Consider+  f (LT; GT) (EQ; GT) = rhs1+  f _        _        = rhs2+The naïve desugaring of or-patterns would explode every or-pattern, thus+  f LT EQ = rhs1+  f LT GT = rhs1+  f GT EQ = rhs1+  f GT GT = rhs1+  f _  _  = rhs2+which leads to an exponential number of copies of `rhs1`.+Our current strategy, implemented in GHC.HsToCore.Match.tidy1, is to+desugar to LambdaCase and ViewPatterns,+  f ((\case LT -> True; GT -> True; _ -> False) -> True)+    ((\case EQ -> True; GT -> True; _ -> False) -> True)+    = rhs1+  f _ _ = rhs2+The existing code for ViewPatterns makes sure that we do not duplicate `rhs1`+and the Simplifier will take care to turn this into efficient code.++Pattern-match checker+---------------------+The changes to the pattern-match checker are described in detail in Section 4.9+of the 2024 revision of the "Lower Your Guards" paper.+What follows is a brief summary of that change.++The pattern-match checker desugars patterns as well, into syntactic variants of+*guard trees* such as `PmMatch`, describing a single Match `f ps | grhss`.+It used to be that each such guard trees nicely captured the effects of pattern+matching `ps` in a conjunctive list of `PmGrd`s, each of which refines+the set of Nablas that reach the RHS of the clause.+`PmGrd` is the heart of the Lower Your Guards approach: it is compositional,+simple, and *non-recursive*, unlike or-patterns!+Conjunction is implemented with the `...Pmc.Check.leftToRight` combinator.+But to desugar or-patterns, we need to compose with `Pmc.Check.topToBottom`+to model first match semantics!+This was previously impossible in the pattern fragment, and indeed is+incompatible with the simple "list of `PmGrd`s" desugaring of patterns.++So our solution is to generalise "sequence of `PmGrd`" into a series-parallel+graph `GrdDag`, a special kind of DAG, where "series" corresponds to+left-to-right sequence and "parallel" corresponds to top-to-bottom or-pattern+alternatives. Example++  f (LT; GT) True (EQ; GT) = rhs++desugars to++   /- LT <- x -\             /- EQ <- z -\+  .             . True <- y .             .-> rhs+   \- GT <- x ./             \- GT <- z -/++Branching is GdAlt and models first-match semantics of or-patterns, and+sequencing is GdSeq.++We must take care of exponential explosion of Covered sets for long matches like+  g (LT; GT) (LT; GT) ... True = 1+Fortunately, we can build on our existing throttling mechanism;+see Note [Countering exponential blowup] in GHC.HsToCore.Pmc.Check. -} + -- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs -- parentheses under precedence @p@. patNeedsParens :: forall p. IsPass p => PprPrec -> Pat (GhcPass p) -> Bool@@ -865,6 +1056,7 @@     -- at a different GhcPass (see the case for GhcTc XPat below).     go :: forall q. IsPass q => Pat (GhcPass q) -> Bool     go (NPlusKPat {})    = p > opPrec+    go (OrPat {})        = p > topPrec     go (SplicePat {})    = False     go (ConPat { pat_args = ds })                          = conPatNeedsParens p ds@@ -947,6 +1139,7 @@     BangPat _ p      -> collectEvVarsLPat p     ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps     TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps+    OrPat _ ps       -> unionManyBags $ map collectEvVarsLPat (NE.toList ps)     SumPat _ p _ _   -> collectEvVarsLPat p     ConPat       { pat_args  = args
+ compiler/GHC/Hs/Specificity.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -Wno-orphans #-}+module GHC.Hs.Specificity where++import Prelude+import Control.DeepSeq (NFData(..))++import GHC.Utils.Outputable+import GHC.Utils.Binary++import Language.Haskell.Syntax.Specificity++{- *********************************************************************+*                                                                      *+*                   ForAllTyFlag+*                                                                      *+********************************************************************* -}++instance Outputable ForAllTyFlag where+  ppr Required  = text "[req]"+  ppr Specified = text "[spec]"+  ppr Inferred  = text "[infrd]"++instance Binary Specificity where+  put_ bh SpecifiedSpec = putByte bh 0+  put_ bh InferredSpec  = putByte bh 1++  get bh = do+    h <- getByte bh+    case h of+      0 -> return SpecifiedSpec+      _ -> return InferredSpec++instance Binary ForAllTyFlag where+  put_ bh Required  = putByte bh 0+  put_ bh Specified = putByte bh 1+  put_ bh Inferred  = putByte bh 2++  get bh = do+    h <- getByte bh+    case h of+      0 -> return Required+      1 -> return Specified+      _ -> return Inferred++instance NFData Specificity where+  rnf SpecifiedSpec = ()+  rnf InferredSpec = ()+instance NFData ForAllTyFlag where+  rnf (Invisible spec) = rnf spec+  rnf Required = ()++
compiler/GHC/Hs/Type.hs view
@@ -25,13 +25,16 @@ module GHC.Hs.Type (         Mult, HsScaled(..),         hsMult, hsScaledThing,-        HsArrow(..), arrowToHsType,+        HsArrow, HsArrowOf(..), arrowToHsType, expandHsArrow,         EpLinearArrow(..),         hsLinear, hsUnrestricted, isUnrestricted,         pprHsArrow,          HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,-        HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,+        HsForAllTelescope(..), EpAnnForallVis, EpAnnForallInvis,+        HsTyVarBndr(..), LHsTyVarBndr, AnnTyVarBndr(..),+        HsBndrKind(..),+        HsBndrVar(..),         HsBndrVis(..), isHsBndrInvisible,         LHsQTyVars(..),         HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,@@ -56,12 +59,8 @@         ConDeclField(..), LConDeclField, pprConDeclFields,          HsConDetails(..), noTypeArgs,-         FieldOcc(..), LFieldOcc, mkFieldOcc,-        AmbiguousFieldOcc(..), LAmbiguousFieldOcc, mkAmbiguousFieldOcc,-        ambiguousFieldOccRdrName, ambiguousFieldOccLRdrName,-        selectorAmbiguousFieldOcc,-        unambiguousFieldOcc, ambiguousFieldOcc,+        fieldOccRdrName, fieldOccLRdrName,          OpName(..), @@ -74,9 +73,10 @@         mkEmptyWildCardBndrs,         mkHsForAllVisTele, mkHsForAllInvisTele,         mkHsQTvs, hsQTvExplicit, emptyLHsQTvs,-        isHsKindedTyVar, hsTvbAllKinded,+        isHsKindedTyVar, hsBndrVar, hsBndrKind, hsTvbAllKinded,         hsScopedTvs, hsScopedKvs, hsWcScopedTvs, dropWildCards,-        hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,+        hsTyVarLName, hsTyVarName,+        hsAllLTyVarNames, hsLTyVarLocNames,         hsLTyVarName, hsLTyVarNames, hsForAllTelescopeNames,         hsLTyVarLocName, hsExplicitLTyVarNames,         splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,@@ -103,12 +103,14 @@ import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) )  import Language.Haskell.Syntax.Extension-import GHC.Core.DataCon( SrcStrictness(..), SrcUnpackedness(..), HsImplBang(..) )+import GHC.Core.DataCon ( SrcStrictness(..), SrcUnpackedness(..)+                        , HsSrcBang(..), HsImplBang(..)+                        , mkHsSrcBang+                        ) import GHC.Hs.Extension import GHC.Parser.Annotation  import GHC.Types.Fixity ( LexicalFixity(..) )-import GHC.Types.Id ( Id ) import GHC.Types.SourceText import GHC.Types.Name import GHC.Types.Name.Reader ( RdrName )@@ -146,9 +148,9 @@ getBangType lty                                            = lty  getBangStrictness :: LHsType (GhcPass p) -> HsSrcBang-getBangStrictness                 (L _ (HsBangTy _ s _))     = s-getBangStrictness (L _ (HsDocTy _ (L _ (HsBangTy _ s _)) _)) = s-getBangStrictness _ = (HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)+getBangStrictness                 (L _ (HsBangTy (_, s) b _))     = HsSrcBang s b+getBangStrictness (L _ (HsDocTy _ (L _ (HsBangTy (_, s) b _)) _)) = HsSrcBang s b+getBangStrictness _ = (mkHsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)  {- ************************************************************************@@ -161,16 +163,15 @@ fromMaybeContext :: Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p) fromMaybeContext mctxt = unLoc $ fromMaybe (noLocA []) mctxt -type instance XHsForAllVis   (GhcPass _) = EpAnnForallTy+type instance XHsForAllVis   (GhcPass _) = EpAnn (TokForall, TokRarrow)                                            -- Location of 'forall' and '->'-type instance XHsForAllInvis (GhcPass _) = EpAnnForallTy+type instance XHsForAllInvis (GhcPass _) = EpAnn (TokForall, EpToken ".")                                            -- Location of 'forall' and '.'  type instance XXHsForAllTelescope (GhcPass _) = DataConCantHappen -type EpAnnForallTy = EpAnn (AddEpAnn, AddEpAnn)-  -- ^ Location of 'forall' and '->' for HsForAllVis-  -- Location of 'forall' and '.' for HsForAllInvis+type EpAnnForallVis   = EpAnn (TokForall, TokRarrow)+type EpAnnForallInvis = EpAnn (TokForall, EpToken ".")  type HsQTvsRn = [Name]  -- Implicit variables   -- For example, in   data T (a :: k1 -> k2) = ...@@ -182,12 +183,12 @@  type instance XXLHsQTyVars  (GhcPass _) = DataConCantHappen -mkHsForAllVisTele ::EpAnnForallTy ->+mkHsForAllVisTele ::EpAnnForallVis ->   [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p) mkHsForAllVisTele an vis_bndrs =   HsForAllVis { hsf_xvis = an, hsf_vis_bndrs = vis_bndrs } -mkHsForAllInvisTele :: EpAnnForallTy+mkHsForAllInvisTele :: EpAnnForallInvis   -> [LHsTyVarBndr Specificity (GhcPass p)] -> HsForAllTelescope (GhcPass p) mkHsForAllInvisTele an invis_bndrs =   HsForAllInvis { hsf_xinvis = an, hsf_invis_bndrs = invis_bndrs }@@ -205,7 +206,7 @@ type instance XHsOuterImplicit GhcRn = [Name] type instance XHsOuterImplicit GhcTc = [TyVar] -type instance XHsOuterExplicit GhcPs _    = EpAnnForallTy+type instance XHsOuterExplicit GhcPs _    = EpAnnForallInvis type instance XHsOuterExplicit GhcRn _    = NoExtField type instance XHsOuterExplicit GhcTc flag = [VarBndr TyVar flag] @@ -317,7 +318,7 @@ mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs mkHsOuterImplicit = HsOuterImplicit{hso_ximplicit = noExtField} -mkHsOuterExplicit :: EpAnnForallTy -> [LHsTyVarBndr flag GhcPs]+mkHsOuterExplicit :: EpAnnForallInvis -> [LHsTyVarBndr flag GhcPs]                   -> HsOuterTyVarBndrs flag GhcPs mkHsOuterExplicit an bndrs = HsOuterExplicit { hso_xexplicit = an                                              , hso_bndrs     = bndrs }@@ -327,7 +328,7 @@   HsSig { sig_ext   = noExtField         , sig_bndrs = mkHsOuterImplicit, sig_body = body } -mkHsExplicitSigType :: EpAnnForallTy+mkHsExplicitSigType :: EpAnnForallInvis                     -> [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs                     -> HsSigType GhcPs mkHsExplicitSigType an bndrs body =@@ -352,40 +353,62 @@  -------------------------------------------------- -type instance XUserTyVar    (GhcPass _) = [AddEpAnn]-type instance XKindedTyVar  (GhcPass _) = [AddEpAnn]-+type instance XTyVarBndr    (GhcPass _) = AnnTyVarBndr type instance XXTyVarBndr   (GhcPass _) = DataConCantHappen +type instance XBndrKind   (GhcPass p) = NoExtField+type instance XBndrNoKind (GhcPass p) = NoExtField+type instance XXBndrKind  (GhcPass p) = DataConCantHappen++type instance XBndrVar (GhcPass p) = NoExtField++type instance XBndrWildCard GhcPs = EpToken "_"+type instance XBndrWildCard GhcRn = NoExtField+type instance XBndrWildCard GhcTc = NoExtField++type instance XXBndrVar (GhcPass p) = DataConCantHappen++data AnnTyVarBndr+  = AnnTyVarBndr {+    atv_opens  :: [EpaLocation], -- all "(" or all "{"+    atv_closes :: [EpaLocation], -- all ")" or all "}"+    atv_tv     :: EpToken "'",+    atv_dcolon :: TokDcolon+  } deriving Data++instance NoAnn AnnTyVarBndr where+  noAnn = AnnTyVarBndr noAnn noAnn noAnn noAnn+ -- | Return the attached flag hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag-hsTyVarBndrFlag (UserTyVar _ fl _)     = fl-hsTyVarBndrFlag (KindedTyVar _ fl _ _) = fl+hsTyVarBndrFlag = tvb_flag -- By specialising to (GhcPass p) we know that XXTyVarBndr is DataConCantHappen--- so these two equations are exhaustive: extension construction can't happen+-- so the equation is exhaustive: extension construction can't happen  -- | Set the attached flag setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)   -> HsTyVarBndr flag (GhcPass pass)-setHsTyVarBndrFlag f (UserTyVar x _ l)     = UserTyVar x f l-setHsTyVarBndrFlag f (KindedTyVar x _ l k) = KindedTyVar x f l k+setHsTyVarBndrFlag fl tvb = tvb { tvb_flag = fl }  -- | 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+updateHsTyVarBndrFlag f tvb = tvb { tvb_flag = f (tvb_flag tvb) } +-- | Get the variable of the type variable binder+hsBndrVar :: HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)+hsBndrVar = tvb_var++-- | Get the kind of the type variable binder+hsBndrKind :: HsTyVarBndr flag (GhcPass pass) -> HsBndrKind (GhcPass pass)+hsBndrKind = tvb_kind+ -- | Do all type variables in this 'LHsQTyVars' come with kind annotations? hsTvbAllKinded :: LHsQTyVars (GhcPass p) -> Bool hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit -instance NamedThing (HsTyVarBndr flag GhcRn) where-  getName (UserTyVar _ _ v) = unLoc v-  getName (KindedTyVar _ _ v _) = unLoc v- type instance XBndrRequired (GhcPass _) = NoExtField  type instance XBndrInvisible GhcPs = EpToken "@"@@ -394,19 +417,54 @@  type instance XXBndrVis (GhcPass _) = DataConCantHappen +{- Note [Wildcard binders in disallowed contexts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In contexts where a type variable binder is expected (HsTyVarBndr), we usually+allow both named binders and wildcards, e.g.++  type Const1 a b = a     -- ok+  type Const2 a _ = a     -- ok, too++This applies to LHSs of data, newtype, type, class, type family and data family+declarations. However, we choose to reject wildcards in forall telescopes and+type family result variables (the latter being part of TypeFamilyDependencies):++  type family Fd a = _    -- disallowed  (WildcardBndrInTyFamResultVar)+  fn :: forall _. Int     -- disallowed  (WildcardBndrInForallTelescope)++This restriction is placed solely because such binders have not been proposed+and there is no known use case for them. If we see user demand for wildcard+binders in these contexts, adding support for them would be as easy as dropping+the checks that reject them. The rest of the compiler can handle all wildcard+binders regardless of context by generating a fresh name (see `tcHsBndrVarName`+in GHC.Tc.Gen.HsType and `repHsBndrVar` in GHC.HsToCore.Quote).++That is, in type declarations we have:++  type F _  = ...  -- equivalent to ...+  type F _a = ...  -- where _a is fresh++and the same principle could be applied to foralls:++  fn :: forall _.  Int   -- equivalent to ...+  fn :: forall _a. Int   -- where _a is fresh++except the `forall _.` example is rejected by checkForAllTelescopeWildcardBndrs.+-}+ type instance XForAllTy        (GhcPass _) = NoExtField type instance XQualTy          (GhcPass _) = NoExtField-type instance XTyVar           (GhcPass _) = [AddEpAnn]+type instance XTyVar           (GhcPass _) = EpToken "'" type instance XAppTy           (GhcPass _) = NoExtField type instance XFunTy           (GhcPass _) = NoExtField type instance XListTy          (GhcPass _) = AnnParen type instance XTupleTy         (GhcPass _) = AnnParen type instance XSumTy           (GhcPass _) = AnnParen-type instance XOpTy            (GhcPass _) = [AddEpAnn]-type instance XParTy           (GhcPass _) = AnnParen-type instance XIParamTy        (GhcPass _) = [AddEpAnn]+type instance XOpTy            (GhcPass _) = NoExtField+type instance XParTy           (GhcPass _) = (EpToken "(", EpToken ")")+type instance XIParamTy        (GhcPass _) = TokDcolon type instance XStarTy          (GhcPass _) = NoExtField-type instance XKindSig         (GhcPass _) = [AddEpAnn]+type instance XKindSig         (GhcPass _) = TokDcolon  type instance XAppKindTy       GhcPs = EpToken "@" type instance XAppKindTy       GhcRn = NoExtField@@ -416,24 +474,26 @@ type instance XSpliceTy        GhcRn = HsUntypedSpliceResult (LHsType GhcRn) type instance XSpliceTy        GhcTc = Kind -type instance XDocTy           (GhcPass _) = [AddEpAnn]-type instance XBangTy          (GhcPass _) = [AddEpAnn]+type instance XDocTy           (GhcPass _) = NoExtField+type instance XBangTy          (GhcPass _) = ((EpaLocation, EpToken "#-}", EpaLocation), SourceText) -type instance XRecTy           GhcPs = AnnList+type instance XRecTy           GhcPs = AnnList () type instance XRecTy           GhcRn = NoExtField type instance XRecTy           GhcTc = NoExtField -type instance XExplicitListTy  GhcPs = [AddEpAnn]+type instance XExplicitListTy  GhcPs = (EpToken "'", EpToken "[", EpToken "]") type instance XExplicitListTy  GhcRn = NoExtField type instance XExplicitListTy  GhcTc = Kind -type instance XExplicitTupleTy GhcPs = [AddEpAnn]+type instance XExplicitTupleTy GhcPs = (EpToken "'", EpToken "(", EpToken ")") type instance XExplicitTupleTy GhcRn = NoExtField type instance XExplicitTupleTy GhcTc = [Kind]  type instance XTyLit           (GhcPass _) = NoExtField -type instance XWildCardTy      (GhcPass _) = NoExtField+type instance XWildCardTy      GhcPs = EpToken "_"+type instance XWildCardTy      GhcRn = NoExtField+type instance XWildCardTy      GhcTc = NoExtField  type instance XXType         (GhcPass _) = HsCoreTy @@ -451,32 +511,26 @@ type instance XXTyLit        (GhcPass _) = DataConCantHappen  data EpLinearArrow-  = EpPct1 !(EpToken "%1") !(EpUniToken "->" "→")+  = EpPct1 !(EpToken "%1") !(TokRarrow)   | EpLolly !(EpToken "⊸")   deriving Data  instance NoAnn EpLinearArrow where   noAnn = EpPct1 noAnn noAnn -type instance XUnrestrictedArrow GhcPs = EpUniToken "->" "→"-type instance XUnrestrictedArrow GhcRn = NoExtField-type instance XUnrestrictedArrow GhcTc = NoExtField--type instance XLinearArrow       GhcPs = EpLinearArrow-type instance XLinearArrow       GhcRn = NoExtField-type instance XLinearArrow       GhcTc = NoExtField--type instance XExplicitMult      GhcPs = (EpToken "%", EpUniToken "->" "→")-type instance XExplicitMult      GhcRn = NoExtField-type instance XExplicitMult      GhcTc = NoExtField+type instance XUnrestrictedArrow _ GhcPs = TokRarrow+type instance XUnrestrictedArrow _ GhcRn = NoExtField+type instance XUnrestrictedArrow _ GhcTc = NoExtField -type instance XXArrow            (GhcPass _) = DataConCantHappen+type instance XLinearArrow       _ GhcPs = EpLinearArrow+type instance XLinearArrow       _ GhcRn = NoExtField+type instance XLinearArrow       _ GhcTc = NoExtField -oneDataConHsTy :: HsType GhcRn-oneDataConHsTy = HsTyVar noAnn NotPromoted (noLocA oneDataConName)+type instance XExplicitMult      _ GhcPs = (EpToken "%", TokRarrow)+type instance XExplicitMult      _ GhcRn = NoExtField+type instance XExplicitMult      _ GhcTc = NoExtField -manyDataConHsTy :: HsType GhcRn-manyDataConHsTy = HsTyVar noAnn NotPromoted (noLocA manyDataConName)+type instance XXArrow            _ (GhcPass _) = DataConCantHappen  hsLinear :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a hsLinear = HsScaled (HsLinearArrow x)@@ -498,26 +552,29 @@ isUnrestricted (arrowToHsType -> L _ (HsTyVar _ _ (L _ n))) = n == manyDataConName isUnrestricted _ = False +arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn+arrowToHsType = expandHsArrow (HsTyVar noAnn NotPromoted)+ -- | Convert an arrow into its corresponding multiplicity. In essence this -- erases the information of whether the programmer wrote an explicit -- multiplicity or a shorthand.-arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn-arrowToHsType (HsUnrestrictedArrow _) = noLocA manyDataConHsTy-arrowToHsType (HsLinearArrow _) = noLocA oneDataConHsTy-arrowToHsType (HsExplicitMult _ p) = p+expandHsArrow :: (LocatedN Name -> t GhcRn) -> HsArrowOf (LocatedA (t GhcRn)) GhcRn -> LocatedA (t GhcRn)+expandHsArrow mk_var (HsUnrestrictedArrow _) = noLocA (mk_var (noLocA manyDataConName))+expandHsArrow mk_var (HsLinearArrow _) = noLocA (mk_var (noLocA oneDataConName))+expandHsArrow _mk_var (HsExplicitMult _ p) = p  instance-      (OutputableBndrId pass) =>-      Outputable (HsArrow (GhcPass pass)) where+      (Outputable mult, OutputableBndrId pass) =>+      Outputable (HsArrowOf mult (GhcPass pass)) where   ppr arr = parens (pprHsArrow arr)  -- See #18846-pprHsArrow :: (OutputableBndrId pass) => HsArrow (GhcPass pass) -> SDoc+pprHsArrow :: (Outputable mult, OutputableBndrId pass) => HsArrowOf mult (GhcPass pass) -> SDoc pprHsArrow (HsUnrestrictedArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left False) pprHsArrow (HsLinearArrow _)       = pprArrowWithMultiplicity visArgTypeLike (Left True) pprHsArrow (HsExplicitMult _ p)    = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p)) -type instance XConDeclField  (GhcPass _) = [AddEpAnn]+type instance XConDeclField  (GhcPass _) = TokDcolon type instance XXConDeclField (GhcPass _) = DataConCantHappen  instance OutputableBndrId p@@ -551,18 +608,20 @@ hsScopedKvs _ = []  ----------------------hsTyVarLName :: HsTyVarBndr flag (GhcPass p) -> LIdP (GhcPass p)-hsTyVarLName (UserTyVar _ _ n)     = n-hsTyVarLName (KindedTyVar _ _ n _) = n+hsTyVarLName :: HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))+hsTyVarLName tvb =+  case hsBndrVar tvb of+    HsBndrVar      _ n -> Just n+    HsBndrWildCard _   -> Nothing -hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)-hsTyVarName = unLoc . hsTyVarLName+hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))+hsTyVarName = fmap unLoc . hsTyVarLName -hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)+hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p)) hsLTyVarName = hsTyVarName . unLoc  hsLTyVarNames :: [LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]-hsLTyVarNames = map hsLTyVarName+hsLTyVarNames = mapMaybe hsLTyVarName  hsForAllTelescopeNames :: HsForAllTelescope (GhcPass p) -> [IdP (GhcPass p)] hsForAllTelescopeNames (HsForAllVis _ bndrs) = hsLTyVarNames bndrs@@ -570,7 +629,7 @@  hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)] -- Explicit variables only-hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)+hsExplicitLTyVarNames qtvs = hsLTyVarNames (hsQTvExplicit qtvs)  hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name] -- All variables@@ -579,12 +638,12 @@   = kvs ++ hsLTyVarNames tvs  hsLTyVarLocName :: Anno (IdGhcP p) ~ SrcSpanAnnN-                => LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))+                => LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p))) hsLTyVarLocName (L _ a) = hsTyVarLName a  hsLTyVarLocNames :: Anno (IdGhcP p) ~ SrcSpanAnnN                  => LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]-hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)+hsLTyVarLocNames qtvs = mapMaybe hsLTyVarLocName (hsQTvExplicit qtvs)  -- | Get the kind signature of a type, ignoring parentheses: --@@ -617,14 +676,14 @@ ************************************************************************ -} -mkAnonWildCardTy :: HsType GhcPs-mkAnonWildCardTy = HsWildCardTy noExtField+mkAnonWildCardTy :: EpToken "_" -> HsType GhcPs+mkAnonWildCardTy tok = HsWildCardTy tok  mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)          => PromotionFlag          -> LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))          -> LHsType (GhcPass p) -> HsType (GhcPass p)-mkHsOpTy prom ty1 op ty2 = HsOpTy noAnn prom ty1 op ty2+mkHsOpTy prom ty1 op ty2 = HsOpTy noExtField prom ty1 op ty2  mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) mkHsAppTy t1 t2 = addCLocA t1 t2 (HsAppTy noExtField t1 t2)@@ -653,23 +712,22 @@ -- It returns API Annotations for any parens removed splitHsFunType ::      LHsType (GhcPass p)-  -> ( [AddEpAnn], EpAnnComments -- The locations of any parens and+  -> ( ([EpToken "("], [EpToken ")"]) , EpAnnComments -- The locations of any parens and                                   -- comments discarded      , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p)) splitHsFunType ty = go ty   where-    go (L l (HsParTy an ty))+    go (L l (HsParTy (op,cp) ty))       = let-          (anns, cs, args, res) = splitHsFunType ty-          anns' = anns ++ annParen2AddEpAnn an+          ((ops, cps), cs, args, res) = splitHsFunType ty           cs' = cs S.<> epAnnComments l-        in (anns', cs', args, res)+        in ((ops++[op], cps ++ [cp]), cs', args, res)      go (L ll (HsFunTy _ mult x y))       | (anns, csy, args, res) <- splitHsFunType y       = (anns, csy S.<> epAnnComments ll, HsScaled mult x:args, res) -    go other = ([], emptyComments, [], other)+    go other = (noAnn, emptyComments, [], other)  -- | Retrieve the name of the \"head\" of a nested type application. -- This is somewhat like @GHC.Tc.Gen.HsType.splitHsAppTys@, but a little more@@ -1040,60 +1098,63 @@                 FieldOcc *                                                                      * ************************************************************************--} -type instance XCFieldOcc GhcPs = NoExtField-type instance XCFieldOcc GhcRn = Name-type instance XCFieldOcc GhcTc = Id+Note [Ambiguous FieldOcc in record updates]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When renaming a "record field update" (`some_record{ field = expr }`), the field+occurrence may be ambiguous if there are multiple record types with that same+field label in scope. Instead of failing, we may attempt to do type-directed+disambiguation: if we typecheck the record field update, we can disambiguate+the `field` based on the record and field type. -type instance XXFieldOcc (GhcPass _) = DataConCantHappen+In practice, this means an identifier of a field occurrence+(`FieldOcc`) may have to go straight from `RdrName` to `Id`, since field+ambiguity makes it impossible to construct a `Name` for the field. -mkFieldOcc :: LocatedN RdrName -> FieldOcc GhcPs-mkFieldOcc rdr = FieldOcc noExtField rdr+Since type-directed disambiguation is a GHC property rather than a property of+the GHC-Haskell AST, we still parameterise a `FieldOcc` occurrence by `IdP p`,+but in the case of the ambiguity we do the unthinkable and insert a mkUnboundName+in the name. Very bad, yes, but since type-directed disambiguation is on the way+out (see proposal https://github.com/ghc-proposals/ghc-proposals/pull/366),+we consider this acceptable for now. +see also Wrinkle [Disambiguating fields] and note [Type-directed record disambiguation] -type instance XUnambiguous GhcPs = NoExtField-type instance XUnambiguous GhcRn = Name-type instance XUnambiguous GhcTc = Id+NB: FieldOcc preserves the RdrName throughout its lifecycle for+exact printing purposes.+-} -type instance XAmbiguous GhcPs = NoExtField-type instance XAmbiguous GhcRn = NoExtField-type instance XAmbiguous GhcTc = Id+type instance XCFieldOcc GhcPs = NoExtField -- RdrName is stored in the proper IdP field+type instance XCFieldOcc GhcRn = RdrName+type instance XCFieldOcc GhcTc = RdrName -type instance XXAmbiguousFieldOcc (GhcPass _) = DataConCantHappen+type instance XXFieldOcc GhcPs = DataConCantHappen+type instance XXFieldOcc GhcRn = DataConCantHappen+type instance XXFieldOcc GhcTc = DataConCantHappen -instance Outputable (AmbiguousFieldOcc (GhcPass p)) where-  ppr = ppr . ambiguousFieldOccRdrName+-------------------------------------------------------------------------------- -instance OutputableBndr (AmbiguousFieldOcc (GhcPass p)) where-  pprInfixOcc  = pprInfixOcc . ambiguousFieldOccRdrName-  pprPrefixOcc = pprPrefixOcc . ambiguousFieldOccRdrName+mkFieldOcc :: LocatedN RdrName -> FieldOcc GhcPs+mkFieldOcc rdr = FieldOcc noExtField rdr -instance OutputableBndr (Located (AmbiguousFieldOcc (GhcPass p))) where-  pprInfixOcc  = pprInfixOcc . unLoc-  pprPrefixOcc = pprPrefixOcc . unLoc+fieldOccRdrName :: forall p. IsPass p => FieldOcc (GhcPass p) -> RdrName+fieldOccRdrName fo = case ghcPass @p of+  GhcPs -> unLoc $ foLabel fo+  GhcRn -> foExt fo+  GhcTc -> foExt fo -mkAmbiguousFieldOcc :: LocatedN RdrName -> AmbiguousFieldOcc GhcPs-mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr+fieldOccLRdrName :: forall p. IsPass p => FieldOcc (GhcPass p) -> LocatedN RdrName+fieldOccLRdrName fo = case ghcPass @p of+  GhcPs -> foLabel fo+  GhcRn -> case fo of+    FieldOcc rdr sel ->+      let (L l _) = sel+       in L l rdr+  GhcTc ->+    let (L l _) = foLabel fo+     in L l (foExt fo) -ambiguousFieldOccRdrName :: AmbiguousFieldOcc (GhcPass p) -> RdrName-ambiguousFieldOccRdrName = unLoc . ambiguousFieldOccLRdrName -ambiguousFieldOccLRdrName :: AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName-ambiguousFieldOccLRdrName (Unambiguous _ rdr) = rdr-ambiguousFieldOccLRdrName (Ambiguous   _ rdr) = rdr--selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id-selectorAmbiguousFieldOcc (Unambiguous sel _) = sel-selectorAmbiguousFieldOcc (Ambiguous   sel _) = sel--unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc-unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel-unambiguousFieldOcc (Ambiguous   rdr sel) = FieldOcc rdr sel--ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc-ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr- {- ************************************************************************ *                                                                      *@@ -1122,28 +1183,40 @@ ************************************************************************ -} +instance OutputableBndrId p => Outputable (HsBndrVar (GhcPass p)) where+  ppr (HsBndrVar _ name) = ppr name+  ppr (HsBndrWildCard _) = char '_'+ class OutputableBndrFlag flag p where-    pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr flag (GhcPass p) -> SDoc+  pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr flag (GhcPass p) -> SDoc  instance OutputableBndrFlag () p where-    pprTyVarBndr (UserTyVar _ _ n)     = ppr n-    pprTyVarBndr (KindedTyVar _ _ n k) = parens $ hsep [ppr n, dcolon, ppr k]+  pprTyVarBndr (HsTvb _ _ bvar bkind) = decorate (ppr_hs_tvb bvar bkind)+    where decorate :: SDoc -> SDoc+          decorate d = parens_if_kind bkind d  instance OutputableBndrFlag Specificity p where-    pprTyVarBndr (UserTyVar _ SpecifiedSpec n)     = ppr n-    pprTyVarBndr (UserTyVar _ InferredSpec n)      = braces $ ppr n-    pprTyVarBndr (KindedTyVar _ SpecifiedSpec n k) = parens $ hsep [ppr n, dcolon, ppr k]-    pprTyVarBndr (KindedTyVar _ InferredSpec n k)  = braces $ hsep [ppr n, dcolon, ppr k]+  pprTyVarBndr (HsTvb _ spec bvar bkind) = decorate (ppr_hs_tvb bvar bkind)+    where decorate :: SDoc -> SDoc+          decorate d = case spec of+            InferredSpec  -> braces d+            SpecifiedSpec -> parens_if_kind bkind d  instance OutputableBndrFlag (HsBndrVis (GhcPass 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]+  pprTyVarBndr (HsTvb _ bvis bvar bkind) = decorate (ppr_hs_tvb bvar bkind)+    where decorate :: SDoc -> SDoc+          decorate d = case bvis of+            HsBndrRequired  _ -> parens_if_kind bkind d+            HsBndrInvisible _ -> char '@' <> parens_if_kind bkind d -pprHsBndrVis :: HsBndrVis (GhcPass p) -> SDoc -> SDoc-pprHsBndrVis (HsBndrRequired _) d = d-pprHsBndrVis (HsBndrInvisible _) d = char '@' <> d+ppr_hs_tvb :: OutputableBndrId p => HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc+ppr_hs_tvb bvar (HsBndrNoKind _) = ppr bvar+ppr_hs_tvb bvar (HsBndrKind _ k) = hsep [ppr bvar, dcolon, ppr k] +parens_if_kind :: HsBndrKind (GhcPass p) -> SDoc -> SDoc+parens_if_kind (HsBndrNoKind _) d = d+parens_if_kind (HsBndrKind _ _) d = parens d+ instance OutputableBndrId p => Outputable (HsSigType (GhcPass p)) where     ppr (HsSig { sig_bndrs = outer_bndrs, sig_body = body }) =       pprHsOuterSigTyVarBndrs outer_bndrs <+> ppr body@@ -1210,18 +1283,19 @@   ppr (RecCon rec)            = text "RecCon:" <+> ppr rec   ppr (InfixCon l r)          = text "InfixCon:" <+> ppr [l, r] -instance Outputable (XRec pass RdrName) => Outputable (FieldOcc pass) where+instance Outputable (XRec pass (IdP pass)) => Outputable (FieldOcc pass) where   ppr = ppr . foLabel -instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (FieldOcc pass) where-  pprInfixOcc  = pprInfixOcc . unXRec @pass . foLabel-  pprPrefixOcc = pprPrefixOcc . unXRec @pass . foLabel+instance (OutputableBndrId pass) => OutputableBndr (FieldOcc (GhcPass pass)) where+  pprInfixOcc  = pprInfixOcc . unXRec @(GhcPass pass) . foLabel+  pprPrefixOcc = pprPrefixOcc . unXRec @(GhcPass pass) . foLabel -instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where+instance (OutputableBndrId pass) => OutputableBndr (GenLocated SrcSpan (FieldOcc (GhcPass pass))) where   pprInfixOcc  = pprInfixOcc . unLoc   pprPrefixOcc = pprPrefixOcc . unLoc  + ppr_tylit :: (HsTyLit (GhcPass p)) -> SDoc ppr_tylit (HsNumTy source i) = pprWithSourceText source (integer i) ppr_tylit (HsStrTy source s) = pprWithSourceText source (text (show s))@@ -1282,7 +1356,7 @@       [L _ ty] -> ppr_mono_ty ty           <+> darrow       _        -> parens (interpp'SP ctxt) <+> darrow -pprConDeclFields :: OutputableBndrId p+pprConDeclFields :: forall p. OutputableBndrId p                  => [LConDeclField (GhcPass p)] -> SDoc pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))   where@@ -1290,23 +1364,10 @@                                  cd_fld_doc = doc }))         = pprMaybeWithDoc doc (ppr_names ns <+> dcolon <+> ppr ty) -    ppr_names :: [LFieldOcc (GhcPass p)] -> SDoc+    ppr_names :: forall p. OutputableBndrId p => [LFieldOcc (GhcPass p)] -> SDoc     ppr_names [n] = pprPrefixOcc n     ppr_names ns = sep (punctuate comma (map pprPrefixOcc ns)) -{--Note [Printing KindedTyVars]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-#3830 reminded me that we should really only print the kind-signature on a KindedTyVar if the kind signature was put there by the-programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,-rather than converting to KindedTyVars as before.--(As it happens, the message in #3830 comes out a different way now,-and the problem doesn't show up; but having the flag on a KindedTyVar-seems like the Right Thing anyway.)--}- -- Printing works more-or-less as for Types  pprHsType :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc@@ -1353,13 +1414,13 @@ ppr_mono_ty (HsExplicitListTy _ prom tys)   | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys)   | otherwise       = brackets (interpp'SP tys)-ppr_mono_ty (HsExplicitTupleTy _ tys)+ppr_mono_ty (HsExplicitTupleTy _ prom tys)     -- Special-case unary boxed tuples so that they are pretty-printed as     -- `'MkSolo x`, not `'(x)`   | [ty] <- tys-  = quoteIfPunsEnabled $ sep [text (mkTupleStr Boxed dataName 1), ppr_mono_lty ty]+  = quote_tuple prom $ sep [text (mkTupleStr Boxed dataName 1), ppr_mono_lty ty]   | otherwise-  = quoteIfPunsEnabled $ parens (maybeAddSpace tys $ interpp'SP tys)+  = quote_tuple prom $ parens (maybeAddSpace tys $ interpp'SP tys) ppr_mono_ty (HsTyLit _ t)       = ppr t ppr_mono_ty (HsWildCardTy {})   = char '_' @@ -1393,6 +1454,10 @@     in     sep [p1, arr <+> p2] +quote_tuple :: PromotionFlag -> SDoc -> SDoc+quote_tuple IsPromoted  doc = quote doc+quote_tuple NotPromoted doc = doc+ -------------------------- -- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses -- under precedence @p@.@@ -1422,7 +1487,7 @@     -- Special-case unary boxed tuple applications so that they are     -- parenthesized as `Proxy ('MkSolo x)`, not `Proxy 'MkSolo x` (#18612)     -- See Note [One-tuples] in GHC.Builtin.Types-    go_hs_ty (HsExplicitTupleTy _ [_])+    go_hs_ty (HsExplicitTupleTy _ _ [_])                                       = p >= appPrec     go_hs_ty (HsExplicitTupleTy{})    = False     go_hs_ty (HsTyLit{})              = False@@ -1531,4 +1596,3 @@ type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA  type instance Anno (FieldOcc (GhcPass p)) = SrcSpanAnnA-type instance Anno (AmbiguousFieldOcc (GhcPass p)) = SrcSpanAnnA
compiler/GHC/Hs/Utils.hs view
@@ -58,7 +58,7 @@   nlHsIntLit, nlHsVarApps,   nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,   mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,-  mkLocatedList,+  mkLocatedList, nlAscribe,    -- * Bindings   mkFunBind, mkVarBind, mkHsVarBind, mkSimpleGeneratedFunBind, mkTopFunBind,@@ -149,7 +149,6 @@ import GHC.Types.SourceText  import GHC.Data.FastString-import GHC.Data.Bag  import GHC.Utils.Misc import GHC.Utils.Outputable@@ -187,11 +186,11 @@                   Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))                         ~ EpAnn NoEpAnns)               => HsMatchContext (LIdP (NoGhcTc (GhcPass p)))-              -> [LPat (GhcPass p)] -> LocatedA (body (GhcPass p))+              -> LocatedE [LPat (GhcPass p)] -> LocatedA (body (GhcPass p))               -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))-mkSimpleMatch ctxt pats rhs+mkSimpleMatch ctxt (L l pats) rhs   = L loc $-    Match { m_ext = noAnn, m_ctxt = ctxt, m_pats = pats+    Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = L l pats           , m_grhss = unguardedGRHSs (locA loc) rhs noAnn }   where     loc = case pats of@@ -213,13 +212,13 @@  type AnnoBody p body   = ( XMG (GhcPass p) (LocatedA (body (GhcPass p))) ~ Origin-    , Anno [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] ~ SrcSpanAnnL+    , Anno [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] ~ SrcSpanAnnLW     , Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpanAnnA     )  mkMatchGroup :: AnnoBody p body              => Origin-             -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]+             -> LocatedLW [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]              -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkMatchGroup origin matches = MG { mg_ext = origin                                  , mg_alts = matches }@@ -227,7 +226,7 @@ mkLamCaseMatchGroup :: AnnoBody p body                     => Origin                     -> HsLamVariant-                    -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]+                    -> LocatedLW [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]                     -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkLamCaseMatchGroup origin lam_variant (L l matches)   = mkMatchGroup origin (L l $ map fixCtxt matches)@@ -270,13 +269,13 @@ mkHsAppTypes = foldl' mkHsAppType  mkHsLam :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin)-        => [LPat (GhcPass p)]+        => LocatedE [LPat (GhcPass p)]         -> LHsExpr (GhcPass p)         -> LHsExpr (GhcPass p)-mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noAnn LamSingle matches))+mkHsLam (L l pats) body = mkHsPar (L (getLoc body) (HsLam noAnn LamSingle matches))   where     matches = mkMatchGroup (Generated OtherExpansion SkipPmc)-                           (noLocA [mkSimpleMatch (LamAlt LamSingle) pats' body])+                           (noLocA [mkSimpleMatch (LamAlt LamSingle) (L l pats') body])     pats' = map (parenthesizePat appPrec) pats  mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc@@ -302,8 +301,8 @@                         ~ SrcSpanAnnA)             => LPat (GhcPass p) -> (LocatedA (body (GhcPass p)))             -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))-mkHsCaseAlt pat expr-  = mkSimpleMatch CaseAlt [pat] expr+mkHsCaseAlt (L l pat) expr+  = mkSimpleMatch CaseAlt (L (l2l l) [L l pat]) expr  nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc nlHsTyApp fun_id tys@@ -331,17 +330,17 @@ mkHsIntegral   :: IntegralLit -> HsOverLit GhcPs mkHsFractional :: FractionalLit -> HsOverLit GhcPs mkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs-mkHsDo         :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs-mkHsDoAnns     :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> AnnList -> HsExpr GhcPs+mkHsDo         :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> HsExpr GhcPs+mkHsDoAnns     :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> AnnList EpaLocation -> HsExpr GhcPs mkHsComp       :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs                -> HsExpr GhcPs mkHsCompAnns   :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs-               -> AnnList+               -> AnnList EpaLocation                -> HsExpr GhcPs -mkNPat      :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> [AddEpAnn]+mkNPat      :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-"             -> Pat GhcPs-mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpaLocation+mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpToken "+"             -> Pat GhcPs  -- NB: The following functions all use noSyntaxExpr: the generated expressions@@ -350,7 +349,7 @@            -> StmtLR (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR))) mkBodyStmt :: LocatedA (bodyR GhcPs)            -> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))-mkPsBindStmt :: [AddEpAnn] -> LPat GhcPs -> LocatedA (bodyR GhcPs)+mkPsBindStmt :: EpUniToken "<-" "←" -> LPat GhcPs -> LocatedA (bodyR GhcPs)              -> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs)) mkRnBindStmt :: LPat GhcRn -> LocatedA (bodyR GhcRn)              -> StmtLR GhcRn GhcRn (LocatedA (bodyR GhcRn))@@ -360,12 +359,12 @@ emptyRecStmt     :: (Anno [GenLocated                              (Anno (StmtLR (GhcPass idL) GhcPs bodyR))                              (StmtLR (GhcPass idL) GhcPs bodyR)]-                        ~ SrcSpanAnnL)+                        ~ SrcSpanAnnLW)                  => StmtLR (GhcPass idL) GhcPs bodyR emptyRecStmtName :: (Anno [GenLocated                              (Anno (StmtLR GhcRn GhcRn bodyR))                              (StmtLR GhcRn GhcRn bodyR)]-                        ~ SrcSpanAnnL)+                        ~ SrcSpanAnnLW)                  => StmtLR GhcRn GhcRn bodyR emptyRecStmtId   :: Stmt GhcTc (LocatedA (HsCmd GhcTc)) @@ -373,9 +372,9 @@                     (Anno [GenLocated                              (Anno (StmtLR (GhcPass idL) GhcPs bodyR))                              (StmtLR (GhcPass idL) GhcPs bodyR)]-                        ~ SrcSpanAnnL)-                 => AnnList-                 -> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]+                        ~ SrcSpanAnnLW)+                 => AnnList (EpToken "rec")+                 -> LocatedLW [LStmtLR (GhcPass idL) GhcPs bodyR]                  -> StmtLR (GhcPass idL) GhcPs bodyR mkRecStmt anns stmts  = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR)                              { recS_stmts = stmts }@@ -410,17 +409,17 @@ mkNPlusKPat id lit anns   = NPlusKPat anns id lit (unLoc lit) noSyntaxExpr noSyntaxExpr -mkTransformStmt    :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+mkTransformStmt    :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs                    -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)-mkTransformByStmt  :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+mkTransformByStmt  :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs                    -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)-mkGroupUsingStmt   :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+mkGroupUsingStmt   :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs                    -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)-mkGroupByUsingStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+mkGroupByUsingStmt :: AnnTransStmt -> [ExprLStmt GhcPs] -> LHsExpr GhcPs                    -> LHsExpr GhcPs                    -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -emptyTransStmt :: [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)+emptyTransStmt :: AnnTransStmt -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) emptyTransStmt anns = TransStmt { trS_ext = anns                                 , trS_form = panic "emptyTransStmt: form"                                 , trS_stmts = [], trS_bndrs = []@@ -469,14 +468,14 @@ emptyRecStmtId   = emptyRecStmt' unitRecStmtTc                                         -- a panic might trigger during zonking -mkLetStmt :: [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)+mkLetStmt :: EpToken "let" -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b) mkLetStmt anns binds = LetStmt anns binds  ------------------------------- -- | A useful function for building @OpApps@.  The operator is always a -- variable, and we don't know the fixity yet. mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkHsOpApp e1 op e2 = OpApp noAnn e1 (noLocA (HsVar noExtField (noLocA op))) e2+mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLocA (HsVar noExtField (noLocA op))) e2  mkHsString :: String -> HsLit (GhcPass p) mkHsString s = HsString NoSourceText (mkFastString s)@@ -648,7 +647,7 @@ nlHsTyConApp prom fixity tycon tys   | Infix <- fixity   , HsValArg _ ty1 : HsValArg _ ty2 : rest <- tys-  = foldl' mk_app (noLocA $ HsOpTy noAnn prom ty1 (noLocA tycon) ty2) rest+  = foldl' mk_app (noLocA $ HsOpTy noExtField prom ty1 (noLocA tycon) ty2) rest   | otherwise   = foldl' mk_app (nlHsTyVar prom tycon) tys   where@@ -770,6 +769,13 @@       = L loc (ClassOpSig anns False nms (dropWildCards ty))     fiddle sig = sig ++-- | Type ascription: (e :: ty)+nlAscribe :: RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs+nlAscribe ty e = noLocA $ ExprWithTySig noAnn e+                           $ mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType+                           $ nlHsTyVar NotPromoted ty+ {- ********************************************************************* *                                                                      *     --------- HsWrappers: type args, dict args, casts ---------@@ -781,7 +787,7 @@  mkHsWrap :: HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc mkHsWrap co_fn e | isIdHsWrapper co_fn = e-mkHsWrap co_fn e                       = XExpr (WrapExpr $ HsWrap co_fn e)+mkHsWrap co_fn e                       = XExpr (WrapExpr co_fn e)  mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b            -> HsExpr GhcTc -> HsExpr GhcTc@@ -843,7 +849,7 @@                                     }  mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs-mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var [] rhs+mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var (noLocA []) rhs  mkVarBind :: IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc mkVarBind var rhs = L (getLoc rhs) $@@ -851,7 +857,7 @@                               var_id = var, var_rhs = rhs }  mkPatSynBind :: LocatedN RdrName -> HsPatSynDetails GhcPs-             -> LPat GhcPs -> HsPatSynDir GhcPs -> [AddEpAnn] -> HsBind GhcPs+             -> LPat GhcPs -> HsPatSynDir GhcPs -> AnnPSB -> HsBind GhcPs mkPatSynBind name details lpat dir anns = PatSynBind noExtField psb   where     psb = PSB{ psb_ext = anns@@ -874,14 +880,14 @@   = foldr combineSrcSpans noSrcSpan (bsSpans ++ sigsSpans)   where     bsSpans :: [SrcSpan]-    bsSpans = map getLocA $ bagToList bs+    bsSpans = map getLocA bs     sigsSpans :: [SrcSpan]     sigsSpans = map getLocA sigs spanHsLocaLBinds (HsValBinds _ (XValBindsLR (NValBinds bs sigs)))   = foldr combineSrcSpans noSrcSpan (bsSpans ++ sigsSpans)   where     bsSpans :: [SrcSpan]-    bsSpans = map getLocA $ concatMap (bagToList . snd) bs+    bsSpans = map getLocA $ concatMap snd bs     sigsSpans :: [SrcSpan]     sigsSpans = map getLocA sigs spanHsLocaLBinds (HsIPBinds _ (IPBinds _ bs))@@ -890,30 +896,31 @@ ------------ -- | Convenience function using 'mkFunBind'. -- This is for generated bindings only, do not use for user-written code.-mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LPat GhcPs]+mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> LocatedE [LPat GhcPs]                          -> LHsExpr GhcPs -> LHsBind GhcPs mkSimpleGeneratedFunBind loc fun pats expr   = L (noAnnSrcSpan loc) $ mkFunBind (Generated OtherExpansion SkipPmc) (L (noAnnSrcSpan loc) fun)                                      [mkMatch ctxt pats expr emptyLocalBinds]   where     ctxt :: HsMatchContextPs-    ctxt = mkPrefixFunRhs (L (noAnnSrcSpan loc) fun)+    ctxt = mkPrefixFunRhs (L (noAnnSrcSpan loc) fun) noAnn  -- | Make a prefix, non-strict function 'HsMatchContext'-mkPrefixFunRhs :: fn -> HsMatchContext fn-mkPrefixFunRhs n = FunRhs { mc_fun        = n+mkPrefixFunRhs :: fn -> AnnFunRhs -> HsMatchContext fn+mkPrefixFunRhs n an = FunRhs { mc_fun        = n                           , mc_fixity     = Prefix-                          , mc_strictness = NoSrcStrict }+                          , mc_strictness = NoSrcStrict+                          , mc_an         = an }  ------------ mkMatch :: forall p. IsPass p         => HsMatchContext (LIdP (NoGhcTc (GhcPass p)))-        -> [LPat (GhcPass p)]+        -> LocatedE [LPat (GhcPass p)]         -> LHsExpr (GhcPass p)         -> HsLocalBinds (GhcPass p)         -> LMatch (GhcPass p) (LHsExpr (GhcPass p)) mkMatch ctxt pats expr binds-  = noLocA (Match { m_ext   = noAnn+  = noLocA (Match { m_ext   = noExtField                   , m_ctxt  = ctxt                   , m_pats  = pats                   , m_grhss = GRHSs emptyComments (unguardedRHS noAnn noSrcSpan expr) binds })@@ -1036,7 +1043,7 @@ isUnliftedHsBind (PatSynBind {}) = panic "isUnliftedBind: PatSynBind"  isUnliftedHsBinds :: LHsBinds GhcTc -> Bool-isUnliftedHsBinds = anyBag (isUnliftedHsBind . unLoc)+isUnliftedHsBinds = any (isUnliftedHsBind . unLoc)  is_unlifted_id :: Id -> Bool is_unlifted_id id = isUnliftedType (idType id)@@ -1046,7 +1053,7 @@ -- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)? isBangedHsBind :: HsBind GhcTc -> Bool isBangedHsBind (XHsBindsLR (AbsBinds { abs_binds = binds }))-  = anyBag (isBangedHsBind . unLoc) binds+  = any (isBangedHsBind . unLoc) binds isBangedHsBind (FunBind {fun_matches = matches})   | [L _ match] <- unLoc $ mg_alts matches   , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match@@ -1152,28 +1159,28 @@ ----------------- Statements -------------------------- -- collectLStmtsBinders-  :: CollectPass (GhcPass idL)+  :: (IsPass idL, IsPass idR, CollectPass (GhcPass idL))   => CollectFlag (GhcPass idL)   -> [LStmtLR (GhcPass idL) (GhcPass idR) body]   -> [IdP (GhcPass idL)] collectLStmtsBinders flag = concatMap (collectLStmtBinders flag)  collectStmtsBinders-  :: CollectPass (GhcPass idL)+  :: (IsPass idL, IsPass idR, CollectPass (GhcPass idL))   => CollectFlag (GhcPass idL)   -> [StmtLR (GhcPass idL) (GhcPass idR) body]   -> [IdP (GhcPass idL)] collectStmtsBinders flag = concatMap (collectStmtBinders flag)  collectLStmtBinders-  :: CollectPass (GhcPass idL)+  :: (IsPass idL, IsPass idR, CollectPass (GhcPass idL))   => CollectFlag (GhcPass idL)   -> LStmtLR (GhcPass idL) (GhcPass idR) body   -> [IdP (GhcPass idL)] collectLStmtBinders flag = collectStmtBinders flag . unLoc  collectStmtBinders-  :: CollectPass (GhcPass idL)+  :: forall idL idR body . (IsPass idL, IsPass idR, CollectPass (GhcPass idL))   => CollectFlag (GhcPass idL)   -> StmtLR (GhcPass idL) (GhcPass idR) body   -> [IdP (GhcPass idL)]@@ -1186,12 +1193,16 @@     ParStmt _ xs _ _ -> collectLStmtsBinders flag [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]     TransStmt { trS_stmts = stmts } -> collectLStmtsBinders flag stmts     RecStmt { recS_stmts = L _ ss } -> collectLStmtsBinders flag ss-    ApplicativeStmt _ args _        -> concatMap collectArgBinders args-        where-         collectArgBinders = \case-            (_, ApplicativeArgOne { app_arg_pattern = pat }) -> collectPatBinders flag pat-            (_, ApplicativeArgMany { bv_pattern = pat })     -> collectPatBinders flag pat+    XStmtLR x -> case ghcPass :: GhcPass idR of+        GhcRn -> collectApplicativeStmtBndrs x+        GhcTc -> collectApplicativeStmtBndrs x+  where+    collectApplicativeStmtBndrs :: ApplicativeStmt (GhcPass idL) a -> [IdP (GhcPass idL)]+    collectApplicativeStmtBndrs (ApplicativeStmt _ args _) = concatMap (collectArgBinders . snd) args +    collectArgBinders = \case+        ApplicativeArgOne { app_arg_pattern = pat } -> collectPatBinders flag pat+        ApplicativeArgMany { bv_pattern = pat }     -> collectPatBinders flag pat  ----------------- Patterns -------------------------- @@ -1254,6 +1265,10 @@   ParPat _ pat          -> collect_lpat flag pat bndrs   ListPat _ pats        -> foldr (collect_lpat flag) bndrs pats   TuplePat _ pats _     -> foldr (collect_lpat flag) bndrs pats+  OrPat _ _             -> []+      -- See Note [Implementation of OrPatterns], Renamer:+      -- evidence binders in an OrPat currently aren't visible outside their+      -- binding pattern, so we return [].   SumPat _ pat _ _      -> collect_lpat flag pat bndrs   LitPat _ _            -> bndrs   NPat {}               -> bndrs@@ -1427,7 +1442,7 @@          (foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls))   where     getSelectorNames :: ([LocatedA Name], [LFieldOcc GhcRn]) -> [Name]-    getSelectorNames (ns, fs) = map unLoc ns ++ map (foExt . unLoc) fs+    getSelectorNames (ns, fs) = map unLoc ns ++ map (unLoc . foLabel . unLoc) fs  ------------------- @@ -1508,7 +1523,7 @@ -- names are collected by 'collectHsValBinders'. hsPatSynSelectors (ValBinds _ _ _) = panic "hsPatSynSelectors" hsPatSynSelectors (XValBindsLR (NValBinds binds _))-  = foldr addPatSynSelector [] . unionManyBags $ map snd binds+  = foldr addPatSynSelector [] . concat $ map snd binds  addPatSynSelector :: forall p. UnXRec p => LHsBind p -> [FieldOcc p] -> [FieldOcc p] addPatSynSelector bind sels@@ -1520,7 +1535,7 @@                => [(RecFlag, LHsBinds id)] -> [PatSynBind id id] getPatSynBinds binds   = [ psb | (_, lbinds) <- binds-          , (unXRec @id -> (PatSynBind _ psb)) <- bagToList lbinds ]+          , (unXRec @id -> (PatSynBind _ psb)) <- lbinds ]  ------------------- hsLInstDeclBinders :: (IsPass p, OutputableBndrId p)@@ -1669,7 +1684,7 @@                , fieldIndices = Map.empty                , newInt       = 0 } -insertField :: LFieldOcc (GhcPass p) -> FieldIndices p -> (Located Int, FieldIndices p)+insertField :: IsPass p => LFieldOcc (GhcPass p) -> FieldIndices p -> (Located Int, FieldIndices p) insertField new_fld fi@(FieldIndices flds idxs new_idx)   | Just i <- Map.lookup rdr idxs   = (L loc i, fi)@@ -1680,7 +1695,7 @@                    (new_idx + 1))   where     loc = getLocA new_fld-    rdr = unLoc . foLabel . unLoc $ new_fld+    rdr = fieldOccRdrName . unLoc $ new_fld  {- @@ -1760,25 +1775,24 @@                              -- (in practice, always a singleton: see Note [Collecting implicit binders])                          } -lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]+lStmtsImplicits :: forall idR body . IsPass idR => [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]                 -> [(SrcSpan, [ImplicitFieldBinders])] lStmtsImplicits = hs_lstmts   where-    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]+    hs_lstmts :: forall idR body . IsPass idR => [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]               -> [(SrcSpan, [ImplicitFieldBinders])]     hs_lstmts = concatMap (hs_stmt . unLoc) -    hs_stmt :: StmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))+    hs_stmt :: forall idR body . IsPass idR => StmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))             -> [(SrcSpan, [ImplicitFieldBinders])]     hs_stmt (BindStmt _ pat _) = lPatImplicits pat-    hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args-      where do_arg (_, ApplicativeArgOne { app_arg_pattern = pat }) = lPatImplicits pat-            do_arg (_, ApplicativeArgMany { app_stmts = stmts }) = hs_lstmts stmts+    hs_stmt (XStmtLR x) = case ghcPass :: GhcPass idR of+        GhcRn -> hs_applicative_stmt x+        GhcTc -> hs_applicative_stmt x     hs_stmt (LetStmt _ binds)     = hs_local_binds binds     hs_stmt (BodyStmt {})         = []     hs_stmt (LastStmt {})         = []-    hs_stmt (ParStmt _ xs _ _)    = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs-                                                , s <- ss]+    hs_stmt (ParStmt _ xs _ _)    = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs , s <- ss]     hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts     hs_stmt (RecStmt { recS_stmts = L _ ss }) = hs_lstmts ss @@ -1786,6 +1800,10 @@     hs_local_binds (HsIPBinds {})           = []     hs_local_binds (EmptyLocalBinds _)      = [] +    hs_applicative_stmt (ApplicativeStmt _ args _) = concatMap do_arg args+      where do_arg (_, ApplicativeArgOne { app_arg_pattern = pat }) = lPatImplicits pat+            do_arg (_, ApplicativeArgMany { app_stmts = stmts }) = hs_lstmts stmts+ hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR)                     -> [(SrcSpan, [ImplicitFieldBinders])] hsValBindsImplicits (XValBindsLR (NValBinds binds _))@@ -1794,7 +1812,7 @@   = lhsBindsImplicits binds  lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [ImplicitFieldBinders])]-lhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []+lhsBindsImplicits = concatMap (lhs_bind . unLoc)   where     lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat     lhs_bind _ = []@@ -1853,5 +1871,5 @@   where (explicit_binds, implicit_binds) = splitAt unRecFieldsDotDot rec_flds         implicit_field_binders (L _ (HsFieldBind { hfbLHS = L _ fld, hfbRHS = rhs }))           = ImplicitFieldBinders-              { implFlBndr_field   = foExt fld+              { implFlBndr_field   = unLoc $ foLabel fld               , implFlBndr_binders = collectPatBinders CollNoDictBinders rhs }
compiler/GHC/HsToCore/Pmc/Solver/Types.hs view
@@ -65,7 +65,7 @@ import GHC.Builtin.Types.Prim import GHC.Tc.Solver.InertSet (InertSet, emptyInert) import GHC.Tc.Utils.TcType (isStringTy)-import GHC.Types.CompleteMatch (CompleteMatch(..))+import GHC.Types.CompleteMatch import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit                             , fractionalLitFromRational                             , FractionalExponentBase(..))@@ -258,19 +258,19 @@ -- See also Note [Implementation of COMPLETE pragmas] data ResidualCompleteMatches   = RCM-  { rcm_vanilla :: !(Maybe CompleteMatch)+  { rcm_vanilla :: !(Maybe DsCompleteMatch)   -- ^ The residual set for the vanilla COMPLETE set from the data defn.   -- Tracked separately from 'rcm_pragmas', because it might only be   -- known much later (when we have enough type information to see the 'TyCon'   -- of the match), or not at all even. Until that happens, it is 'Nothing'.-  , rcm_pragmas :: !(Maybe [CompleteMatch])+  , rcm_pragmas :: !(Maybe DsCompleteMatches)   -- ^ The residual sets for /all/ COMPLETE sets from pragmas that are   -- visible when compiling this module. Querying that set with   -- 'dsGetCompleteMatches' requires 'DsM', so we initialise it with 'Nothing'   -- until first needed in a 'DsM' context.   } -getRcm :: ResidualCompleteMatches -> [CompleteMatch]+getRcm :: ResidualCompleteMatches -> DsCompleteMatches getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas  isRcmInitialised :: ResidualCompleteMatches -> Bool@@ -325,6 +325,11 @@     go _                = Nothing  trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla)+{-# INLINE trvVarInfo #-}+-- This function is called a lot and we want to specilise it, not only+-- for the type class, but also for its 'f' function argument.+-- Before the INLINE pragma it sometimes inlined and sometimes didn't,+-- depending delicately on GHC's optimisations.  Better to use a pragma. trvVarInfo f nabla@MkNabla{ nabla_tm_st = ts@TmSt{ts_facts = env} } x   = set_vi <$> f (lookupVarInfo ts x)   where
compiler/GHC/HsToCore/Pmc/Types.hs view
@@ -18,7 +18,9 @@         -- * LYG syntax          -- ** Guard language-        SrcInfo(..), PmGrd(..), GrdVec(..),+        SrcInfo(..), PmGrd(..), GrdDag(..),+        consGrdDag, gdSeq, sequencePmGrds, sequenceGrdDags,+        alternativesGrdDags,          -- ** Guard tree language         PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..),@@ -103,9 +105,52 @@ -- location. newtype SrcInfo = SrcInfo (Located SDoc) --- | A sequence of 'PmGrd's.-newtype GrdVec = GrdVec [PmGrd]+-- | A series-parallel graph of 'PmGrd's, so very nearly a guard tree, if+-- it weren't for or-patterns/'GdAlt'!+-- The implicit "source" corresponds to "before the match" and the implicit+-- "sink" corresponds to "after a successful match".+--+--   * 'GdEnd' is a 'GrdDag' that always matches.+--   * 'GdOne' is a 'GrdDag' that matches iff its 'PmGrd' matches.+--   * @'GdSeq' g1 g2@ corresponds to matching guards @g1@ and then @g2@+--     if matching @g1@ succeeded.+--     Example: The Haskell guard @| x > 1, x < 10 = ...@ will test @x > 1@+--     before @x < 10@, failing if either test fails.+--   * @'GdAlt' g1 g2@ is far less common than 'GdSeq' and corresponds to+--     matching an or-pattern @(LT; EQ)@, succeeding if the+--     match variable matches /either/ 'LT' or 'EQ'.+--     See Note [Implementation of OrPatterns] for a larger example.+--+data GrdDag+  = GdEnd+  | GdOne !PmGrd+  | GdSeq !GrdDag !GrdDag+  | GdAlt !GrdDag !GrdDag +-- | Sequentially compose a list of 'PmGrd's into a 'GrdDag'.+sequencePmGrds :: [PmGrd] -> GrdDag+sequencePmGrds = sequenceGrdDags . map GdOne++-- | Sequentially compose a list of 'GrdDag's.+sequenceGrdDags :: [GrdDag] -> GrdDag+sequenceGrdDags xs = foldr gdSeq GdEnd xs++-- | Sequentially compose a 'PmGrd' in front of a 'GrdDag'.+consGrdDag :: PmGrd -> GrdDag -> GrdDag+consGrdDag g d = gdSeq (GdOne g) d++-- | Sequentially compose two 'GrdDag's. A smart constructor for `GdSeq` that+-- eliminates `GdEnd`s.+gdSeq :: GrdDag -> GrdDag -> GrdDag+gdSeq g1    GdEnd = g1+gdSeq GdEnd g2    = g2+gdSeq g1    g2    = g1 `GdSeq` g2++-- | Parallel composition of a list of 'GrdDag's.+-- Needs a non-empty list as 'GdAlt' does not have a neutral element.+alternativesGrdDags :: NonEmpty GrdDag -> GrdDag+alternativesGrdDags xs = foldr1 GdAlt xs+ -- | A guard tree denoting 'MatchGroup'. newtype PmMatchGroup p = PmMatchGroup (NonEmpty (PmMatch p)) @@ -139,9 +184,15 @@   ppr (SrcInfo (L s                   _)) = ppr s  -- | Format LYG guards as @| True <- x, let x = 42, !z@-instance Outputable GrdVec where-  ppr (GrdVec [])     = empty-  ppr (GrdVec (g:gs)) = fsep (char '|' <+> ppr g : map ((comma <+>) . ppr) gs)+instance Outputable GrdDag where+  ppr GdEnd = empty+  ppr (GdOne g) = ppr g+  ppr (GdSeq d1 d2) = ppr d1 <> comma <+> ppr d2+  ppr d0@GdAlt{} = parens $ fsep (ppr d : map ((semi <+>) . ppr) ds)+    where+      d NE.:| ds = collect d0+      collect (GdAlt d1 d2) = collect d1 Semi.<> collect d2+      collect d = NE.singleton d  -- | Format a LYG sequence (e.g. 'Match'es of a 'MatchGroup' or 'GRHSs') as -- @{ <first alt>; ...; <last alt> }@@@ -236,7 +287,7 @@ --  -- | Used as tree payload pre-checking. The LYG guards to check.-type Pre = GrdVec+type Pre = GrdDag  -- | Used as tree payload post-checking. The redundancy info we elaborated. type Post = RedSets
compiler/GHC/Iface/Decl.hs view
@@ -45,7 +45,6 @@ import GHC.Utils.Panic.Plain import GHC.Utils.Misc -import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.BooleanFormula @@ -147,7 +146,7 @@   | Just fam_flav <- famTyConFlav_maybe tycon   = ( tc_env1     , IfaceFamily { ifName    = getName tycon,-                    ifResVar  = if_res_var,+                    ifResVar  = mkIfLclName <$> if_res_var,                     ifFamFlav = to_if_fam_flav fam_flav,                     ifBinders = if_binders,                     ifResKind = if_res_kind,@@ -288,7 +287,7 @@                 ifClassCtxt   = tidyToIfaceContext env1 sc_theta,                 ifATs    = map toIfaceAT clas_ats,                 ifSigs   = map toIfaceClassOp op_stuff,-                ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas)+                ifMinDef = toIfaceBooleanFormula $ fmap (mkIfLclName . getOccFS) (classMinimalDef clas)             }      (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)@@ -334,7 +333,7 @@ tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder]) tidyTyConBinders = mapAccumL tidyTyConBinder -tidyTyVar :: TidyEnv -> TyVar -> FastString+tidyTyVar :: TidyEnv -> TyVar -> IfLclName tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)  toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula
compiler/GHC/Iface/Ext/Fields.hs view
@@ -33,16 +33,16 @@     -- for a payload pointer after each name:     header_entries <- forM (Map.toList fs) $ \(name, dat) -> do       put_ bh name-      field_p_p <- tellBin bh+      field_p_p <- tellBinWriter bh       put_ bh field_p_p       return (field_p_p, dat)      -- Now put the payloads and use the reserved space     -- to point to the start of each payload:     forM_ header_entries $ \(field_p_p, dat) -> do-      field_p <- tellBin bh-      putAt bh field_p_p field_p-      seekBin bh field_p+      field_p <- tellBinWriter bh+      putAtRel bh field_p_p field_p+      seekBinWriter bh field_p       put_ bh dat    get bh = do@@ -50,11 +50,11 @@      -- Get the names and field pointers:     header_entries <- replicateM n $-      (,) <$> get bh <*> get bh+      (,) <$> get bh <*> getRelBin bh      -- Seek to and get each field's payload:     fields <- forM header_entries $ \(name, field_p) -> do-      seekBin bh field_p+      seekBinReaderRel bh field_p       dat <- get bh       return (name, dat) @@ -72,7 +72,7 @@ readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)+readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$>   Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields+writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do   bh <- openBinMem (1024 * 1024)   write bh
compiler/GHC/Iface/Recomp/Binary.hs view
@@ -14,8 +14,9 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain+import GHC.Iface.Type (putIfaceType) -fingerprintBinMem :: BinHandle -> IO Fingerprint+fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f   where     f bs =@@ -26,7 +27,7 @@         in fp `seq` return fp  computeFingerprint :: (Binary a)-                   => (BinHandle -> Name -> IO ())+                   => (WriteBinHandle -> Name -> IO ())                    -> a                    -> IO Fingerprint computeFingerprint put_nonbinding_name a = do@@ -34,12 +35,16 @@     put_ bh a     fingerprintBinMem bh   where-    set_user_data bh =-      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS+    set_user_data bh = setWriterUserData bh $ mkWriterUserData+      [ mkSomeBinaryWriter $ mkWriter putIfaceType+      , mkSomeBinaryWriter $ mkWriter put_nonbinding_name+      , mkSomeBinaryWriter $ simpleBindingNameWriter $ mkWriter putNameLiterally+      , mkSomeBinaryWriter $ mkWriter putFS+      ]  -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to.-putNameLiterally :: BinHandle -> Name -> IO ()+putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do     put_ bh $! nameModule name     put_ bh $! nameOccName name
compiler/GHC/Iface/Syntax.hs view
@@ -17,7 +17,7 @@         IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..),         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,         IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..),-        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),+        IfaceDefault(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),         IfaceClassBody(..), IfaceBooleanFormula(..),         IfaceBang(..),         IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),@@ -25,6 +25,8 @@         IfaceTyConParent(..),         IfaceCompleteMatch(..),         IfaceLFInfo(..), IfaceTopBndrInfo(..),+        IfaceImport(..),+        ImpIfaceList(..),          -- * Binding names         IfaceTopBndr,@@ -63,6 +65,7 @@ import GHC.Types.Name.Set import GHC.Core.Coercion.Axiom ( BranchIndex ) import GHC.Types.Name+import GHC.Types.Name.Reader import GHC.Types.CostCentre import GHC.Types.Literal import GHC.Types.ForeignCall@@ -94,6 +97,7 @@ import Control.Monad import System.IO.Unsafe import Control.DeepSeq+import Data.Proxy  infixl 3 &&& @@ -105,6 +109,13 @@ ************************************************************************ -} +data IfaceImport = IfaceImport ImpDeclSpec ImpIfaceList++data ImpIfaceList+  = ImpIfaceAll -- ^ no user import list+  | ImpIfaceExplicit !IfGlobalRdrEnv+  | ImpIfaceEverythingBut !NameSet+ -- | A binding top-level 'Name' in an interface file (e.g. the name of an -- 'IfaceDecl'). type IfaceTopBndr = Name@@ -118,16 +129,15 @@   -- We don't serialise the namespace onto the disk though; rather we   -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr+getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()+putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name =-    case getUserData bh of-      UserData{ ud_put_binding_name = put_binding_name } ->+    case findUserDataWriter (Proxy @BindingName) bh of+      tbl ->           --pprTrace "putIfaceTopBndr" (ppr name) $-          put_binding_name bh name-+          putEntry tbl bh (BindingName name)  data IfaceDecl   = IfaceId { ifName      :: IfaceTopBndr,@@ -311,6 +321,13 @@ data IfaceSrcBang   = IfSrcBang SrcUnpackedness SrcStrictness +-- See Note [Named default declarations] in GHC.Tc.Gen.Default+-- | Exported named defaults+data IfaceDefault+  = IfaceDefault { ifDefaultCls  :: IfaceTyCon,            -- Defaulted class+                   ifDefaultTys  :: [IfaceType],          -- List of defaults+                   ifDefaultWarn :: Maybe IfaceWarningTxt }+ data IfaceClsInst   = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with                    ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst@@ -369,7 +386,7 @@  type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] (Maybe IfaceTyCon)+data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] (Maybe IfExtName)  instance Outputable IfaceCompleteMatch where   ppr (IfaceCompleteMatch cls mtc) = text "COMPLETE" <> colon <+> ppr cls <+> case mtc of@@ -631,6 +648,7 @@   | IfaceFCall  ForeignCall IfaceType   | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E + data IfaceTickish   = IfaceHpcTick    Module Int               -- from HpcTick x   | IfaceSCC        CostCentre Bool Bool     -- from ProfNote@@ -642,7 +660,7 @@         -- We reconstruct the kind/type of the thing from the context         -- thus saving bulk in interface files -data IfaceConAlt = IfaceDefault+data IfaceConAlt = IfaceDefaultAlt                  | IfaceDataAlt IfExtName                  | IfaceLitAlt Literal @@ -1025,7 +1043,7 @@       pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions         text "{-# MINIMAL" <+>         pprBooleanFormula-          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>+          (\_ def -> cparen (isLexSym def) (ppr def)) 0 (fmap ifLclNameFS minDef) <+>         text "#-}"        -- See Note [Suppressing binder signatures] in GHC.Iface.Type@@ -1399,6 +1417,10 @@     where       pp_foralls = ppUnless (null bndrs) $ forAllLit <+> pprIfaceBndrs bndrs <> dot +instance Outputable IfaceDefault where+  ppr (IfaceDefault { ifDefaultCls = cls, ifDefaultTys = tcs })+    = text "default" <+> ppr cls <+> parens (pprWithCommas ppr tcs)+ instance Outputable IfaceClsInst where   ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag                     , ifInstCls = cls, ifInstTys = mb_tcs@@ -1551,7 +1573,7 @@  ------------------ instance Outputable IfaceConAlt where-    ppr IfaceDefault      = text "DEFAULT"+    ppr IfaceDefaultAlt   = text "DEFAULT"     ppr (IfaceLitAlt l)   = ppr l     ppr (IfaceDataAlt d)  = ppr d @@ -1770,10 +1792,8 @@ freeNamesIfCoercion (IfaceFreeCoVar _) = emptyNameSet freeNamesIfCoercion (IfaceCoVarCo _)   = emptyNameSet freeNamesIfCoercion (IfaceHoleCo _)    = emptyNameSet-freeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)-  = unitNameSet ax &&& fnList freeNamesIfCoercion cos-freeNamesIfCoercion (IfaceUnivCo p _ t1 t2)-  = freeNamesIfProv p &&& freeNamesIfType t1 &&& freeNamesIfType t2+freeNamesIfCoercion (IfaceUnivCo _ _ t1 t2 cos)+  = freeNamesIfType t1 &&& freeNamesIfType t2 &&& fnList freeNamesIfCoercion cos freeNamesIfCoercion (IfaceSymCo c)   = freeNamesIfCoercion c freeNamesIfCoercion (IfaceTransCo c1 c2)@@ -1788,14 +1808,13 @@   = freeNamesIfCoercion c freeNamesIfCoercion (IfaceSubCo co)   = freeNamesIfCoercion co-freeNamesIfCoercion (IfaceAxiomRuleCo _ax cos)-  -- the axiom is just a string, so we don't count it as a name.-  = fnList freeNamesIfCoercion cos+freeNamesIfCoercion (IfaceAxiomCo ax cos)+  = fnAxRule ax &&& fnList freeNamesIfCoercion cos -freeNamesIfProv :: IfaceUnivCoProv -> NameSet-freeNamesIfProv (IfacePhantomProv co)    = freeNamesIfCoercion co-freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co-freeNamesIfProv (IfacePluginProv _)      = emptyNameSet+fnAxRule :: IfaceAxiomRule -> NameSet+fnAxRule (IfaceAR_X _)   = emptyNameSet -- the axiom is just a string, so we don't count it as a name.+fnAxRule (IfaceAR_U n)   = unitNameSet n+fnAxRule (IfaceAR_B n _) = unitNameSet n  freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr@@ -1855,7 +1874,7 @@     -- Depend on the data constructors.  Just one will do!     -- Note [Tracking data constructors]     fn_cons []                                     = emptyNameSet-    fn_cons (IfaceAlt IfaceDefault _ _       : xs) = fn_cons xs+    fn_cons (IfaceAlt IfaceDefaultAlt    _ _ : xs) = fn_cons xs     fn_cons (IfaceAlt (IfaceDataAlt con) _ _ : _ ) = unitNameSet con     fn_cons (_                               : _ ) = emptyNameSet @@ -2278,6 +2297,17 @@          a2 <- get bh          return (IfSrcBang a1 a2) +instance Binary IfaceDefault where+    put_ bh (IfaceDefault cls tys warn) = do+        put_ bh cls+        put_ bh tys+        put_ bh warn+    get bh = do+        cls  <- get bh+        tys  <- get bh+        warn <- get bh+        return (IfaceDefault cls tys warn)+ instance Binary IfaceClsInst where     put_ bh (IfaceClsInst cls tys dfun flag orph warn) = do         put_ bh cls@@ -2444,13 +2474,13 @@                     c <- get bh                     return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO ()+putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike                                      , uf_is_work_free = wf, uf_expandable = exp }) = do     let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp     putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache+getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do     b <- getByte bh     let hnf     = testBit b 3@@ -2461,8 +2491,9 @@                            , uf_is_work_free = wf, uf_expandable = exp })  infixl 9 .<<|.-(.<<|.) :: (Bits a) => a -> Bool -> a+(.<<|.) :: (Num a, Bits a) => a -> Bool -> a x .<<|. b = (if b then (`setBit` 0) else id) (x `shiftL` 1)+{-# INLINE (.<<|.) #-}  instance Binary IfaceAlt where     put_ bh (IfaceAlt a b c) = do@@ -2633,13 +2664,13 @@             _ -> panic ("get IfaceTickish " ++ show h)  instance Binary IfaceConAlt where-    put_ bh IfaceDefault      = putByte bh 0+    put_ bh IfaceDefaultAlt   = putByte bh 0     put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa     put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac     get bh = do         h <- getByte bh         case h of-            0 -> return IfaceDefault+            0 -> return IfaceDefaultAlt             1 -> liftM IfaceDataAlt $ get bh             _ -> liftM IfaceLitAlt  $ get bh @@ -2725,6 +2756,14 @@ ************************************************************************ -} +instance NFData IfaceImport where+  rnf (IfaceImport a b) = rnf a `seq` rnf b++instance NFData ImpIfaceList where+  rnf ImpIfaceAll = ()+  rnf (ImpIfaceEverythingBut ns) = rnf ns+  rnf (ImpIfaceExplicit gre) = rnf gre+ instance NFData IfaceDecl where   rnf = \case     IfaceId f1 f2 f3 f4 ->@@ -2882,7 +2921,7 @@  instance NFData IfaceConAlt where   rnf = \case-    IfaceDefault -> ()+    IfaceDefaultAlt -> ()     IfaceDataAlt nm -> rnf nm     IfaceLitAlt lit -> lit `seq` () @@ -2892,6 +2931,10 @@ instance NFData IfaceRule where   rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) =     rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` f8 `seq` ()++instance NFData IfaceDefault where+  rnf (IfaceDefault f1 f2 f3) =+    rnf f1 `seq` rnf f2 `seq` rnf f3  instance NFData IfaceFamInst where   rnf (IfaceFamInst f1 f2 f3 f4) =
compiler/GHC/Iface/Type.hs view
@@ -9,13 +9,12 @@  {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-}- module GHC.Iface.Type (-        IfExtName, IfLclName,+        IfExtName,+        IfLclName(..), mkIfLclName, ifLclNameFS,          IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),-        IfaceMCoercion(..),-        IfaceUnivCoProv(..),+        IfaceAxiomRule(..),IfaceMCoercion(..),         IfaceMult,         IfaceTyCon(..),         IfaceTyConInfo(..), mkIfaceTyConInfo,@@ -33,6 +32,8 @@         ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,         ifTyConBinderVar, ifTyConBinderName, +        -- Binary utilities+        putIfaceType, getIfaceType, ifaceTypeSharedByte,         -- Equality testing         isIfaceLiftedTypeKind, @@ -74,7 +75,7 @@                                  , liftedRepTyCon, liftedDataConTyCon                                  , sumTyCon ) import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy, funTyFlagTyCon )-import GHC.Core.TyCo.Rep( CoSel )+import GHC.Core.TyCo.Rep( CoSel, UnivCoProvenance(..) ) import GHC.Core.TyCo.Compare( eqForAllVis ) import GHC.Core.TyCon hiding ( pprPromotionQuote ) import GHC.Core.Coercion.Axiom@@ -90,9 +91,13 @@ import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust )+import Data.Maybe (isJust)+import Data.Proxy import qualified Data.Semigroup as Semi+import Data.Word (Word8)+import Control.Arrow (first) import Control.DeepSeq+import Control.Monad ((<$!>))  {- ************************************************************************@@ -102,15 +107,26 @@ ************************************************************************ -} -type IfLclName = FastString     -- A local name in iface syntax+-- | A local name in iface syntax+newtype IfLclName = IfLclName+  { getIfLclName :: LexicalFastString+  } deriving (Eq, Ord, Show) +ifLclNameFS :: IfLclName -> FastString+ifLclNameFS = getLexicalFastString . getIfLclName++mkIfLclName :: FastString -> IfLclName+mkIfLclName = IfLclName . LexicalFastString+ type IfExtName = Name   -- An External or WiredIn Name can appear in Iface syntax                         -- (However Internal or System Names never should)  data IfaceBndr          -- Local (non-top-level) binders   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr+  deriving (Eq, Ord) + type IfaceIdBndr  = (IfaceType, IfLclName, IfaceType) type IfaceTvBndr  = (IfLclName, IfaceKind) @@ -154,7 +170,7 @@ -- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType' -- before being printed. See Note [Pretty printing via Iface syntax] in "GHC.Types.TyThing.Ppr" data IfaceType-  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]+  = IfaceFreeTyVar TyVar                -- See Note [Free TyVars and CoVars in IfaceType]   | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon   | IfaceLitTy     IfaceTyLit   | IfaceAppTy     IfaceType IfaceAppArgs@@ -178,7 +194,36 @@           -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression           -- in interface file size (in GHC's boot libraries).           -- See !3987.+  deriving (Eq, Ord)+  -- See Note [Ord instance of IfaceType] +{-+Note [Ord instance of IfaceType]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We need an 'Ord' instance to have a 'Map' keyed by 'IfaceType'. This 'Map' is+required for implementing the deduplication table during interface file+serialisation.+See Note [Deduplication during iface binary serialisation] for the implementation details.++We experimented with a 'TrieMap' based implementation, but it seems to be+slower than using a straight-forward 'Map IfaceType'.+The experiments loaded the full agda library into a ghci session with the+following scenarios:++* normal: a plain ghci session.+* cold: a ghci session that uses '-fwrite-if-simplified-core -fforce-recomp',+  forcing a cold-cache.+* warm: a subsequent ghci session that uses a warm cache for+  '-fwrite-if-simplified-core', e.g. nothing needs to be recompiled.++The implementation was up to 5% slower in some execution runs. However, on+'lib:Cabal', the performance difference between 'Map IfaceType' and+'TrieMap IfaceType' was negligible.++We share our implementation of the 'TrieMap' in the ticket #24816, so that+further performance analysis and improvements don't need to start from scratch.+-}+ type IfaceMult = IfaceType  type IfacePredType = IfaceType@@ -186,9 +231,9 @@  data IfaceTyLit   = IfaceNumTyLit Integer-  | IfaceStrTyLit FastString+  | IfaceStrTyLit LexicalFastString   | IfaceCharTyLit Char-  deriving (Eq)+  deriving (Eq, Ord)  type IfaceTyConBinder    = VarBndr IfaceBndr TyConBndrVis type IfaceForAllBndr     = VarBndr IfaceBndr ForAllTyFlag@@ -230,6 +275,7 @@                         --    arguments in @{...}.             IfaceAppArgs -- The rest of the arguments+  deriving (Eq, Ord)  instance Semi.Semigroup IfaceAppArgs where   IA_Nil <> xs              = xs@@ -244,8 +290,19 @@ -- We have to tag them in order to pretty print them -- properly. data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName-                             , ifaceTyConInfo :: IfaceTyConInfo }-    deriving (Eq)+                             , ifaceTyConInfo :: !IfaceTyConInfo+                             -- ^ We add a bang to this field as heap analysis+                             -- showed that this constructor retains a thunk to+                             -- a value that is usually shared.+                             --+                             -- See !12200 for how this bang saved ~10% residency+                             -- when loading 'mi_extra_decls' on the agda+                             -- code base.+                             --+                             -- See Note [Sharing IfaceTyConInfo] for why+                             -- sharing is so important for 'IfaceTyConInfo'.+                             }+    deriving (Eq, Ord)  -- | The various types of TyCons which have special, built-in syntax. data IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon@@ -265,7 +322,7 @@                       -- that is actually being applied to two types                       -- of the same kind.  This affects pretty-printing                       -- only: see Note [Equality predicates in IfaceType]-                    deriving (Eq)+                    deriving (Eq, Ord)  instance Outputable IfaceTyConSort where   ppr IfaceNormalTyCon         = text "normal"@@ -273,7 +330,7 @@   ppr (IfaceSumTyCon n)        = text "sum:" <> ppr n   ppr IfaceEqualityTyCon       = text "equality" -{- Note [Free tyvars in IfaceType]+{- Note [Free TyVars and CoVars in IfaceType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to an IfaceType and pretty printing that.  This eliminates a lot of@@ -359,18 +416,57 @@                       -- should be printed as 'D to distinguish it from                       -- an existing type constructor D.                    , ifaceTyConSort       :: IfaceTyConSort }-    deriving (Eq)+    deriving (Eq, Ord) --- This smart constructor allows sharing of the two most common--- cases. See #19194+-- | This smart constructor allows sharing of the two most common+-- cases. See Note [Sharing IfaceTyConInfo] mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo-mkIfaceTyConInfo IsPromoted  IfaceNormalTyCon = IfaceTyConInfo IsPromoted  IfaceNormalTyCon-mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = IfaceTyConInfo NotPromoted IfaceNormalTyCon-mkIfaceTyConInfo prom        sort             = IfaceTyConInfo prom        sort+mkIfaceTyConInfo IsPromoted  IfaceNormalTyCon = promotedNormalTyConInfo+mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = notPromotedNormalTyConInfo+mkIfaceTyConInfo prom        sort             = IfaceTyConInfo prom sort +{-# NOINLINE promotedNormalTyConInfo #-}+-- | See Note [Sharing IfaceTyConInfo]+promotedNormalTyConInfo :: IfaceTyConInfo+promotedNormalTyConInfo = IfaceTyConInfo IsPromoted IfaceNormalTyCon++{-# NOINLINE notPromotedNormalTyConInfo #-}+-- | See Note [Sharing IfaceTyConInfo]+notPromotedNormalTyConInfo :: IfaceTyConInfo+notPromotedNormalTyConInfo = IfaceTyConInfo NotPromoted IfaceNormalTyCon++{-+Note [Sharing IfaceTyConInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+'IfaceTyConInfo' occurs an awful lot in 'ModIface', see #19194 for an example.+But almost all of them are++   IfaceTyConInfo IsPromoted IfaceNormalTyCon+   IfaceTyConInfo NotPromoted IfaceNormalTyCon.++The smart constructor `mkIfaceTyConInfo` arranges to share these instances,+thus:++  promotedNormalTyConInfo    = IfaceTyConInfo IsPromoted  IfaceNormalTyCon+  notPromotedNormalTyConInfo = IfaceTyConInfo NotPromoted IfaceNormalTyCon++  mkIfaceTyConInfo IsPromoted  IfaceNormalTyCon = promotedNormalTyConInfo+  mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = notPromotedNormalTyConInfo+  mkIfaceTyConInfo prom        sort             = IfaceTyConInfo prom sort++But ALAS, the (nested) CPR transform can lose this sharing, completely+negating the effect of `mkIfaceTyConInfo`: see #24530 and #19326.++Sticking-plaster solution: add a NOINLINE pragma to those top-level constants.+When we fix the CPR bug we can remove the NOINLINE pragmas.++This one change leads to an 15% reduction in residency for GHC when embedding+'mi_extra_decls': see !12222.+-}+ data IfaceMCoercion   = IfaceMRefl-  | IfaceMCo IfaceCoercion+  | IfaceMCo IfaceCoercion deriving (Eq, Ord)  data IfaceCoercion   = IfaceReflCo       IfaceType@@ -380,12 +476,11 @@   | IfaceAppCo        IfaceCoercion IfaceCoercion   | IfaceForAllCo     IfaceBndr !ForAllTyFlag !ForAllTyFlag IfaceCoercion IfaceCoercion   | IfaceCoVarCo      IfLclName-  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]-  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]-       -- There are only a fixed number of CoAxiomRules, so it suffices+  | IfaceAxiomCo      IfaceAxiomRule [IfaceCoercion]+       -- ^ There are only a fixed number of CoAxiomRules, so it suffices        -- to use an IfaceLclName to distinguish them.        -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals-  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType+  | IfaceUnivCo       UnivCoProvenance Role IfaceType IfaceType [IfaceCoercion]   | IfaceSymCo        IfaceCoercion   | IfaceTransCo      IfaceCoercion IfaceCoercion   | IfaceSelCo        CoSel IfaceCoercion@@ -393,13 +488,16 @@   | IfaceInstCo       IfaceCoercion IfaceCoercion   | IfaceKindCo       IfaceCoercion   | IfaceSubCo        IfaceCoercion-  | IfaceFreeCoVar    CoVar    -- See Note [Free tyvars in IfaceType]+  | IfaceFreeCoVar    CoVar    -- ^ See Note [Free TyVars and CoVars in IfaceType]   | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]+  deriving (Eq, Ord)+  -- Why Ord?  See Note [Ord instance of IfaceType] -data IfaceUnivCoProv-  = IfacePhantomProv IfaceCoercion-  | IfaceProofIrrelProv IfaceCoercion-  | IfacePluginProv String+data IfaceAxiomRule+  = IfaceAR_X IfLclName               -- Built-in+  | IfaceAR_B IfExtName BranchIndex   -- Branched+  | IfaceAR_U IfExtName               -- Unbranched+  deriving (Eq, Ord)  {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -571,11 +669,11 @@  mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst -- See Note [Substitution on IfaceType]-mkIfaceTySubst eq_spec = mkFsEnv eq_spec+mkIfaceTySubst eq_spec = mkFsEnv (map (first ifLclNameFS) eq_spec)  inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool -- See Note [Substitution on IfaceType]-inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs)+inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst (ifLclNameFS fs))  substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType -- See Note [Substitution on IfaceType]@@ -605,8 +703,7 @@     go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv     go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv     go_co (IfaceHoleCo cv)           = IfaceHoleCo cv-    go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)-    go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)+    go_co (IfaceUnivCo p r t1 t2 ds) = IfaceUnivCo p r (go t1) (go t2) (go_cos ds)     go_co (IfaceSymCo co)            = IfaceSymCo (go_co co)     go_co (IfaceTransCo co1 co2)     = IfaceTransCo (go_co co1) (go_co co2)     go_co (IfaceSelCo n co)          = IfaceSelCo n (go_co co)@@ -614,14 +711,10 @@     go_co (IfaceInstCo c1 c2)        = IfaceInstCo (go_co c1) (go_co c2)     go_co (IfaceKindCo co)           = IfaceKindCo (go_co co)     go_co (IfaceSubCo co)            = IfaceSubCo (go_co co)-    go_co (IfaceAxiomRuleCo n cos)   = IfaceAxiomRuleCo n (go_cos cos)+    go_co (IfaceAxiomCo n cos)       = IfaceAxiomCo n (go_cos cos)      go_cos = map go_co -    go_prov (IfacePhantomProv co)    = IfacePhantomProv (go_co co)-    go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)-    go_prov co@(IfacePluginProv _)   = co- substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs substIfaceAppArgs env args   = go args@@ -631,7 +724,7 @@  substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType substIfaceTyVar env tv-  | Just ty <- lookupFsEnv env tv = ty+  | Just ty <- lookupFsEnv env (ifLclNameFS tv) = ty   | otherwise                     = IfaceTyVar tv  @@ -677,6 +770,12 @@       | isVisibleForAllTyFlag argf = go (n+1) rest       | otherwise             = go n rest +ifaceAppArgsLength :: IfaceAppArgs -> Int+ifaceAppArgsLength = go 0+  where+    go !n IA_Nil = n+    go !n (IA_Arg _ _ ts) = go (n + 1) ts+ {- Note [Suppressing invisible arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -967,7 +1066,7 @@   | not (isIfaceRhoType ty)             = ppr_sigma ShowForAllMust ctxt_prec ty ppr_ty _         (IfaceForAllTy {})     = panic "ppr_ty"  -- Covered by not.isIfaceRhoType ppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reason for IfaceFreeTyVar!-ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [Free tyvars in IfaceType]+ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [Free TyVars and CoVars in IfaceType] ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys ppr_ty ctxt_prec (IfaceTupleTy i p tys) = ppr_tuple ctxt_prec i p tys -- always fully saturated ppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n@@ -1134,7 +1233,7 @@      | isInvisibleForAllTyFlag argf  -- Don't default *visible* quantification                                      -- or we get the mess in #13963      , Just substituted_ty <- check_substitution var_kind-      = let subs' = extendFsEnv subs var substituted_ty+      = let subs' = extendFsEnv subs (ifLclNameFS var) substituted_ty             -- Record that we should replace it with LiftedRep/Lifted/Many,             -- and recurse, discarding the forall         in go subs' True ty@@ -1142,7 +1241,7 @@     go subs rank1 (IfaceForAllTy bndr ty)       = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) -    go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of+    go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs (ifLclNameFS tv) of       Just s -> s       Nothing -> ty @@ -1570,7 +1669,7 @@        , IA_Arg (IfaceLitTy (IfaceStrTyLit n))                 Required (IA_Arg ty Required IA_Nil) <- tys        -> maybeParen ctxt_prec funPrec-         $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty+         $ char '?' <> ftext (getLexicalFastString n) <> text "::" <> ppr_ty topPrec ty         | IfaceTupleTyCon arity sort <- ifaceTyConSort info        , not debug@@ -1739,17 +1838,16 @@      | tc `ifaceTyConHasKey` liftedTypeKindTyConKey      -> ppr_kind_type ctxt_prec -     | not (isSymOcc (nameOccName (ifaceTyConName tc)))-     -> pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)+     | isSymOcc (nameOccName (ifaceTyConName tc)) -     | [ ty1@(_, Required), ty2@(_, Required) ] <- tys+     , [ ty1@(_, Required), ty2@(_, Required) ] <- tys          -- Infix, two visible arguments (we know nothing of precedence though).          -- Don't apply this special case if one of the arguments is invisible,          -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).-     -> pprIfaceInfixApp ctxt_prec (ppr tc) (pp opPrec ty1) (pp opPrec ty2)+     -> pprIfaceInfixApp ctxt_prec (pprIfaceTyCon tc) (pp opPrec ty1) (pp opPrec ty2)       | otherwise-     -> pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)+     -> pprIfacePrefixApp ctxt_prec (pprParendIfaceTyCon tc) (map (pp appPrec) tys)  data TupleOrSum = IsSum | IsTuple TupleSort   deriving (Eq)@@ -1899,26 +1997,24 @@       = let (tvs, co'') = split_co co' in ((name,kind_co,visL,visR):tvs,co'')     split_co co' = ([], co') --- Why these three? See Note [Free tyvars in IfaceType]+-- Why these three? See Note [Free TyVars and CoVars in IfaceType] ppr_co _ (IfaceFreeCoVar covar) = ppr covar ppr_co _ (IfaceCoVarCo covar)   = ppr covar ppr_co _ (IfaceHoleCo covar)    = braces (ppr covar) -ppr_co _ (IfaceUnivCo prov role ty1 ty2)+ppr_co _ (IfaceUnivCo prov role ty1 ty2 ds)   = text "Univ" <> (parens $-      sep [ ppr role <+> pprIfaceUnivCoProv prov+      sep [ ppr role <+> ppr prov <> ppr ds           , dcolon <+>  ppr ty1 <> comma <+> ppr ty2 ])  ppr_co ctxt_prec (IfaceInstCo co ty)   = maybeParen ctxt_prec appPrec $-    text "Inst" <+> pprParendIfaceCoercion co-                        <+> pprParendIfaceCoercion ty--ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)-  = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos)+    text "Inst" <+> sep [ pprParendIfaceCoercion co+                        , pprParendIfaceCoercion ty ] -ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)-  = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos+ppr_co ctxt_prec (IfaceAxiomCo ax cos)+  | null cos  = pprIfAxRule ax  -- Don't add parens+  | otherwise = ppr_special_co ctxt_prec (pprIfAxRule ax) cos ppr_co ctxt_prec (IfaceSymCo co)   = ppr_special_co ctxt_prec (text "Sym") [co] ppr_co ctxt_prec (IfaceTransCo co1 co2)@@ -1941,6 +2037,11 @@   = maybeParen ctxt_prec appPrec                (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))]) +pprIfAxRule :: IfaceAxiomRule -> SDoc+pprIfAxRule (IfaceAR_X n)   = ppr n+pprIfAxRule (IfaceAR_U n)   = ppr n+pprIfAxRule (IfaceAR_B n i) = ppr n <> brackets (int i)+ ppr_role :: Role -> SDoc ppr_role r = underscore <> pp_role   where pp_role = case r of@@ -1948,19 +2049,24 @@                     Representational -> char 'R'                     Phantom          -> char 'P' --------------------pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc-pprIfaceUnivCoProv (IfacePhantomProv co)-  = text "phantom" <+> pprParendIfaceCoercion co-pprIfaceUnivCoProv (IfaceProofIrrelProv co)-  = text "irrel" <+> pprParendIfaceCoercion co-pprIfaceUnivCoProv (IfacePluginProv s)-  = text "plugin" <+> doubleQuotes (text s)- -------------------+instance Outputable IfLclName where+  ppr = ppr . ifLclNameFS+ instance Outputable IfaceTyCon where-  ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)+  ppr = pprIfaceTyCon +-- | Print an `IfaceTyCon` with a promotion tick if needed, without parens,+-- suitable for use in infix contexts+pprIfaceTyCon :: IfaceTyCon -> SDoc+pprIfaceTyCon tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)++-- | Print an `IfaceTyCon` with a promotion tick if needed, possibly with parens,+-- suitable for use in prefix contexts+pprParendIfaceTyCon :: IfaceTyCon -> SDoc+pprParendIfaceTyCon tc = pprPromotionQuote tc <> pprPrefixVar (isSymOcc (nameOccName tc_name)) (ppr tc_name)+  where tc_name = ifaceTyConName tc+ instance Outputable IfaceTyConInfo where   ppr (IfaceTyConInfo { ifaceTyConIsPromoted = prom                       , ifaceTyConSort       = sort })@@ -1988,11 +2094,12 @@   ppr = pprIfaceCoercion  instance Binary IfaceTyCon where-   put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i+  put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i -   get bh = do n <- get bh-               i <- get bh-               return (IfaceTyCon n i)+  get bh = do+    n <- get bh+    i <- get bh+    return (IfaceTyCon n i)  instance Binary IfaceTyConSort where    put_ bh IfaceNormalTyCon             = putByte bh 0@@ -2011,7 +2118,13 @@ instance Binary IfaceTyConInfo where    put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s -   get bh = mkIfaceTyConInfo <$> get bh <*> get bh+   get bh = mkIfaceTyConInfo <$!> get bh <*> get bh+    -- We want to make sure, when reading from disk, as the most common case+    -- is supposed to be shared. Any thunk adds an additional indirection+    -- making sharing less useful.+    --+    -- See !12200 for how this bang and the one in 'IfaceTyCon' reduces the+    -- residency by ~10% when loading 'mi_extra_decls' from disk.  instance Outputable IfaceTyLit where   ppr = pprIfaceTyLit@@ -2033,21 +2146,27 @@          _ -> panic ("get IfaceTyLit " ++ show tag)  instance Binary IfaceAppArgs where-  put_ bh tk =-    case tk of-      IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts-      IA_Nil        -> putByte bh 1+  put_ bh tk = do+    -- Int is variable length encoded so only+    -- one byte for small lists.+    put_ bh (ifaceAppArgsLength tk)+    go tk+    where+      go IA_Nil = pure ()+      go (IA_Arg a b t) = do+        put_ bh a+        put_ bh b+        go t -  get bh =-    do c <- getByte bh-       case c of-         0 -> do-           t  <- get bh-           a  <- get bh-           ts <- get bh-           return $! IA_Arg t a ts-         1 -> return IA_Nil-         _ -> panic ("get IfaceAppArgs " ++ show c)+  get bh = do+    n <- get bh :: IO Int+    go n+    where+      go 0 = return IA_Nil+      go c = do+        a <- get bh+        b <- get bh+        IA_Arg a b <$> go (c - 1)  ------------------- @@ -2102,38 +2221,80 @@ ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))  instance Binary IfaceType where-    put_ _ (IfaceFreeTyVar tv)-       = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)+   put_ bh ty =+    case findUserDataWriter Proxy bh of+      tbl -> putEntry tbl bh ty -    put_ bh (IfaceForAllTy aa ab) = do-            putByte bh 0-            put_ bh aa-            put_ bh ab-    put_ bh (IfaceTyVar ad) = do-            putByte bh 1-            put_ bh ad-    put_ bh (IfaceAppTy ae af) = do-            putByte bh 2-            put_ bh ae-            put_ bh af-    put_ bh (IfaceFunTy af aw ag ah) = do-            putByte bh 3-            put_ bh af-            put_ bh aw-            put_ bh ag-            put_ bh ah-    put_ bh (IfaceTyConApp tc tys)-      = do { putByte bh 5; put_ bh tc; put_ bh tys }-    put_ bh (IfaceCastTy a b)-      = do { putByte bh 6; put_ bh a; put_ bh b }-    put_ bh (IfaceCoercionTy a)-      = do { putByte bh 7; put_ bh a }-    put_ bh (IfaceTupleTy s i tys)-      = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }-    put_ bh (IfaceLitTy n)-      = do { putByte bh 9; put_ bh n }+   get bh = getIfaceTypeShared bh -    get bh = do+-- | This is the byte tag we expect to read when the next+-- value is not an 'IfaceType' value, but an offset into a+-- lookup table.+-- See Note [Deduplication during iface binary serialisation].+--+-- Must not overlap with any byte tag in 'getIfaceType'.+ifaceTypeSharedByte :: Word8+ifaceTypeSharedByte = 99++-- | Like 'getIfaceType' but checks for a specific byte tag+-- that indicates that we won't be able to read a 'IfaceType' value+-- but rather an offset into a lookup table. Consequentially,+-- we look up the value for the 'IfaceType' in the look up table.+--+-- See Note [Deduplication during iface binary serialisation]+-- for details.+getIfaceTypeShared :: ReadBinHandle -> IO IfaceType+getIfaceTypeShared bh = do+  start <- tellBinReader bh+  tag <- getByte bh+  if ifaceTypeSharedByte == tag+    then case findUserDataReader Proxy bh of+            tbl -> getEntry tbl bh+    else seekBinReader bh start >> getIfaceType bh++-- | Serialises an 'IfaceType' to the given 'WriteBinHandle'.+--+-- Serialising inner 'IfaceType''s uses the 'Binary.put' of 'IfaceType' which may be using+-- a deduplication table. See Note [Deduplication during iface binary serialisation].+putIfaceType :: WriteBinHandle -> IfaceType -> IO ()+putIfaceType _ (IfaceFreeTyVar tv)+  = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)+  -- See Note [Free TyVars and CoVars in IfaceType]++putIfaceType bh (IfaceForAllTy aa ab) = do+        putByte bh 0+        put_ bh aa+        put_ bh ab+putIfaceType bh (IfaceTyVar ad) = do+        putByte bh 1+        put_ bh ad+putIfaceType bh (IfaceAppTy ae af) = do+        putByte bh 2+        put_ bh ae+        put_ bh af+putIfaceType bh (IfaceFunTy af aw ag ah) = do+        putByte bh 3+        put_ bh af+        put_ bh aw+        put_ bh ag+        put_ bh ah+putIfaceType bh (IfaceTyConApp tc tys)+  = do { putByte bh 5; put_ bh tc; put_ bh tys }+putIfaceType bh (IfaceCastTy a b)+  = do { putByte bh 6; put_ bh a; put_ bh b }+putIfaceType bh (IfaceCoercionTy a)+  = do { putByte bh 7; put_ bh a }+putIfaceType bh (IfaceTupleTy s i tys)+  = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }+putIfaceType bh (IfaceLitTy n)+  = do { putByte bh 9; put_ bh n }++-- | Deserialises an 'IfaceType' from the given 'ReadBinHandle'.+--+-- Reading inner 'IfaceType''s uses the 'Binary.get' of 'IfaceType' which may be using+-- a deduplication table. See Note [Deduplication during iface binary serialisation].+getIfaceType :: HasCallStack => ReadBinHandle -> IO IfaceType+getIfaceType bh = do             h <- getByte bh             case h of               0 -> do aa <- get bh@@ -2161,6 +2322,13 @@               _  -> do n <- get bh                        return (IfaceLitTy n) +instance Binary IfLclName where+  put_ bh = put_ bh . ifLclNameFS++  get bh = do+    fs <- get bh+    pure $ IfLclName $ LexicalFastString fs+ instance Binary IfaceMCoercion where   put_ bh IfaceMRefl =           putByte bh 1@@ -2210,17 +2378,13 @@   put_ bh (IfaceCoVarCo a) = do           putByte bh 7           put_ bh a-  put_ bh (IfaceAxiomInstCo a b c) = do-          putByte bh 8-          put_ bh a-          put_ bh b-          put_ bh c-  put_ bh (IfaceUnivCo a b c d) = do+  put_ bh (IfaceUnivCo a b c d deps) = do           putByte bh 9           put_ bh a           put_ bh b           put_ bh c           put_ bh d+          put_ bh deps   put_ bh (IfaceSymCo a) = do           putByte bh 10           put_ bh a@@ -2246,15 +2410,16 @@   put_ bh (IfaceSubCo a) = do           putByte bh 16           put_ bh a-  put_ bh (IfaceAxiomRuleCo a b) = do+  put_ bh (IfaceAxiomCo a b) = do           putByte bh 17           put_ bh a           put_ bh b   put_ _ (IfaceFreeCoVar cv)        = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)+           -- See Note [Free TyVars and CoVars in IfaceType]   put_ _  (IfaceHoleCo cv)        = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)-          -- See Note [Holes in IfaceCoercion]+           -- See Note [Holes in IfaceCoercion]    get bh = do       tag <- getByte bh@@ -2285,15 +2450,12 @@                    return $ IfaceForAllCo a visL visR b c            7 -> do a <- get bh                    return $ IfaceCoVarCo a-           8 -> do a <- get bh-                   b <- get bh-                   c <- get bh-                   return $ IfaceAxiomInstCo a b c            9 -> do a <- get bh                    b <- get bh                    c <- get bh                    d <- get bh-                   return $ IfaceUnivCo a b c d+                   deps <- get bh+                   return $ IfaceUnivCo a b c d deps            10-> do a <- get bh                    return $ IfaceSymCo a            11-> do a <- get bh@@ -2314,31 +2476,19 @@                    return $ IfaceSubCo a            17-> do a <- get bh                    b <- get bh-                   return $ IfaceAxiomRuleCo a b+                   return $ IfaceAxiomCo a b            _ -> panic ("get IfaceCoercion " ++ show tag) -instance Binary IfaceUnivCoProv where-  put_ bh (IfacePhantomProv a) = do-          putByte bh 1-          put_ bh a-  put_ bh (IfaceProofIrrelProv a) = do-          putByte bh 2-          put_ bh a-  put_ bh (IfacePluginProv a) = do-          putByte bh 3-          put_ bh a--  get bh = do-      tag <- getByte bh-      case tag of-           1 -> do a <- get bh-                   return $ IfacePhantomProv a-           2 -> do a <- get bh-                   return $ IfaceProofIrrelProv a-           3 -> do a <- get bh-                   return $ IfacePluginProv a-           _ -> panic ("get IfaceUnivCoProv " ++ show tag)+instance Binary IfaceAxiomRule where+  put_ bh (IfaceAR_X n)   = putByte bh 0 >> put_ bh n+  put_ bh (IfaceAR_U n)   = putByte bh 1 >> put_ bh n+  put_ bh (IfaceAR_B n i) = putByte bh 2 >> put_ bh n >> put_ bh i +  get bh = do h <- getByte bh+              case h of+                0 -> do { n <- get bh; return (IfaceAR_X n) }+                1 -> do { n <- get bh; return (IfaceAR_U n) }+                _ -> do { n <- get bh; i <- get bh; return (IfaceAR_B n i) }  instance Binary (DefMethSpec IfaceType) where     put_ bh VanillaDM     = putByte bh 0@@ -2377,9 +2527,8 @@     IfaceAppCo f1 f2 -> rnf f1 `seq` rnf f2     IfaceForAllCo f1 f2 f3 f4 f5 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5     IfaceCoVarCo f1 -> rnf f1-    IfaceAxiomInstCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3-    IfaceAxiomRuleCo f1 f2 -> rnf f1 `seq` rnf f2-    IfaceUnivCo f1 f2 f3 f4 -> rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4+    IfaceAxiomCo f1 f2 -> rnf f1 `seq` rnf f2+    IfaceUnivCo f1 f2 f3 f4 deps -> rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf deps     IfaceSymCo f1 -> rnf f1     IfaceTransCo f1 f2 -> rnf f1 `seq` rnf f2     IfaceSelCo f1 f2 -> rnf f1 `seq` rnf f2@@ -2390,8 +2539,11 @@     IfaceFreeCoVar f1 -> f1 `seq` ()     IfaceHoleCo f1 -> f1 `seq` () -instance NFData IfaceUnivCoProv where-  rnf x = seq x ()+instance NFData IfaceAxiomRule where+  rnf = \case+    IfaceAR_X n   -> rnf n+    IfaceAR_U n   -> rnf n+    IfaceAR_B n i -> rnf n `seq` rnf i  instance NFData IfaceMCoercion where   rnf x = seq x ()@@ -2405,6 +2557,9 @@     IfaceTupleTyCon arity sort -> rnf arity `seq` sort `seq` ()     IfaceSumTyCon arity -> rnf arity     IfaceEqualityTyCon -> ()++instance NFData IfLclName where+  rnf (IfLclName lfs) = rnf lfs  instance NFData IfaceTyConInfo where   rnf (IfaceTyConInfo f s) = f `seq` rnf s
compiler/GHC/JS/Ident.hs view
@@ -34,25 +34,29 @@  module GHC.JS.Ident   ( Ident(..)-  , global+  , name   ) where -import Prelude+import GHC.Prelude  import GHC.Data.FastString import GHC.Types.Unique+import GHC.Utils.Outputable  -------------------------------------------------------------------------------- --                            Identifiers ----------------------------------------------------------------------------------- We use FastString for identifiers in JS backend  -- | A newtype wrapper around 'FastString' for JS identifiers. newtype Ident = TxtI { identFS :: FastString }  deriving stock   (Show, Eq)- deriving newtype (Uniquable)+ deriving newtype (Uniquable, Outputable) --- | A not-so-smart constructor for @Ident@s, used to indicate that this name is--- expected to be top-level-global :: FastString -> Ident-global = TxtI+-- | To give a thing a name is to have power over it. This smart constructor+-- serves two purposes: first, it isolates the JS backend from the rest of GHC.+-- The backend should not explicitly use types provided by GHC but instead+-- should wrap them such as we do here. Second it creates a symbol in the JS+-- backend, but it does not yet give that symbols meaning. Giving the symbol+-- meaning only occurs once it is used with a combinator from @GHC.JS.Make@.+name :: FastString -> Ident+name = TxtI
compiler/GHC/JS/JStg/Monad.hs view
@@ -92,7 +92,7 @@               return  $ mk_ident tag id  mk_ident :: FastString -> Unique -> Ident-mk_ident t i = global (mconcat [t, "_", mkFastString (show i)])+mk_ident t i = name (mconcat [t, "_", mkFastString (show i)])  -- | Set the tag for @Ident@s for all remaining computations. tag_names :: FastString -> JSM ()
compiler/GHC/JS/JStg/Syntax.hs view
@@ -28,6 +28,10 @@ --     is written in. Nothing fancy, its just a straightforward deeply embedded --     DSL. --+--     In general, one should not use these constructors explicitly in the JS+--     backend. Instead, prefer using the combinators in GHC.JS.Make, if those+--     are suitable then prefer using the patterns exported from this module+ ----------------------------------------------------------------------------- module GHC.JS.JStg.Syntax   ( -- * Deeply embedded JS datatypes@@ -63,7 +67,8 @@   -- * Utility   , SaneDouble(..)   , pattern Func-  , var+  , global+  , local   ) where  import GHC.Prelude@@ -105,7 +110,7 @@   | BreakStat (Maybe JsLabel)                   -- ^ Break   | ContinueStat (Maybe JsLabel)                -- ^ Continue   | FuncStat   !Ident [Ident] JStgStat          -- ^ an explicit function definition-  deriving (Eq, Typeable, Generic)+  deriving (Eq, Generic)  -- | A Label used for 'JStgStat', specifically 'BreakStat', 'ContinueStat' and of -- course 'LabelStat'@@ -144,7 +149,7 @@   | UOpExpr    UOp JStgExpr               -- ^ Unary Expressions   | IfExpr     JStgExpr JStgExpr JStgExpr  -- ^ If-expression   | ApplExpr   JStgExpr [JStgExpr]         -- ^ Application-  deriving (Eq, Typeable, Generic)+  deriving (Eq, Generic)  instance Outputable JStgExpr where   ppr x = case x of@@ -233,7 +238,6 @@ pattern LAnd :: JStgExpr -> JStgExpr -> JStgExpr pattern LAnd x y = InfixExpr LAndOp x y - -- | pattern synonym to create integer values pattern Int :: Integer -> JStgExpr pattern Int x = ValExpr (JInt x)@@ -265,7 +269,7 @@   | JBool    Bool                       -- ^ A Boolean   | JHash    (UniqMap FastString JStgExpr) -- ^ A JS HashMap: @{"foo": 0}@   | JFunc    [Ident] JStgStat              -- ^ A function-  deriving (Eq, Typeable, Generic)+  deriving (Eq, Generic)  -------------------------------------------------------------------------------- --                            Operators@@ -296,7 +300,7 @@   | LOrOp           -- ^ Logical Or:             ||   | InstanceofOp    -- ^ @instanceof@   | InOp            -- ^ @in@-  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)+  deriving (Show, Eq, Ord, Enum, Data, Generic)  instance NFData Op @@ -315,7 +319,7 @@   | PostIncOp       -- ^ Postfix Increment: @x++@   | PreDecOp        -- ^ Prefix Decrement:  @--x@   | PostDecOp       -- ^ Postfix Decrement: @x--@-  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)+  deriving (Show, Eq, Ord, Enum, Data, Generic)  instance NFData UOp @@ -324,10 +328,14 @@   = AssignOp    -- ^ Vanilla  Assignment: =   | AddAssignOp -- ^ Addition Assignment: +=   | SubAssignOp -- ^ Subtraction Assignment: -=-  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)+  deriving (Show, Eq, Ord, Enum, Data, Generic)  instance NFData AOp --- | construct a JS variable reference-var :: FastString -> JStgExpr-var = Var . global+-- | construct a JS reference, intended to refer to a global name+global :: FastString -> JStgExpr+global = Var . name++-- | construct a JS reference, intended to refer to a local name+local :: FastString -> JStgExpr+local = Var . name
compiler/GHC/JS/Make.hs view
@@ -107,11 +107,10 @@   , off8, off16, off32, off64   , mask8, mask16   , signExtend8, signExtend16-  , typeof+  , typeOf   , returnStack, assignAllEqual, assignAll, assignAllReverseOrder   , declAssignAll   , nullStat, (.^)-  , trace   -- ** Hash combinators   , jhEmpty   , jhSingle@@ -131,7 +130,8 @@   -- $math   , math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin,     math_atan, math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh,-    math_cosh, math_sinh, math_tanh, math_expm1, math_log1p, math_fround+    math_cosh, math_sinh, math_tanh, math_expm1, math_log1p, math_fround,+    math_min, math_max   -- * Statement helpers   , Solo(..)   , decl@@ -182,8 +182,8 @@     toJExpr _ = ValExpr $ JList []  instance ToJExpr Bool where-    toJExpr True  = var "true"-    toJExpr False = var "false"+    toJExpr True  = global "true"+    toJExpr False = global "false"  instance ToJExpr JVal where     toJExpr = ValExpr@@ -376,7 +376,7 @@ jTryCatchFinally c f f2 = do i <- newIdent                              return $ TryStat (c i) i (f i) (f2 i) --- | Convert a ShortText to a Javascript String+-- | Convert a FastString to a Javascript String jString :: FastString -> JStgExpr jString = toJExpr @@ -447,8 +447,8 @@ infixl 9 .<<., .>>., .>>>.  -- | Given a 'JStgExpr', return the its type.-typeof :: JStgExpr -> JStgExpr-typeof = UOpExpr TypeofOp+typeOf :: JStgExpr -> JStgExpr+typeOf = UOpExpr TypeofOp  -- | JS if-expression --@@ -494,15 +494,15 @@ if01 :: JStgExpr -> JStgExpr if01 e = IfExpr e zero_ one_ --- | an expression application, see related 'appS'+-- | an application expression, see related 'appS' -- -- > app f xs ==> f(xs) app :: FastString -> [JStgExpr] -> JStgExpr-app f xs = ApplExpr (var f) xs+app f xs = ApplExpr (global f) xs  -- | A statement application, see the expression form 'app' appS :: FastString -> [JStgExpr] -> JStgStat-appS f xs = ApplStat (var f) xs+appS f xs = ApplStat (global f) xs  -- | Return a 'JStgExpr' returnS :: JStgExpr -> JStgStat@@ -577,7 +577,7 @@ -- -- > obj .^ prop ==> obj.prop (.^) :: JStgExpr -> FastString -> JStgExpr-obj .^ prop = SelExpr obj (global prop)+obj .^ prop = SelExpr obj (name prop) infixl 8 .^  -- | Assign a variable to an expression@@ -614,10 +614,7 @@ declAssignAll :: [Ident] -> [JStgExpr] -> JStgStat declAssignAll xs ys = mconcat (zipWith (||=) xs ys) -trace :: ToJExpr a => a -> JStgStat-trace ex = appS "h$log" [toJExpr ex] - -------------------------------------------------------------------------------- --                             Literals --------------------------------------------------------------------------------@@ -627,7 +624,7 @@  -- | The JS literal 'null' null_ :: JStgExpr-null_ = var "null"+null_ = global "null"  -- | The JS literal 0 zero_ :: JStgExpr@@ -647,7 +644,7 @@  -- | The JS literal 'undefined' undefined_ :: JStgExpr-undefined_ = var "undefined"+undefined_ = global "undefined"  -- | The JS literal 'true' true_ :: JStgExpr@@ -658,7 +655,7 @@ false_ = ValExpr (JBool False)  returnStack :: JStgStat-returnStack = ReturnStat (ApplExpr (var "h$rs") [])+returnStack = ReturnStat (ApplExpr (global "h$rs") [])   --------------------------------------------------------------------------------@@ -669,14 +666,15 @@ -- is the sole math introduction function.  math :: JStgExpr-math = var "Math"+math = global "Math"  math_ :: FastString -> [JStgExpr] -> JStgExpr math_ op args = ApplExpr (math .^ op) args  math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin, math_atan,   math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh, math_sign,-  math_sinh, math_cosh, math_tanh, math_expm1, math_log1p, math_fround+  math_sinh, math_cosh, math_tanh, math_expm1, math_log1p, math_fround,+  math_min, math_max   :: [JStgExpr] -> JStgExpr math_log   = math_ "log" math_sin   = math_ "sin"@@ -699,6 +697,8 @@ math_expm1 = math_ "expm1" math_log1p = math_ "log1p" math_fround = math_ "fround"+math_min    = math_ "min"+math_max    = math_ "max"  instance Num JStgExpr where     x + y = InfixExpr AddOp x y
compiler/GHC/JS/Ppr.hs view
@@ -33,7 +33,7 @@ -- * Design -- --     This module follows the architecture and style of the other backends in---     GHC: it intances Outputable for the relevant types, creates a class that+--     GHC: it instances Outputable for the relevant types, creates a class that --     describes a morphism from the IR domain to JavaScript concrete Syntax and --     then generates that syntax on a case by case basis. --
compiler/GHC/JS/Syntax.hs view
@@ -129,7 +129,7 @@   | BreakStat (Maybe JLabel)           -- ^ Break   | ContinueStat (Maybe JLabel)        -- ^ Continue   | FuncStat   !Ident [Ident] JStat    -- ^ an explicit function definition-  deriving (Eq, Typeable, Generic)+  deriving (Eq, Generic)  -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of -- course 'LabelStat'@@ -168,7 +168,7 @@   | UOpExpr    UOp JExpr         -- ^ Unary Expressions   | IfExpr     JExpr JExpr JExpr -- ^ If-expression   | ApplExpr   JExpr [JExpr]     -- ^ Application-  deriving (Eq, Typeable, Generic)+  deriving (Eq, Generic)  -- * Useful pattern synonyms to ease programming with the deeply embedded JS --   AST. Each pattern wraps @UOp@ and @Op@ into a @JExpr@s to save typing and@@ -274,7 +274,7 @@   | JBool    Bool         -- ^ A Boolean   | JHash    (UniqMap FastString JExpr) -- ^ A JS HashMap: @{"foo": 0}@   | JFunc    [Ident] JStat             -- ^ A function-  deriving (Eq, Typeable, Generic)+  deriving (Eq, Generic)   --------------------------------------------------------------------------------@@ -307,7 +307,7 @@   | LOrOp           -- ^ Logical Or:             ||   | InstanceofOp    -- ^ @instanceof@   | InOp            -- ^ @in@-  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)+  deriving (Show, Eq, Ord, Enum, Data, Generic)  instance NFData Op @@ -326,7 +326,7 @@   | PostIncOp       -- ^ Postfix Increment: @x++@   | PreDecOp        -- ^ Prefix Decrement:  @--x@   | PostDecOp       -- ^ Postfix Decrement: @x--@-  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)+  deriving (Show, Eq, Ord, Enum, Data, Generic)  instance NFData UOp @@ -335,13 +335,13 @@   = AssignOp    -- ^ Vanilla  Assignment: =   | AddAssignOp -- ^ Addition Assignment: +=   | SubAssignOp -- ^ Subtraction Assignment: -=-  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)+  deriving (Show, Eq, Ord, Enum, Data, Generic)  instance NFData AOp  -- | construct a JS variable reference var :: FastString -> JExpr-var = Var . global+var = Var . name  -- | The JS literal 'true' true_ :: JExpr
compiler/GHC/Linker/Types.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE LambdaCase #-}+ ----------------------------------------------------------------------------- -- -- Types for the linkers and the loader@@ -5,7 +8,6 @@ -- (c) The University of Glasgow 2019 -- ------------------------------------------------------------------------------{-# LANGUAGE TypeApplications #-} module GHC.Linker.Types    ( Loader (..)    , LoaderState (..)@@ -16,47 +18,57 @@    , ClosureEnv    , emptyClosureEnv    , extendClosureEnv-   , Linkable(..)    , LinkableSet    , mkLinkableSet    , unionLinkableSet    , ObjFile-   , Unlinked(..)    , SptEntry(..)-   , isObjectLinkable-   , linkableObjs-   , isObject-   , nameOfObject-   , nameOfObject_maybe-   , isInterpretable-   , byteCodeOfObject    , LibrarySpec(..)    , LoadedPkgInfo(..)    , PkgsLoaded++   -- * Linkable+   , Linkable(..)+   , LinkablePart(..)+   , LinkableObjectSort (..)+   , linkableIsNativeCodeOnly+   , linkableObjs+   , linkableLibs+   , linkableFiles+   , linkableBCOs+   , linkableNativeParts+   , linkablePartitionParts+   , linkablePartPath+   , linkablePartAllBCOs+   , isNativeCode+   , isNativeLib+   , linkableFilterByteCode+   , linkableFilterNative+   , partitionLinkables    ) where  import GHC.Prelude import GHC.Unit                ( UnitId, Module ) import GHC.ByteCode.Types      ( ItblEnv, AddrEnv, CompiledByteCode )-import GHC.Fingerprint.Type    ( Fingerprint ) import GHCi.RemoteTypes        ( ForeignHValue, RemotePtr ) import GHCi.Message            ( LoadedDLL ) -import GHC.Types.Var           ( Id ) import GHC.Types.Name.Env      ( NameEnv, emptyNameEnv, extendNameEnvList, filterNameEnv ) import GHC.Types.Name          ( Name )+import GHC.Types.SptEntry  import GHC.Utils.Outputable-import GHC.Utils.Panic  import Control.Concurrent.MVar import Data.Time               ( UTCTime )-import Data.Maybe import GHC.Unit.Module.Env import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.WholeCoreBindings+import Data.Maybe (mapMaybe)+import Data.List.NonEmpty (NonEmpty, nonEmpty)+import qualified Data.List.NonEmpty as NE   {- **********************************************************************@@ -162,7 +174,7 @@   , itbl_env    :: !ItblEnv       -- ^ The current global mapping from RdrNames of DataCons to       -- info table addresses.-      -- When a new Unlinked is linked into the running image, or an existing+      -- When a new LinkablePart is linked into the running image, or an existing       -- module in the image is replaced, the itbl_env must be updated       -- appropriately. @@ -208,15 +220,17 @@   -- | Information we can use to dynamically link modules into the compiler-data Linkable = LM {-  linkableTime     :: !UTCTime,         -- ^ Time at which this linkable was built-                                        -- (i.e. when the bytecodes were produced,-                                        --       or the mod date on the files)-  linkableModule   :: !Module,          -- ^ The linkable module itself-  linkableUnlinked :: [Unlinked]-    -- ^ Those files and chunks of code we have yet to link.-    ---    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.+data Linkable = Linkable+  { linkableTime     :: !UTCTime+      -- ^ Time at which this linkable was built+      -- (i.e. when the bytecodes were produced,+      --       or the mod date on the files)++  , linkableModule   :: !Module+      -- ^ The linkable module itself++  , linkableParts :: NonEmpty LinkablePart+    -- ^ Files and chunks of code to link.  }  type LinkableSet = ModuleEnv Linkable@@ -224,6 +238,9 @@ mkLinkableSet :: [Linkable] -> LinkableSet mkLinkableSet ls = mkModuleEnv [(linkableModule l, l) | l <- ls] +-- | Union of LinkableSets.+--+-- In case of conflict, keep the most recent Linkable (as per linkableTime) unionLinkableSet :: LinkableSet -> LinkableSet -> LinkableSet unionLinkableSet = plusModuleEnv_C go   where@@ -232,85 +249,200 @@       | otherwise = l2  instance Outputable Linkable where-  ppr (LM when_made mod unlinkeds)-     = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)-       $$ nest 3 (ppr unlinkeds)+  ppr (Linkable when_made mod parts)+     = (text "Linkable" <+> parens (text (show when_made)) <+> ppr mod)+       $$ nest 3 (ppr parts)  type ObjFile = FilePath +-- | Classify the provenance of @.o@ products.+data LinkableObjectSort =+  -- | The object is the final product for a module.+  -- When linking splices, its file extension will be adapted to the+  -- interpreter's way if needed.+  ModuleObject+  |+  -- | The object was created from generated code for foreign stubs or foreign+  -- sources added by the user.+  -- Its file extension must be preserved, since there are no objects for+  -- alternative ways available.+  ForeignObject+ -- | Objects which have yet to be linked by the compiler-data Unlinked-  = DotO ObjFile       -- ^ An object file (.o)-  | DotA FilePath      -- ^ Static archive file (.a)-  | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)-  | CoreBindings WholeCoreBindings -- ^ Serialised core which we can turn into BCOs (or object files), or used by some other backend-                       -- See Note [Interface Files with Core Definitions]-  | LoadedBCOs [Unlinked] -- ^ A list of BCOs, but hidden behind extra indirection to avoid-                          -- being too strict.+data LinkablePart+  = DotO+      ObjFile+      -- ^ An object file (.o)+      LinkableObjectSort+      -- ^ Whether the object is an internal, intermediate build product that+      -- should not be adapted to the interpreter's way. Used for foreign stubs+      -- loaded from interfaces.++  | DotA FilePath+      -- ^ Static archive file (.a)++  | DotDLL FilePath+      -- ^ Dynamically linked library file (.so, .dll, .dylib)++  | CoreBindings WholeCoreBindings+      -- ^ Serialised core which we can turn into BCOs (or object files), or+      -- used by some other backend See Note [Interface Files with Core+      -- Definitions]++  | LazyBCOs+      CompiledByteCode+      -- ^ Some BCOs generated on-demand when forced. This is used for+      -- WholeCoreBindings, see Note [Interface Files with Core Definitions]+      [FilePath]+      -- ^ Objects containing foreign stubs and files+   | BCOs CompiledByteCode-         [SptEntry]    -- ^ A byte-code object, lives only in memory. Also-                       -- carries some static pointer table entries which-                       -- should be loaded along with the BCOs.-                       -- See Note [Grand plan for static forms] in-                       -- "GHC.Iface.Tidy.StaticPtrTable".+    -- ^ A byte-code object, lives only in memory. -instance Outputable Unlinked where-  ppr (DotO path)   = text "DotO" <+> text path-  ppr (DotA path)   = text "DotA" <+> text path-  ppr (DotDLL path) = text "DotDLL" <+> text path-  ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt-  ppr (LoadedBCOs{})  = text "LoadedBCOs"-  ppr (CoreBindings {})       = text "FI"+instance Outputable LinkablePart where+  ppr (DotO path sort)   = text "DotO" <+> text path <+> pprSort sort+    where+      pprSort = \case+        ModuleObject -> empty+        ForeignObject -> brackets (text "foreign")+  ppr (DotA path)       = text "DotA" <+> text path+  ppr (DotDLL path)     = text "DotDLL" <+> text path+  ppr (BCOs bco)        = text "BCOs" <+> ppr bco+  ppr (LazyBCOs{})      = text "LazyBCOs"+  ppr (CoreBindings {}) = text "CoreBindings" --- | An entry to be inserted into a module's static pointer table.--- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable".-data SptEntry = SptEntry Id Fingerprint+-- | Return true if the linkable only consists of native code (no BCO)+linkableIsNativeCodeOnly :: Linkable -> Bool+linkableIsNativeCodeOnly l = all isNativeCode (NE.toList (linkableParts l)) -instance Outputable SptEntry where-  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr+-- | List the BCOs parts of a linkable.+--+-- This excludes the LazyBCOs and the CoreBindings parts+linkableBCOs :: Linkable -> [CompiledByteCode]+linkableBCOs l = [ cbc | BCOs cbc <- NE.toList (linkableParts l) ] +-- | List the native linkable parts (.o/.so/.dll) of a linkable+linkableNativeParts :: Linkable -> [LinkablePart]+linkableNativeParts l = NE.filter isNativeCode (linkableParts l) -isObjectLinkable :: Linkable -> Bool-isObjectLinkable l = not (null unlinked) && all isObject unlinked-  where unlinked = linkableUnlinked l-        -- A linkable with no Unlinked's is treated as a BCO.  We can-        -- generate a linkable with no Unlinked's as a result of-        -- compiling a module in NoBackend mode, and this choice-        -- happens to work well with checkStability in module GHC.+-- | Split linkable parts into (native code parts, BCOs parts)+linkablePartitionParts :: Linkable -> ([LinkablePart],[LinkablePart])+linkablePartitionParts l = NE.partition isNativeCode (linkableParts l) +-- | List the native objects (.o) of a linkable linkableObjs :: Linkable -> [FilePath]-linkableObjs l = [ f | DotO f <- linkableUnlinked l ]+linkableObjs l = concatMap linkablePartObjectPaths (linkableParts l) +-- | List the native libraries (.so/.dll) of a linkable+linkableLibs :: Linkable -> [LinkablePart]+linkableLibs l = NE.filter isNativeLib (linkableParts l)++-- | List the paths of the native objects and libraries (.o/.so/.dll)+linkableFiles :: Linkable -> [FilePath]+linkableFiles l = concatMap linkablePartNativePaths (NE.toList (linkableParts l))+ ------------------------------------------- --- | Is this an actual file on disk we can link in somehow?-isObject :: Unlinked -> Bool-isObject (DotO _)   = True-isObject (DotA _)   = True-isObject (DotDLL _) = True-isObject _          = False+-- | Is the part a native object or library? (.o/.so/.dll)+isNativeCode :: LinkablePart -> Bool+isNativeCode = \case+  DotO {}         -> True+  DotA {}         -> True+  DotDLL {}       -> True+  BCOs {}         -> False+  LazyBCOs{}      -> False+  CoreBindings {} -> False --- | Is this a bytecode linkable with no file on disk?-isInterpretable :: Unlinked -> Bool-isInterpretable = not . isObject+-- | Is the part a native library? (.so/.dll)+isNativeLib :: LinkablePart -> Bool+isNativeLib = \case+  DotO {}         -> False+  DotA {}         -> True+  DotDLL {}       -> True+  BCOs {}         -> False+  LazyBCOs{}      -> False+  CoreBindings {} -> False -nameOfObject_maybe :: Unlinked -> Maybe FilePath-nameOfObject_maybe (DotO fn)   = Just fn-nameOfObject_maybe (DotA fn)   = Just fn-nameOfObject_maybe (DotDLL fn) = Just fn-nameOfObject_maybe (CoreBindings {}) = Nothing-nameOfObject_maybe (LoadedBCOs{}) = Nothing-nameOfObject_maybe (BCOs {})   = Nothing+-- | Get the FilePath of linkable part (if applicable)+linkablePartPath :: LinkablePart -> Maybe FilePath+linkablePartPath = \case+  DotO fn _       -> Just fn+  DotA fn         -> Just fn+  DotDLL fn       -> Just fn+  CoreBindings {} -> Nothing+  LazyBCOs {}     -> Nothing+  BCOs {}         -> Nothing --- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object-nameOfObject :: Unlinked -> FilePath-nameOfObject o = fromMaybe (pprPanic "nameOfObject" (ppr o)) (nameOfObject_maybe o)+-- | Return the paths of all object code files (.o, .a, .so) contained in this+-- 'LinkablePart'.+linkablePartNativePaths :: LinkablePart -> [FilePath]+linkablePartNativePaths = \case+  DotO fn _       -> [fn]+  DotA fn         -> [fn]+  DotDLL fn       -> [fn]+  CoreBindings {} -> []+  LazyBCOs _ fos  -> fos+  BCOs {}         -> [] --- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable-byteCodeOfObject :: Unlinked -> [CompiledByteCode]-byteCodeOfObject (BCOs bc _) = [bc]-byteCodeOfObject (LoadedBCOs ul) = concatMap byteCodeOfObject ul-byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)+-- | Return the paths of all object files (.o) contained in this 'LinkablePart'.+linkablePartObjectPaths :: LinkablePart -> [FilePath]+linkablePartObjectPaths = \case+  DotO fn _ -> [fn]+  DotA _ -> []+  DotDLL _ -> []+  CoreBindings {} -> []+  LazyBCOs _ fos -> fos+  BCOs {} -> []++-- | Retrieve the compiled byte-code from the linkable part.+--+-- Contrary to linkableBCOs, this includes byte-code from LazyBCOs.+linkablePartAllBCOs :: LinkablePart -> [CompiledByteCode]+linkablePartAllBCOs = \case+  BCOs bco    -> [bco]+  LazyBCOs bcos _ -> [bcos]+  _           -> []++linkableFilter :: (LinkablePart -> [LinkablePart]) -> Linkable -> Maybe Linkable+linkableFilter f linkable = do+  new <- nonEmpty (concatMap f (linkableParts linkable))+  Just linkable {linkableParts = new}++linkablePartNative :: LinkablePart -> [LinkablePart]+linkablePartNative = \case+  u@DotO {}  -> [u]+  u@DotA {} -> [u]+  u@DotDLL {} -> [u]+  LazyBCOs _ os -> [DotO f ForeignObject | f <- os]+  _ -> []++linkablePartByteCode :: LinkablePart -> [LinkablePart]+linkablePartByteCode = \case+  u@BCOs {}  -> [u]+  LazyBCOs bcos _ -> [BCOs bcos]+  _ -> []++-- | Transform the 'LinkablePart' list in this 'Linkable' to contain only+-- object code files (.o, .a, .so) without 'LazyBCOs'.+-- If no 'LinkablePart' remains, return 'Nothing'.+linkableFilterNative :: Linkable -> Maybe Linkable+linkableFilterNative = linkableFilter linkablePartNative++-- | Transform the 'LinkablePart' list in this 'Linkable' to contain only byte+-- code without 'LazyBCOs'.+-- If no 'LinkablePart' remains, return 'Nothing'.+linkableFilterByteCode :: Linkable -> Maybe Linkable+linkableFilterByteCode = linkableFilter linkablePartByteCode++-- | Split the 'LinkablePart' lists in each 'Linkable' into only object code+-- files (.o, .a, .so) and only byte code, without 'LazyBCOs', and return two+-- lists containing the nonempty 'Linkable's for each.+partitionLinkables :: [Linkable] -> ([Linkable], [Linkable])+partitionLinkables linkables =+  (+    mapMaybe linkableFilterNative linkables,+    mapMaybe linkableFilterByteCode linkables+  )  {- **********************************************************************
compiler/GHC/Parser.y view
@@ -476,4099 +476,4219 @@ -}  {- Note [%shift: activation -> {- empty -}]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Context:-    sigdecl -> '{-# INLINE' . activation qvarcon '#-}'-    activation -> {- empty -}-    activation -> explicit_activation--Example:--    {-# INLINE [0] Something #-}--Ambiguity:-    We don't know whether the '[' is the start of the activation or the beginning-    of the [] data constructor.-    We parse this as having '[0]' activation for inlining 'Something', rather than-    empty activation and inlining '[0] Something'.--}--{- Note [Parser API Annotations]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-A lot of the productions are now cluttered with calls to-aa,am,acs,acsA etc.--These are helper functions to make sure that the locations of the-various keywords such as do / let / in are captured for use by tools-that want to do source to source conversions, such as refactorers or-structured editors.--The helper functions are defined at the bottom of this file.--See-  https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations and-  https://gitlab.haskell.org/ghc/ghc/wikis/ghc-ast-annotations-for some background.---}--{- Note [Parsing lists]-~~~~~~~~~~~~~~~~~~~~~~~-You might be wondering why we spend so much effort encoding our lists this-way:--importdecls-        : importdecls ';' importdecl-        | importdecls ';'-        | importdecl-        | {- empty -}--This might seem like an awfully roundabout way to declare a list; plus, to add-insult to injury you have to reverse the results at the end.  The answer is that-left recursion prevents us from running out of stack space when parsing long-sequences. See:-https://haskell-happy.readthedocs.io/en/latest/using.html#parsing-sequences-for more guidance.--By adding/removing branches, you can affect what lists are accepted.  Here-are the most common patterns, rewritten as regular expressions for clarity:--    -- Equivalent to: ';'* (x ';'+)* x?  (can be empty, permits leading/trailing semis)-    xs : xs ';' x-       | xs ';'-       | x-       | {- empty -}--    -- Equivalent to x (';' x)* ';'*  (non-empty, permits trailing semis)-    xs : xs ';' x-       | xs ';'-       | x--    -- Equivalent to ';'* alts (';' alts)* ';'* (non-empty, permits leading/trailing semis)-    alts : alts1-         | ';' alts-    alts1 : alts1 ';' alt-          | alts1 ';'-          | alt--    -- Equivalent to x (',' x)+ (non-empty, no trailing semis)-    xs : x-       | x ',' xs--}--%token- '_'            { L _ ITunderscore }            -- Haskell keywords- 'as'           { L _ ITas }- 'case'         { L _ ITcase }- 'class'        { L _ ITclass }- 'data'         { L _ ITdata }- 'default'      { L _ ITdefault }- 'deriving'     { L _ ITderiving }- 'else'         { L _ ITelse }- 'hiding'       { L _ IThiding }- 'if'           { L _ ITif }- 'import'       { L _ ITimport }- 'in'           { L _ ITin }- 'infix'        { L _ ITinfix }- 'infixl'       { L _ ITinfixl }- 'infixr'       { L _ ITinfixr }- 'instance'     { L _ ITinstance }- 'let'          { L _ ITlet }- 'module'       { L _ ITmodule }- 'newtype'      { L _ ITnewtype }- 'of'           { L _ ITof }- 'qualified'    { L _ ITqualified }- 'then'         { L _ ITthen }- 'type'         { L _ ITtype }- 'where'        { L _ ITwhere }-- 'forall'       { L _ (ITforall _) }                -- GHC extension keywords- 'foreign'      { L _ ITforeign }- 'export'       { L _ ITexport }- 'label'        { L _ ITlabel }- 'dynamic'      { L _ ITdynamic }- 'safe'         { L _ ITsafe }- 'interruptible' { L _ ITinterruptible }- 'unsafe'       { L _ ITunsafe }- 'family'       { L _ ITfamily }- 'role'         { L _ ITrole }- 'stdcall'      { L _ ITstdcallconv }- 'ccall'        { L _ ITccallconv }- 'capi'         { L _ ITcapiconv }- 'prim'         { L _ ITprimcallconv }- 'javascript'   { L _ ITjavascriptcallconv }- 'proc'         { L _ ITproc }          -- for arrow notation extension- 'rec'          { L _ ITrec }           -- for arrow notation extension- 'group'    { L _ ITgroup }     -- for list transform extension- 'by'       { L _ ITby }        -- for list transform extension- 'using'    { L _ ITusing }     -- for list transform extension- 'pattern'      { L _ ITpattern } -- for pattern synonyms- 'static'       { L _ ITstatic }  -- for static pointers extension- 'stock'        { L _ ITstock }    -- for DerivingStrategies extension- 'anyclass'     { L _ ITanyclass } -- for DerivingStrategies extension- 'via'          { L _ ITvia }      -- for DerivingStrategies extension-- 'unit'         { L _ ITunit }- 'signature'    { L _ ITsignature }- 'dependency'   { L _ ITdependency }-- '{-# INLINE'             { L _ (ITinline_prag _ _ _) } -- INLINE or INLINABLE- '{-# OPAQUE'             { L _ (ITopaque_prag _) }- '{-# SPECIALISE'         { L _ (ITspec_prag _) }- '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }- '{-# SOURCE'             { L _ (ITsource_prag _) }- '{-# RULES'              { L _ (ITrules_prag _) }- '{-# SCC'                { L _ (ITscc_prag _)}- '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }- '{-# WARNING'            { L _ (ITwarning_prag _) }- '{-# UNPACK'             { L _ (ITunpack_prag _) }- '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }- '{-# ANN'                { L _ (ITann_prag _) }- '{-# MINIMAL'            { L _ (ITminimal_prag _) }- '{-# CTYPE'              { L _ (ITctype _) }- '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }- '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }- '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }- '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }- '{-# COMPLETE'           { L _ (ITcomplete_prag _)   }- '#-}'                    { L _ ITclose_prag }-- '..'           { L _ ITdotdot }                        -- reserved symbols- ':'            { L _ ITcolon }- '::'           { L _ (ITdcolon _) }- '='            { L _ ITequal }- '\\'           { L _ ITlam }- 'lcase'        { L _ ITlcase }- 'lcases'       { L _ ITlcases }- '|'            { L _ ITvbar }- '<-'           { L _ (ITlarrow _) }- '->'           { L _ (ITrarrow _) }- '->.'          { L _ ITlolly }- TIGHT_INFIX_AT { L _ ITat }- '=>'           { L _ (ITdarrow _) }- '-'            { L _ ITminus }- PREFIX_TILDE   { L _ ITtilde }- PREFIX_BANG    { L _ ITbang }- PREFIX_MINUS   { L _ ITprefixminus }- '*'            { L _ (ITstar _) }- '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation- '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation- '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation- '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation- '.'            { L _ ITdot }- PREFIX_PROJ    { L _ (ITproj True) }               -- RecordDotSyntax- TIGHT_INFIX_PROJ { L _ (ITproj False) }            -- RecordDotSyntax- PREFIX_AT      { L _ ITtypeApp }- PREFIX_PERCENT { L _ ITpercent }                   -- for linear types-- '{'            { L _ ITocurly }                        -- special symbols- '}'            { L _ ITccurly }- vocurly        { L _ ITvocurly } -- virtual open curly (from layout)- vccurly        { L _ ITvccurly } -- virtual close curly (from layout)- '['            { L _ ITobrack }- ']'            { L _ ITcbrack }- '('            { L _ IToparen }- ')'            { L _ ITcparen }- '(#'           { L _ IToubxparen }- '#)'           { L _ ITcubxparen }- '(|'           { L _ (IToparenbar _) }- '|)'           { L _ (ITcparenbar _) }- ';'            { L _ ITsemi }- ','            { L _ ITcomma }- '`'            { L _ ITbackquote }- SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x-- VARID          { L _ (ITvarid    _) }          -- identifiers- CONID          { L _ (ITconid    _) }- VARSYM         { L _ (ITvarsym   _) }- CONSYM         { L _ (ITconsym   _) }- QVARID         { L _ (ITqvarid   _) }- QCONID         { L _ (ITqconid   _) }- QVARSYM        { L _ (ITqvarsym  _) }- QCONSYM        { L _ (ITqconsym  _) }--- -- QualifiedDo- DO             { L _ (ITdo  _) }- MDO            { L _ (ITmdo _) }-- IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension- LABELVARID     { L _ (ITlabelvarid _ _) }-- CHAR           { L _ (ITchar   _ _) }- STRING         { L _ (ITstring _ _) }- INTEGER        { L _ (ITinteger _) }- RATIONAL       { L _ (ITrational _) }-- PRIMCHAR       { L _ (ITprimchar   _ _) }- PRIMSTRING     { L _ (ITprimstring _ _) }- PRIMINTEGER    { L _ (ITprimint    _ _) }- PRIMWORD       { L _ (ITprimword   _ _) }- PRIMINTEGER8   { L _ (ITprimint8   _ _) }- PRIMINTEGER16  { L _ (ITprimint16  _ _) }- PRIMINTEGER32  { L _ (ITprimint32  _ _) }- PRIMINTEGER64  { L _ (ITprimint64  _ _) }- PRIMWORD8      { L _ (ITprimword8  _ _) }- PRIMWORD16     { L _ (ITprimword16 _ _) }- PRIMWORD32     { L _ (ITprimword32 _ _) }- PRIMWORD64     { L _ (ITprimword64 _ _) }- PRIMFLOAT      { L _ (ITprimfloat  _) }- PRIMDOUBLE     { L _ (ITprimdouble _) }---- Template Haskell-'[|'            { L _ (ITopenExpQuote _ _) }-'[p|'           { L _ ITopenPatQuote  }-'[t|'           { L _ ITopenTypQuote  }-'[d|'           { L _ ITopenDecQuote  }-'|]'            { L _ (ITcloseQuote _) }-'[||'           { L _ (ITopenTExpQuote _) }-'||]'           { L _ ITcloseTExpQuote  }-PREFIX_DOLLAR   { L _ ITdollar }-PREFIX_DOLLAR_DOLLAR { L _ ITdollardollar }-TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T-TH_QUASIQUOTE   { L _ (ITquasiQuote _) }-TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }--%monad { P } { >>= } { return }-%lexer { (lexer True) } { L _ ITeof }-  -- Replace 'lexer' above with 'lexerDbg'-  -- to dump the tokens fed to the parser.-%tokentype { (Located Token) }---- Exported parsers-%name parseModuleNoHaddock module-%name parseSignatureNoHaddock signature-%name parseImport importdecl-%name parseStatement e_stmt-%name parseDeclaration topdecl-%name parseExpression exp-%name parsePattern pat-%name parseTypeSignature sigdecl-%name parseStmt   maybe_stmt-%name parseIdentifier  identifier-%name parseType ktype-%name parseBackpack backpack-%partial parseHeader header-%%---------------------------------------------------------------------------------- Identifiers; one of the entry points-identifier :: { LocatedN RdrName }-        : qvar                          { $1 }-        | qcon                          { $1 }-        | qvarop                        { $1 }-        | qconop                        { $1 }-    | '(' '->' ')'      {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)-                                (NameAnnRArrow (isUnicode $2) (Just $ glAA $1) (glAA $2) (Just $ glAA $3) []) }-    | '->'              {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)-                                (NameAnnRArrow (isUnicode $1) Nothing (glAA $1) Nothing []) }---------------------------------------------------------------------------------- Backpack stuff--backpack :: { [LHsUnit PackageName] }-         : implicit_top units close { fromOL $2 }-         | '{' units '}'            { fromOL $2 }--units :: { OrdList (LHsUnit PackageName) }-         : units ';' unit { $1 `appOL` unitOL $3 }-         | units ';'      { $1 }-         | unit           { unitOL $1 }--unit :: { LHsUnit PackageName }-        : 'unit' pkgname 'where' unitbody-            { sL1 $1 $ HsUnit { hsunitName = $2-                              , hsunitBody = fromOL $4 } }--unitid :: { LHsUnitId PackageName }-        : pkgname                  { sL1 $1 $ HsUnitId $1 [] }-        | pkgname '[' msubsts ']'  { sLL $1 $> $ HsUnitId $1 (fromOL $3) }--msubsts :: { OrdList (LHsModuleSubst PackageName) }-        : msubsts ',' msubst { $1 `appOL` unitOL $3 }-        | msubsts ','        { $1 }-        | msubst             { unitOL $1 }--msubst :: { LHsModuleSubst PackageName }-        : modid '=' moduleid { sLL $1 $> $ (reLoc $1, $3) }-        | modid VARSYM modid VARSYM { sLL $1 $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) }--moduleid :: { LHsModuleId PackageName }-          : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) }-          | unitid ':' modid    { sLL $1 $> $ HsModuleId $1 (reLoc $3) }--pkgname :: { Located PackageName }-        : STRING     { sL1 $1 $ PackageName (getSTRING $1) }-        | litpkgname { sL1 $1 $ PackageName (unLoc $1) }--litpkgname_segment :: { Located FastString }-        : VARID  { sL1 $1 $ getVARID $1 }-        | CONID  { sL1 $1 $ getCONID $1 }-        | special_id { $1 }---- Parse a minus sign regardless of whether -XLexicalNegation is turned on or off.--- See Note [Minus tokens] in GHC.Parser.Lexer-HYPHEN :: { [AddEpAnn] }-      : '-'          { [mj AnnMinus $1 ] }-      | PREFIX_MINUS { [mj AnnMinus $1 ] }-      | VARSYM  {% if (getVARSYM $1 == fsLit "-")-                   then return [mj AnnMinus $1]-                   else do { addError $ mkPlainErrorMsgEnvelope (getLoc $1) $ PsErrExpectedHyphen-                           ; return [] } }---litpkgname :: { Located FastString }-        : litpkgname_segment { $1 }-        -- a bit of a hack, means p - b is parsed same as p-b, enough for now.-        | litpkgname_segment HYPHEN litpkgname  { sLL $1 $> $ concatFS [unLoc $1, fsLit "-", (unLoc $3)] }--mayberns :: { Maybe [LRenaming] }-        : {- empty -} { Nothing }-        | '(' rns ')' { Just (fromOL $2) }--rns :: { OrdList LRenaming }-        : rns ',' rn { $1 `appOL` unitOL $3 }-        | rns ','    { $1 }-        | rn         { unitOL $1 }--rn :: { LRenaming }-        : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) }-        | modid            { sL1 $1    $ Renaming (reLoc $1) Nothing }--unitbody :: { OrdList (LHsUnitDecl PackageName) }-        : '{'     unitdecls '}'   { $2 }-        | vocurly unitdecls close { $2 }--unitdecls :: { OrdList (LHsUnitDecl PackageName) }-        : unitdecls ';' unitdecl { $1 `appOL` unitOL $3 }-        | unitdecls ';'         { $1 }-        | unitdecl              { unitOL $1 }--unitdecl :: { LHsUnitDecl PackageName }-        : 'module' maybe_src modid maybe_warning_pragma maybeexports 'where' body-             -- XXX not accurate-             { sL1 $1 $ DeclD-                 (case snd $2 of-                   NotBoot -> HsSrcFile-                   IsBoot  -> HsBootFile)-                 (reLoc $3)-                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7))) }-        | 'signature' modid maybe_warning_pragma maybeexports 'where' body-             { sL1 $1 $ DeclD-                 HsigFile-                 (reLoc $2)-                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6))) }-        | 'dependency' unitid mayberns-             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2-                                              , idModRenaming = $3-                                              , idSignatureInclude = False }) }-        | 'dependency' 'signature' unitid-             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $3-                                              , idModRenaming = Nothing-                                              , idSignatureInclude = True }) }---------------------------------------------------------------------------------- Module Header---- The place for module deprecation is really too restrictive, but if it--- was allowed at its natural place just before 'module', we get an ugly--- s/r conflict with the second alternative. Another solution would be the--- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,--- either, and DEPRECATED is only expected to be used by people who really--- know what they are doing. :-)--signature :: { Located (HsModule GhcPs) }-       : 'signature' modid maybe_warning_pragma maybeexports 'where' body-             {% fileSrcSpan >>= \ loc ->-                acs loc (\loc cs-> (L loc (HsModule (XModulePs-                                               (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6) [] Nothing) cs)-                                               (thdOf3 $6) $3 Nothing)-                                            (Just $2) $4 (fst $ sndOf3 $6)-                                            (snd $ sndOf3 $6)))-                    ) }--module :: { Located (HsModule GhcPs) }-       : 'module' modid maybe_warning_pragma maybeexports 'where' body-             {% fileSrcSpan >>= \ loc ->-                acsFinal (\cs eof -> (L loc (HsModule (XModulePs-                                                     (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1, mj AnnWhere $5] (fstOf3 $6) [] eof) cs)-                                                     (thdOf3 $6) $3 Nothing)-                                                  (Just $2) $4 (fst $ sndOf3 $6)-                                                  (snd $ sndOf3 $6))-                    )) }-        | body2-                {% fileSrcSpan >>= \ loc ->-                   acsFinal (\cs eof -> (L loc (HsModule (XModulePs-                                                        (EpAnn (spanAsAnchor loc) (AnnsModule [] (fstOf3 $1) [] eof) cs)-                                                        (thdOf3 $1) Nothing Nothing)-                                                     Nothing Nothing-                                                     (fst $ sndOf3 $1) (snd $ sndOf3 $1)))) }--missing_module_keyword :: { () }-        : {- empty -}                           {% pushModuleContext }--implicit_top :: { () }-        : {- empty -}                           {% pushModuleContext }--body    :: { ([TrailingAnn]-             ,([LImportDecl GhcPs], [LHsDecl GhcPs])-             ,EpLayout) }-        :  '{'            top '}'      { (fst $2, snd $2, epExplicitBraces $1 $3) }-        |      vocurly    top close    { (fst $2, snd $2, EpVirtualBraces (getVOCURLY $1)) }--body2   :: { ([TrailingAnn]-             ,([LImportDecl GhcPs], [LHsDecl GhcPs])-             ,EpLayout) }-        :  '{' top '}'                          { (fst $2, snd $2, epExplicitBraces $1 $3) }-        |  missing_module_keyword top close     { ([], snd $2, EpVirtualBraces leftmostColumn) }---top     :: { ([TrailingAnn]-             ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }-        : semis top1                            { (reverse $1, $2) }--top1    :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }-        : importdecls_semi topdecls_cs_semi        { (reverse $1, cvTopDecls $2) }-        | importdecls_semi topdecls_cs             { (reverse $1, cvTopDecls $2) }-        | importdecls                              { (reverse $1, []) }---------------------------------------------------------------------------------- Module declaration & imports only--header  :: { Located (HsModule GhcPs) }-        : 'module' modid maybe_warning_pragma maybeexports 'where' header_body-                {% fileSrcSpan >>= \ loc ->-                   acs loc (\loc cs -> (L loc (HsModule (XModulePs-                                                   (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] [] Nothing) cs)-                                                   EpNoLayout $3 Nothing)-                                                (Just $2) $4 $6 []-                          ))) }-        | 'signature' modid maybe_warning_pragma maybeexports 'where' header_body-                {% fileSrcSpan >>= \ loc ->-                   acs loc (\loc cs -> (L loc (HsModule (XModulePs-                                                   (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] [] Nothing) cs)-                                                   EpNoLayout $3 Nothing)-                                                (Just $2) $4 $6 []-                          ))) }-        | header_body2-                {% fileSrcSpan >>= \ loc ->-                   return (L loc (HsModule (XModulePs noAnn EpNoLayout Nothing Nothing) Nothing Nothing $1 [])) }--header_body :: { [LImportDecl GhcPs] }-        :  '{'            header_top            { $2 }-        |      vocurly    header_top            { $2 }--header_body2 :: { [LImportDecl GhcPs] }-        :  '{' header_top                       { $2 }-        |  missing_module_keyword header_top    { $2 }--header_top :: { [LImportDecl GhcPs] }-        :  semis header_top_importdecls         { $2 }--header_top_importdecls :: { [LImportDecl GhcPs] }-        :  importdecls_semi                     { $1 }-        |  importdecls                          { $1 }---------------------------------------------------------------------------------- The Export List--maybeexports :: { (Maybe (LocatedL [LIE GhcPs])) }-        :  '(' exportlist ')'       {% fmap Just $ amsr (sLL $1 $> (fromOL $ snd $2))-                                        (AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) []) }-        |  {- empty -}              { Nothing }--exportlist :: { ([AddEpAnn], OrdList (LIE GhcPs)) }-        : exportlist1     { ([], $1) }-        | {- empty -}     { ([], nilOL) }--        -- trailing comma:-        | exportlist1 ',' {% case $1 of-                               SnocOL hs t -> do-                                 t' <- addTrailingCommaA t (gl $2)-                                 return ([], snocOL hs t')}-        | ','             { ([mj AnnComma $1], nilOL) }--exportlist1 :: { OrdList (LIE GhcPs) }-        : exportlist1 ',' export_cs-                          {% let ls = $1-                             in if isNilOL ls-                                  then return (ls `appOL` $3)-                                  else case ls of-                                         SnocOL hs t -> do-                                           t' <- addTrailingCommaA t (gl $2)-                                           return (snocOL hs t' `appOL` $3)}-        | export_cs       { $1 }---export_cs :: { OrdList (LIE GhcPs) }-export_cs : export {% return (unitOL $1) }--   -- No longer allow things like [] and (,,,) to be exported-   -- They are built in syntax, always available-export  :: { LIE GhcPs }-        : maybe_warning_pragma qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> }-                                                          ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)-                                                          ; return $ reLoc $ sL span $ impExp } }-        | maybe_warning_pragma 'module' modid            {% do { let { span = (maybe comb2 comb3 $1) $2 $>-                                                                     ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }-                                                          ; locImpExp <- return (sL span (IEModuleContents ($1, [mj AnnModule $2]) $3))-                                                          ; return $ reLoc $ locImpExp } }-        | maybe_warning_pragma 'pattern' qcon            { let span = (maybe comb2 comb3 $1) $2 $>-                                                           in reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) Nothing }--export_subspec :: { Located ([AddEpAnn],ImpExpSubSpec) }-        : {- empty -}             { sL0 ([],ImpExpAbs) }-        | '(' qcnames ')'         {% mkImpExpSubSpec (reverse (snd $2))-                                      >>= \(as,ie) -> return $ sLL $1 $>-                                            (as ++ [mop $1,mcp $3] ++ fst $2, ie) }--qcnames :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) }-  : {- empty -}                   { ([],[]) }-  | qcnames1                      { $1 }--qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) }     -- A reversed list-        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (snd $1) of-                                                    (l@(L la ImpExpQcWildcard):t) ->-                                                       do { l' <- addTrailingCommaA l (gl $2)-                                                          ; return ([mj AnnDotdot (reLoc l),-                                                                     mj AnnComma $2]-                                                                   ,(snd (unLoc $3)  : l' : t)) }-                                                    (l:t) ->-                                                       do { l' <- addTrailingCommaA l (gl $2)-                                                          ; return (fst $1 ++ fst (unLoc $3)-                                                                   , snd (unLoc $3) : l' : t)} }--        -- Annotations re-added in mkImpExpSubSpec-        |  qcname_ext_w_wildcard                   { (fst (unLoc $1),[snd (unLoc $1)]) }---- Variable, data constructor or wildcard--- or tagged type constructor-qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) }-        :  qcname_ext               { sL1 $1 ([],$1) }-        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard)  }--qcname_ext :: { LocatedA ImpExpQcSpec }-        :  qcname                   { sL1a $1 (ImpExpQcName $1) }-        |  'type' oqtycon           {% do { n <- mkTypeImpExp $2-                                          ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }}--qcname  :: { LocatedN RdrName }  -- Variable or type constructor-        :  qvar                 { $1 } -- Things which look like functions-                                       -- Note: This includes record selectors but-                                       -- also (-.->), see #11432-        |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]---------------------------------------------------------------------------------- Import Declarations---- importdecls and topdecls must contain at least one declaration;--- top handles the fact that these may be optional.---- One or more semicolons-semis1  :: { Located [TrailingAnn] }-semis1  : semis1 ';'  { if isZeroWidthSpan (gl $2) then (sL1 $1 $ unLoc $1) else (sLL $1 $> $ AddSemiAnn (glAA $2) : (unLoc $1)) }-        | ';'         { case msemi $1 of-                          [] -> noLoc []-                          ms -> sL1 $1 $ ms }---- Zero or more semicolons-semis   :: { [TrailingAnn] }-semis   : semis ';'   { if isZeroWidthSpan (gl $2) then $1 else (AddSemiAnn (glAA $2) : $1) }-        | {- empty -} { [] }---- No trailing semicolons, non-empty-importdecls :: { [LImportDecl GhcPs] }-importdecls-        : importdecls_semi importdecl-                                { $2 : $1 }---- May have trailing semicolons, can be empty-importdecls_semi :: { [LImportDecl GhcPs] }-importdecls_semi-        : importdecls_semi importdecl semis1-                                {% do { i <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3)-                                      ; return (i : $1)} }-        | {- empty -}           { [] }--importdecl :: { LImportDecl GhcPs }-        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec-                {% do {-                  ; let { ; mPreQual = unLoc $4-                          ; mPostQual = unLoc $7 }-                  ; checkImportDecl mPreQual mPostQual-                  ; let anns-                         = EpAnnImportDecl-                             { importDeclAnnImport    = glAA $1-                             , importDeclAnnPragma    = fst $ fst $2-                             , importDeclAnnSafe      = fst $3-                             , importDeclAnnQualified = fst $ importDeclQualifiedStyle mPreQual mPostQual-                             , importDeclAnnPackage   = fst $5-                             , importDeclAnnAs        = fst $8-                             }-                  ; let loc = (comb5 $1 $6 $7 (snd $8) $9);-                  ; fmap reLoc $ acs loc (\loc cs -> L loc $-                      ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False-                                  , ideclName = $6, ideclPkgQual = snd $5-                                  , ideclSource = snd $2, ideclSafe = snd $3-                                  , ideclQualified = snd $ importDeclQualifiedStyle mPreQual mPostQual-                                  , ideclAs = unLoc (snd $8)-                                  , ideclImportList = unLoc $9 })-                  }-                }---maybe_src :: { ((Maybe (EpaLocation,EpaLocation),SourceText),IsBootInterface) }-        : '{-# SOURCE' '#-}'        { ((Just (glAA $1,glAA $2),getSOURCE_PRAGs $1)-                                      , IsBoot) }-        | {- empty -}               { ((Nothing,NoSourceText),NotBoot) }--maybe_safe :: { (Maybe EpaLocation,Bool) }-        : 'safe'                                { (Just (glAA $1),True) }-        | {- empty -}                           { (Nothing,      False) }--maybe_pkg :: { (Maybe EpaLocation, RawPkgQual) }-        : STRING  {% do { let { pkgFS = getSTRING $1 }-                        ; unless (looksLikePackageName (unpackFS pkgFS)) $-                             addError $ mkPlainErrorMsgEnvelope (getLoc $1) $-                               (PsErrInvalidPackageName pkgFS)-                        ; return (Just (glAA $1), RawPkgQual (StringLiteral (getSTRINGs $1) pkgFS Nothing)) } }-        | {- empty -}                           { (Nothing,NoRawPkgQual) }--optqualified :: { Located (Maybe EpaLocation) }-        : 'qualified'                           { sL1 $1 (Just (glAA $1)) }-        | {- empty -}                           { noLoc Nothing }--maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) }-        : 'as' modid                           { (Just (glAA $1)-                                                 ,sLL $1 $> (Just $2)) }-        | {- empty -}                          { (Nothing,noLoc Nothing) }--maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])) }-        : impspec                  {% let (b, ie) = unLoc $1 in-                                       checkImportSpec ie-                                        >>= \checkedIe ->-                                          return (L (gl $1) (Just (b, checkedIe)))  }-        | {- empty -}              { noLoc Nothing }--impspec :: { Located (ImportListInterpretation, LocatedL [LIE GhcPs]) }-        :  '(' importlist ')'               {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $2)-                                                               (AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) [])-                                                  ; return $ sLL $1 $> (Exactly, es)} }-        |  'hiding' '(' importlist ')'      {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $3)-                                                               (AnnList Nothing (Just $ mop $2) (Just $ mcp $4) (mj AnnHiding $1:fst $3) [])-                                                  ; return $ sLL $1 $> (EverythingBut, es)} }--importlist :: { ([AddEpAnn], OrdList (LIE GhcPs)) }-        : importlist1     { ([], $1) }-        | {- empty -}     { ([], nilOL) }--        -- trailing comma:-        | importlist1 ',' {% case $1 of-                               SnocOL hs t -> do-                                 t' <- addTrailingCommaA t (gl $2)-                                 return ([], snocOL hs t')}-        | ','             { ([mj AnnComma $1], nilOL) }--importlist1 :: { OrdList (LIE GhcPs) }-        : importlist1 ',' import-                          {% let ls = $1-                             in if isNilOL ls-                                  then return (ls `appOL` $3)-                                  else case ls of-                                         SnocOL hs t -> do-                                           t' <- addTrailingCommaA t (gl $2)-                                           return (snocOL hs t' `appOL` $3)}-        | import          { $1 }--import  :: { OrdList (LIE GhcPs) }-        : qcname_ext export_subspec {% fmap (unitOL . reLoc . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }-        | 'module' modid            {% fmap (unitOL . reLoc) $ return (sLL $1 $> (IEModuleContents (Nothing, [mj AnnModule $1]) $2)) }-        | 'pattern' qcon            { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) Nothing }---------------------------------------------------------------------------------- Fixity Declarations--prec    :: { Maybe (Located (SourceText,Int)) }-        : {- empty -}           { Nothing }-        | INTEGER-                 { Just (sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1)))) }--infix   :: { Located FixityDirection }-        : 'infix'                               { sL1 $1 InfixN  }-        | 'infixl'                              { sL1 $1 InfixL  }-        | 'infixr'                              { sL1 $1 InfixR }--ops     :: { Located (OrdList (LocatedN RdrName)) }-        : ops ',' op       {% case (unLoc $1) of-                                SnocOL hs t -> do-                                  t' <- addTrailingCommaN t (gl $2)-                                  return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) }-        | op               { sL1 $1 (unitOL $1) }---------------------------------------------------------------------------------- Top-Level Declarations---- No trailing semicolons, non-empty-topdecls :: { OrdList (LHsDecl GhcPs) }-        : topdecls_semi topdecl        { $1 `snocOL` $2 }---- May have trailing semicolons, can be empty-topdecls_semi :: { OrdList (LHsDecl GhcPs) }-        : topdecls_semi topdecl semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3)-                                             ; return ($1 `snocOL` t) }}-        | {- empty -}                  { nilOL }----------------------------------------------------------------------------------- Each topdecl accumulates prior comments--- No trailing semicolons, non-empty-topdecls_cs :: { OrdList (LHsDecl GhcPs) }-        : topdecls_cs_semi topdecl_cs        { $1 `snocOL` $2 }---- May have trailing semicolons, can be empty-topdecls_cs_semi :: { OrdList (LHsDecl GhcPs) }-        : topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3)-                                                   ; return ($1 `snocOL` t) }}-        | {- empty -}                  { nilOL }---- Each topdecl accumulates prior comments-topdecl_cs :: { LHsDecl GhcPs }-topdecl_cs : topdecl {% commentsPA $1 }--------------------------------------------------------------------------------topdecl :: { LHsDecl GhcPs }-        : cl_decl                               { L (getLoc $1) (TyClD noExtField (unLoc $1)) }-        | ty_decl                               { L (getLoc $1) (TyClD noExtField (unLoc $1)) }-        | standalone_kind_sig                   { L (getLoc $1) (KindSigD noExtField (unLoc $1)) }-        | inst_decl                             { L (getLoc $1) (InstD noExtField (unLoc $1)) }-        | stand_alone_deriving                  { L (getLoc $1) (DerivD noExtField (unLoc $1)) }-        | role_annot                            { L (getLoc $1) (RoleAnnotD noExtField (unLoc $1)) }-        | 'default' '(' comma_types0 ')'        {% amsA' (sLL $1 $>-                                                    (DefD noExtField (DefaultDecl [mj AnnDefault $1,mop $2,mcp $4] $3))) }-        | 'foreign' fdecl                       {% amsA' (sLL $1 $> ((snd $ unLoc $2) (mj AnnForeign $1:(fst $ unLoc $2)))) }-        | '{-# DEPRECATED' deprecations '#-}'   {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ([mo $1,mc $3], (getDEPRECATED_PRAGs $1)) (fromOL $2))) }-        | '{-# WARNING' warnings '#-}'          {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ([mo $1,mc $3], (getWARNING_PRAGs $1)) (fromOL $2))) }-        | '{-# RULES' rules '#-}'               {% amsA' (sLL $1 $> $ RuleD noExtField (HsRules ([mo $1,mc $3], (getRULES_PRAGs $1)) (reverse $2))) }-        | annotation { $1 }-        | decl_no_th                            { $1 }--        -- Template Haskell Extension-        -- The $(..) form is one possible form of infixexp-        -- but we treat an arbitrary expression just as if-        -- it had a $(..) wrapped around it-        | infixexp                              {% runPV (unECP $1) >>= \ $1 ->-                                                       commentsPA $ mkSpliceDecl $1 }---- Type classes----cl_decl :: { LTyClDecl GhcPs }-        : 'class' tycl_hdr fds where_cls-                {% (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (sndOf3 $ unLoc $4) (thdOf3 $ unLoc $4))-                        (mj AnnClass $1:(fst $ unLoc $3)++(fstOf3 $ unLoc $4)) }---- Type declarations (toplevel)----ty_decl :: { LTyClDecl GhcPs }-           -- ordinary type synonyms-        : 'type' type '=' ktype-                -- Note ktype, not sigtype, on the right of '='-                -- We allow an explicit for-all but we don't insert one-                -- in   type Foo a = (b,b)-                -- Instead we just say b is out of scope-                ---                -- Note the use of type for the head; this allows-                -- infix type constructors to be declared-                {% mkTySynonym (comb2 $1 $4) $2 $4 [mj AnnType $1,mj AnnEqual $3] }--           -- type family declarations-        | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info-                          where_type_family-                -- Note the use of type for the head; this allows-                -- infix type constructors to be declared-                {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3-                                   (snd $ unLoc $4) (snd $ unLoc $5)-                           (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)-                           ++ (fst $ unLoc $5) ++ (fst $ unLoc $6))  }--          -- ordinary data type or newtype declaration-        | type_data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings-                {% mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3-                           Nothing (reverse (snd $ unLoc $4))-                                   (fmap reverse $5)-                           ((fstOf3 $ unLoc $1)++(fst $ unLoc $4)) }-                                   -- We need the location on tycl_hdr in case-                                   -- constrs and deriving are both empty--          -- ordinary GADT declaration-        | type_data_or_newtype capi_ctype tycl_hdr opt_kind_sig-                 gadt_constrlist-                 maybe_derivings-            {% mkTyData (comb5 $1 $3 $4 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3-                            (snd $ unLoc $4) (snd $ unLoc $5)-                            (fmap reverse $6)-                            ((fstOf3 $ unLoc $1)++(fst $ unLoc $4)++(fst $ unLoc $5)) }-                                   -- We need the location on tycl_hdr in case-                                   -- constrs and deriving are both empty--          -- data/newtype family-        | 'data' 'family' type opt_datafam_kind_sig-                {% mkFamDecl (comb4 $1 $2 $3 $4) DataFamily TopLevel $3-                                   (snd $ unLoc $4) Nothing-                          (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }---- standalone kind signature-standalone_kind_sig :: { LStandaloneKindSig GhcPs }-  : 'type' sks_vars '::' sigktype-      {% mkStandaloneKindSig (comb2 $1 $4) (L (gl $2) $ unLoc $2) $4-               [mj AnnType $1,mu AnnDcolon $3]}---- See also: sig_vars-sks_vars :: { Located [LocatedN RdrName] }  -- Returned in reverse order-  : sks_vars ',' oqtycon-      {% case unLoc $1 of-           (h:t) -> do-             h' <- addTrailingCommaN h (gl $2)-             return (sLL $1 $> ($3 : h' : t)) }-  | oqtycon { sL1 $1 [$1] }--inst_decl :: { LInstDecl GhcPs }-        : 'instance' maybe_warning_pragma overlap_pragma inst_type where_inst-       {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $5)-             ; let anns = (mj AnnInstance $1 : (fst $ unLoc $5))-             ; let cid = ClsInstDecl-                                  { cid_ext = ($2, anns, NoAnnSortKey)-                                  , cid_poly_ty = $4, cid_binds = binds-                                  , cid_sigs = mkClassOpSigs sigs-                                  , cid_tyfam_insts = ats-                                  , cid_overlap_mode = $3-                                  , cid_datafam_insts = adts }-             ; amsA' (L (comb3 $1 $4 $5)-                             (ClsInstD { cid_d_ext = noExtField, cid_inst = cid }))-                   } }--           -- type instance declarations-        | 'type' 'instance' ty_fam_inst_eqn-                {% mkTyFamInst (comb2 $1 $3) (unLoc $3)-                        (mj AnnType $1:mj AnnInstance $2:[]) }--          -- data/newtype instance declaration-        | data_or_newtype 'instance' capi_ctype datafam_inst_hdr constrs-                          maybe_derivings-            {% mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)-                                      Nothing (reverse (snd  $ unLoc $5))-                                              (fmap reverse $6)-                      ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) }--          -- GADT instance declaration-        | data_or_newtype 'instance' capi_ctype datafam_inst_hdr opt_kind_sig-                 gadt_constrlist-                 maybe_derivings-            {% mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (unLoc $4)-                                   (snd $ unLoc $5) (snd $ unLoc $6)-                                   (fmap reverse $7)-                     ((fst $ unLoc $1):mj AnnInstance $2-                       :(fst $ unLoc $5)++(fst $ unLoc $6)) }--overlap_pragma :: { Maybe (LocatedP OverlapMode) }-  : '{-# OVERLAPPABLE'    '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))-                                       (AnnPragma (mo $1) (mc $2) []) }-  | '{-# OVERLAPPING'     '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))-                                       (AnnPragma (mo $1) (mc $2) []) }-  | '{-# OVERLAPS'        '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1)))-                                       (AnnPragma (mo $1) (mc $2) []) }-  | '{-# INCOHERENT'      '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1)))-                                       (AnnPragma (mo $1) (mc $2) []) }-  | {- empty -}                 { Nothing }--deriv_strategy_no_via :: { LDerivStrategy GhcPs }-  : 'stock'                     {% amsA' (sL1 $1 (StockStrategy [mj AnnStock $1])) }-  | 'anyclass'                  {% amsA' (sL1 $1 (AnyclassStrategy [mj AnnAnyclass $1])) }-  | 'newtype'                   {% amsA' (sL1 $1 (NewtypeStrategy [mj AnnNewtype $1])) }--deriv_strategy_via :: { LDerivStrategy GhcPs }-  : 'via' sigktype          {% amsA' (sLL $1 $> (ViaStrategy (XViaStrategyPs [mj AnnVia $1] $2))) }--deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) }-  : 'stock'                     {% fmap Just $ amsA' (sL1 $1 (StockStrategy [mj AnnStock $1])) }-  | 'anyclass'                  {% fmap Just $ amsA' (sL1 $1 (AnyclassStrategy [mj AnnAnyclass $1])) }-  | 'newtype'                   {% fmap Just $ amsA' (sL1 $1 (NewtypeStrategy [mj AnnNewtype $1])) }-  | deriv_strategy_via          { Just $1 }-  | {- empty -}                 { Nothing }---- Injective type families--opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) }-        : {- empty -}               { noLoc ([], Nothing) }-        | '|' injectivity_cond      { sLL $1 $> ([mj AnnVbar $1]-                                                , Just ($2)) }--injectivity_cond :: { LInjectivityAnn GhcPs }-        : tyvarid '->' inj_varids-           {% amsA' (sLL $1 $> (InjectivityAnn [mu AnnRarrow $2] $1 (reverse (unLoc $3)))) }--inj_varids :: { Located [LocatedN RdrName] }-        : inj_varids tyvarid  { sLL $1 $> ($2 : unLoc $1) }-        | tyvarid             { sL1  $1 [$1]               }---- Closed type families--where_type_family :: { Located ([AddEpAnn],FamilyInfo GhcPs) }-        : {- empty -}                      { noLoc ([],OpenTypeFamily) }-        | 'where' ty_fam_inst_eqn_list-               { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)-                    ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }--ty_fam_inst_eqn_list :: { Located ([AddEpAnn],Maybe [LTyFamInstEqn GhcPs]) }-        :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]-                                                ,Just (unLoc $2)) }-        | vocurly ty_fam_inst_eqns close   { let (L loc _) = $2 in-                                             L loc ([],Just (unLoc $2)) }-        |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2-                                                 ,mcc $3],Nothing) }-        | vocurly '..' close               { let (L loc _) = $2 in-                                             L loc ([mj AnnDotdot $2],Nothing) }--ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }-        : ty_fam_inst_eqns ';' ty_fam_inst_eqn-                                      {% let (L loc eqn) = $3 in-                                         case unLoc $1 of-                                           [] -> return (sLL $1 $> (L loc eqn : unLoc $1))-                                           (h:t) -> do-                                             h' <- addTrailingSemiA h (gl $2)-                                             return (sLL $1 $> ($3 : h' : t)) }-        | ty_fam_inst_eqns ';'        {% case unLoc $1 of-                                           [] -> return (sLZ $1 $> (unLoc $1))-                                           (h:t) -> do-                                             h' <- addTrailingSemiA h (gl $2)-                                             return (sLZ $1 $>  (h':t)) }-        | ty_fam_inst_eqn             { sLL $1 $> [$1] }-        | {- empty -}                 { noLoc [] }--ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs }-        : 'forall' tv_bndrs '.' type '=' ktype-              {% do { hintExplicitForall $1-                    ; tvbs <- fromSpecTyVarBndrs $2-                    ; let loc = comb2 $1 $>-                    ; !cs <- getCommentsFor loc-                    ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) cs) tvbs) $4 $6 [mj AnnEqual $5] }}-        | type '=' ktype-              {% mkTyFamInstEqn (comb2 $1 $>) mkHsOuterImplicit $1 $3 (mj AnnEqual $2:[]) }-              -- Note the use of type for the head; this allows-              -- infix type constructors and type patterns---- Associated type family declarations------ * They have a different syntax than on the toplevel (no family special---   identifier).------ * They also need to be separate from instances; otherwise, data family---   declarations without a kind signature cause parsing conflicts with empty---   data declarations.----at_decl_cls :: { LHsDecl GhcPs }-        :  -- data family declarations, with optional 'family' keyword-          'data' opt_family type opt_datafam_kind_sig-                {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3-                                                  (snd $ unLoc $4) Nothing-                        (mj AnnData $1:$2++(fst $ unLoc $4))) }--           -- type family declarations, with optional 'family' keyword-           -- (can't use opt_instance because you get shift/reduce errors-        | 'type' type opt_at_kind_inj_sig-               {% liftM mkTyClD-                        (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2-                                   (fst . snd $ unLoc $3)-                                   (snd . snd $ unLoc $3)-                         (mj AnnType $1:(fst $ unLoc $3)) )}-        | 'type' 'family' type opt_at_kind_inj_sig-               {% liftM mkTyClD-                        (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3-                                   (fst . snd $ unLoc $4)-                                   (snd . snd $ unLoc $4)-                         (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))}--           -- default type instances, with optional 'instance' keyword-        | 'type' ty_fam_inst_eqn-                {% liftM mkInstD (mkTyFamInst (comb2 $1 $2) (unLoc $2)-                          [mj AnnType $1]) }-        | 'type' 'instance' ty_fam_inst_eqn-                {% liftM mkInstD (mkTyFamInst (comb2 $1 $3) (unLoc $3)-                              (mj AnnType $1:mj AnnInstance $2:[]) )}--opt_family   :: { [AddEpAnn] }-              : {- empty -}   { [] }-              | 'family'      { [mj AnnFamily $1] }--opt_instance :: { [AddEpAnn] }-              : {- empty -} { [] }-              | 'instance'  { [mj AnnInstance $1] }---- Associated type instances----at_decl_inst :: { LInstDecl GhcPs }-           -- type instance declarations, with optional 'instance' keyword-        : 'type' opt_instance ty_fam_inst_eqn-                -- Note the use of type for the head; this allows-                -- infix type constructors and type patterns-                {% mkTyFamInst (comb2 $1 $3) (unLoc $3)-                          (mj AnnType $1:$2) }--        -- data/newtype instance declaration, with optional 'instance' keyword-        | data_or_newtype opt_instance capi_ctype datafam_inst_hdr constrs maybe_derivings-               {% mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)-                                    Nothing (reverse (snd $ unLoc $5))-                                            (fmap reverse $6)-                        ((fst $ unLoc $1):$2++(fst $ unLoc $5)) }--        -- GADT instance declaration, with optional 'instance' keyword-        | data_or_newtype opt_instance capi_ctype datafam_inst_hdr opt_kind_sig-                 gadt_constrlist-                 maybe_derivings-                {% mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3-                                (unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6)-                                (fmap reverse $7)-                        ((fst $ unLoc $1):$2++(fst $ unLoc $5)++(fst $ unLoc $6)) }--type_data_or_newtype :: { Located ([AddEpAnn], Bool, NewOrData) }-        : 'data'        { sL1 $1 ([mj AnnData    $1],            False,DataType) }-        | 'newtype'     { sL1 $1 ([mj AnnNewtype $1],            False,NewType) }-        | 'type' 'data' { sL1 $1 ([mj AnnType $1, mj AnnData $2],True ,DataType) }--data_or_newtype :: { Located (AddEpAnn, NewOrData) }-        : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }-        | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }---- Family result/return kind signatures--opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) }-        :               { noLoc     ([]               , Nothing) }-        | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], Just $2) }--opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) }-        :               { noLoc     ([]               , noLocA (NoSig noExtField)         )}-        | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))}--opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) }-        :              { noLoc     ([]               , noLocA     (NoSig    noExtField)   )}-        | '::' kind    { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig  noExtField $2))}-        | '='  tv_bndr {% do { tvb <- fromSpecTyVarBndr $2-                             ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} }--opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs-                                            , Maybe (LInjectivityAnn GhcPs)))}-        :            { noLoc ([], (noLocA (NoSig noExtField), Nothing)) }-        | '::' kind  { sLL $1 $> ( [mu AnnDcolon $1]-                                 , (sL1a $> (KindSig noExtField $2), Nothing)) }-        | '='  tv_bndr_no_braces '|' injectivity_cond-                {% do { tvb <- fromSpecTyVarBndr $2-                      ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3]-                                           , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} }---- tycl_hdr parses the header of a class or data type decl,--- which takes the form---      T a b---      Eq a => T a---      (Eq a, Ord b) => T a b---      T Int [a]                       -- for associated types--- Rather a lot of inlining here, else we get reduce/reduce errors-tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }-        : context '=>' type         {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), $3))) }-        | type                      { sL1 $1 (Nothing, $1) }--datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) }-        : 'forall' tv_bndrs '.' context '=>' type   {% hintExplicitForall $1-                                                       >> fromSpecTyVarBndrs $2-                                                         >>= \tvbs ->-                                                             (acs (comb2 $1 $>) (\loc cs -> (L loc-                                                                                  (Just ( addTrailingDarrowC $4 $5 cs)-                                                                                        , mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6))))-                                                    }-        | 'forall' tv_bndrs '.' type   {% do { hintExplicitForall $1-                                             ; tvbs <- fromSpecTyVarBndrs $2-                                             ; let loc = comb2 $1 $>-                                             ; !cs <- getCommentsFor loc-                                             ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4))-                                       } }-        | context '=>' type         {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) }-        | type                      { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }---capi_ctype :: { Maybe (LocatedP CType) }-capi_ctype : '{-# CTYPE' STRING STRING '#-}'-                       {% fmap Just $ amsr (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))-                                        (getSTRINGs $3,getSTRING $3)))-                              (AnnPragma (mo $1) (mc $4) [mj AnnHeader $2,mj AnnVal $3]) }--           | '{-# CTYPE'        STRING '#-}'-                       {% fmap Just $ amsr (sLL $1 $> (CType (getCTYPEs $1) Nothing (getSTRINGs $2, getSTRING $2)))-                              (AnnPragma (mo $1) (mc $3) [mj AnnVal $2]) }--           |           { Nothing }---------------------------------------------------------------------------------- Stand-alone deriving---- Glasgow extension: stand-alone deriving declarations-stand_alone_deriving :: { LDerivDecl GhcPs }-  : 'deriving' deriv_standalone_strategy 'instance' maybe_warning_pragma overlap_pragma inst_type-                {% do { let { err = text "in the stand-alone deriving instance"-                                    <> colon <+> quotes (ppr $6) }-                      ; amsA' (sLL $1 $>-                                 (DerivDecl ($4, [mj AnnDeriving $1, mj AnnInstance $3]) (mkHsWildCardBndrs $6) $2 $5)) }}---------------------------------------------------------------------------------- Role annotations--role_annot :: { LRoleAnnotDecl GhcPs }-role_annot : 'type' 'role' oqtycon maybe_roles-          {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4))-                   [mj AnnType $1,mj AnnRole $2] }---- Reversed!-maybe_roles :: { Located [Located (Maybe FastString)] }-maybe_roles : {- empty -}    { noLoc [] }-            | roles          { $1 }--roles :: { Located [Located (Maybe FastString)] }-roles : role             { sLL $1 $> [$1] }-      | roles role       { sLL $1 $> $ $2 : unLoc $1 }---- read it in as a varid for better error messages-role :: { Located (Maybe FastString) }-role : VARID             { sL1 $1 $ Just $ getVARID $1 }-     | '_'               { sL1 $1 Nothing }---- Pattern synonyms---- Glasgow extension: pattern synonyms-pattern_synonym_decl :: { LHsDecl GhcPs }-        : 'pattern' pattern_synonym_lhs '=' pat-         {%      let (name, args, as ) = $2 in-                 amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4-                                                    ImplicitBidirectional-                      (as ++ [mj AnnPattern $1, mj AnnEqual $3])) }--        | 'pattern' pattern_synonym_lhs '<-' pat-         {%    let (name, args, as) = $2 in-               amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional-                       (as ++ [mj AnnPattern $1,mu AnnLarrow $3])) }--        | 'pattern' pattern_synonym_lhs '<-' pat where_decls-            {% do { let (name, args, as) = $2-                  ; mg <- mkPatSynMatchGroup name $5-                  ; amsA' (sLL $1 $> . ValD noExtField $-                           mkPatSynBind name args $4 (ExplicitBidirectional mg)-                            (as ++ [mj AnnPattern $1,mu AnnLarrow $3]))-                   }}--pattern_synonym_lhs :: { (LocatedN RdrName, HsPatSynDetails GhcPs, [AddEpAnn]) }-        : con vars0 { ($1, PrefixCon noTypeArgs $2, []) }-        | varid conop varid { ($2, InfixCon $1 $3, []) }-        | con '{' cvars1 '}' { ($1, RecCon $3, [moc $2, mcc $4] ) }--vars0 :: { [LocatedN RdrName] }-        : {- empty -}                 { [] }-        | varid vars0                 { $1 : $2 }--cvars1 :: { [RecordPatSynField GhcPs] }-       : var                          { [RecordPatSynField (mkFieldOcc $1) $1] }-       | var ',' cvars1               {% do { h <- addTrailingCommaN $1 (gl $2)-                                            ; return ((RecordPatSynField (mkFieldOcc h) h) : $3 )}}--where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) }-        : 'where' '{' decls '}'       {% amsr (sLL $1 $> (snd $ unLoc $3))-                                              (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) }-        | 'where' vocurly decls close {% amsr (sLL $1 $3 (snd $ unLoc $3))-                                              (AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) }--pattern_synonym_sig :: { LSig GhcPs }-        : 'pattern' con_list '::' sigtype-                   {% amsA' (sLL $1 $>-                                $ PatSynSig (AnnSig (mu AnnDcolon $3) [mj AnnPattern $1])-                                  (toList $ unLoc $2) $4) }--qvarcon :: { LocatedN RdrName }-        : qvar                          { $1 }-        | qcon                          { $1 }---------------------------------------------------------------------------------- Nested declarations---- Declaration in class bodies----decl_cls  :: { LHsDecl GhcPs }-decl_cls  : at_decl_cls                 { $1 }-          | decl                        { $1 }--          -- A 'default' signature used with the generic-programming extension-          | 'default' infixexp '::' sigtype-                    {% runPV (unECP $2) >>= \ $2 ->-                       do { v <- checkValSigLhs $2-                          ; let err = text "in default signature" <> colon <+>-                                      quotes (ppr $2)-                          ; amsA' (sLL $1 $> $ SigD noExtField $ ClassOpSig (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) True [v] $4) }}--decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) }  -- Reversed-          : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)-                                             then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)-                                                                    , unitOL $3))-                                            else case (snd $ unLoc $1) of-                                              SnocOL hs t -> do-                                                 t' <- addTrailingSemiA t (gl $2)-                                                 return (sLL $1 $> (fst $ unLoc $1-                                                                , snocOL hs t' `appOL` unitOL $3)) }-          | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)-                                             then return (sLZ $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2)-                                                                                   ,snd $ unLoc $1))-                                             else case (snd $ unLoc $1) of-                                               SnocOL hs t -> do-                                                  t' <- addTrailingSemiA t (gl $2)-                                                  return (sLZ $1 $> (fst $ unLoc $1-                                                                 , snocOL hs t')) }-          | decl_cls                    { sL1 $1 ([], unitOL $1) }-          | {- empty -}                 { noLoc ([],nilOL) }--decllist_cls-        :: { Located ([AddEpAnn]-                     , OrdList (LHsDecl GhcPs)-                     , EpLayout) }      -- Reversed-        : '{'         decls_cls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)-                                             ,snd $ unLoc $2, epExplicitBraces $1 $3) }-        |     vocurly decls_cls close   { let { L l (anns, decls) = $2 }-                                           in L l (anns, decls, EpVirtualBraces (getVOCURLY $1)) }---- Class body----where_cls :: { Located ([AddEpAnn]-                       ,(OrdList (LHsDecl GhcPs))    -- Reversed-                       ,EpLayout) }-                                -- No implicit parameters-                                -- May have type declarations-        : 'where' decllist_cls          { sLL $1 $> (mj AnnWhere $1:(fstOf3 $ unLoc $2)-                                             ,sndOf3 $ unLoc $2,thdOf3 $ unLoc $2) }-        | {- empty -}                   { noLoc ([],nilOL,EpNoLayout) }---- Declarations in instance bodies----decl_inst  :: { Located (OrdList (LHsDecl GhcPs)) }-decl_inst  : at_decl_inst               { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) }-           | decl                       { sL1 $1 (unitOL $1) }--decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) }   -- Reversed-           : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)-                                             then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)-                                                                    , unLoc $3))-                                             else case (snd $ unLoc $1) of-                                               SnocOL hs t -> do-                                                  t' <- addTrailingSemiA t (gl $2)-                                                  return (sLL $1 $> (fst $ unLoc $1-                                                                 , snocOL hs t' `appOL` unLoc $3)) }-           | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)-                                             then return (sLZ $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)-                                                                                   ,snd $ unLoc $1))-                                             else case (snd $ unLoc $1) of-                                               SnocOL hs t -> do-                                                  t' <- addTrailingSemiA t (gl $2)-                                                  return (sLZ $1 $> (fst $ unLoc $1-                                                                 , snocOL hs t')) }-           | decl_inst                  { sL1 $1 ([],unLoc $1) }-           | {- empty -}                { noLoc ([],nilOL) }--decllist_inst-        :: { Located ([AddEpAnn]-                     , OrdList (LHsDecl GhcPs)) }      -- Reversed-        : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }-        |     vocurly decls_inst close  { L (gl $2) (unLoc $2) }---- Instance body----where_inst :: { Located ([AddEpAnn]-                        , OrdList (LHsDecl GhcPs)) }   -- Reversed-                                -- No implicit parameters-                                -- May have type declarations-        : 'where' decllist_inst         { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)-                                             ,(snd $ unLoc $2)) }-        | {- empty -}                   { noLoc ([],nilOL) }---- Declarations in binding groups other than classes and instances----decls   :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) }-        : decls ';' decl    {% if isNilOL (snd $ unLoc $1)-                                 then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemiA $2)-                                                        , unitOL $3))-                                 else case (snd $ unLoc $1) of-                                   SnocOL hs t -> do-                                      t' <- addTrailingSemiA t (gl $2)-                                      let { this = unitOL $3;-                                            rest = snocOL hs t';-                                            these = rest `appOL` this }-                                      return (rest `seq` this `seq` these `seq`-                                                 (sLL $1 $> (fst $ unLoc $1, these))) }-        | decls ';'          {% if isNilOL (snd $ unLoc $1)-                                  then return (sLZ $1 $> (((fst $ unLoc $1) ++ (msemiA $2)-                                                          ,snd $ unLoc $1)))-                                  else case (snd $ unLoc $1) of-                                    SnocOL hs t -> do-                                       t' <- addTrailingSemiA t (gl $2)-                                       return (sLZ $1 $> (fst $ unLoc $1-                                                      , snocOL hs t')) }-        | decl                          { sL1 $1 ([], unitOL $1) }-        | {- empty -}                   { noLoc ([],nilOL) }--decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) }-        : '{'            decls '}'     { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3)  (fst $ unLoc $2) []-                                                   ,sL1 $2 $ snd $ unLoc $2) }-        |     vocurly    decls close   { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) []-                                                   ,sL1 $2 $ snd $ unLoc $2) }---- Binding groups other than those of class and instance declarations----binds   ::  { Located (HsLocalBinds GhcPs) }-                                         -- May have implicit parameters-                                                -- No type declarations-        : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)-                                  ; !cs <- getCommentsFor (gl $1)-                                  ; return (sL1 $1 $ HsValBinds (fixValbindsAnn $ EpAnn (glR $1) (fst $ unLoc $1) cs) val_binds)} }--        | '{'            dbinds '}'     {% acs (comb3 $1 $2 $3) (\loc cs -> (L loc-                                             $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }--        |     vocurly    dbinds close   {% acs (gl $2) (\loc cs -> (L loc-                                             $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) Nothing Nothing [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }---wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) }-                                                -- May have implicit parameters-                                                -- No type declarations-        : 'where' binds                 {% do { r <- acs (comb2 $1 $>) (\loc cs ->-                                                (L loc (annBinds (mj AnnWhere $1) cs (unLoc $2))))-                                              ; return $ Just r} }-        | {- empty -}                   { Nothing }---------------------------------------------------------------------------------- Transformation Rules--rules   :: { [LRuleDecl GhcPs] } -- Reversed-        :  rules ';' rule              {% case $1 of-                                            [] -> return ($3:$1)-                                            (h:t) -> do-                                              h' <- addTrailingSemiA h (gl $2)-                                              return ($3:h':t) }-        |  rules ';'                   {% case $1 of-                                            [] -> return $1-                                            (h:t) -> do-                                              h' <- addTrailingSemiA h (gl $2)-                                              return (h':t) }-        |  rule                        { [$1] }-        |  {- empty -}                 { [] }--rule    :: { LRuleDecl GhcPs }-        : STRING rule_activation rule_foralls infixexp '=' exp-         {%runPV (unECP $4) >>= \ $4 ->-           runPV (unECP $6) >>= \ $6 ->-           amsA' (sLL $1 $> $ HsRule-                                   { rd_ext = (((fstOf3 $3) (mj AnnEqual $5 : (fst $2))), getSTRINGs $1)-                                   , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1)-                                   , rd_act = (snd $2) `orElse` AlwaysActive-                                   , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3-                                   , rd_lhs = $4, rd_rhs = $6 }) }---- Rules can be specified to be NeverActive, unlike inline/specialize pragmas-rule_activation :: { ([AddEpAnn],Maybe Activation) }-        -- See Note [%shift: rule_activation -> {- empty -}]-        : {- empty -} %shift                    { ([],Nothing) }-        | rule_explicit_activation              { (fst $1,Just (snd $1)) }---- This production is used to parse the tilde syntax in pragmas such as---   * {-# INLINE[~2] ... #-}---   * {-# SPECIALISE [~ 001] ... #-}---   * {-# RULES ... [~0] ... g #-}--- Note that it can be written either---   without a space [~1]  (the PREFIX_TILDE case), or---   with    a space [~ 1] (the VARSYM case).--- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-rule_activation_marker :: { [AddEpAnn] }-      : PREFIX_TILDE { [mj AnnTilde $1] }-      | VARSYM  {% if (getVARSYM $1 == fsLit "~")-                   then return [mj AnnTilde $1]-                   else do { addError $ mkPlainErrorMsgEnvelope (getLoc $1) $-                               PsErrInvalidRuleActivationMarker-                           ; return [] } }--rule_explicit_activation :: { ([AddEpAnn]-                              ,Activation) }  -- In brackets-        : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]-                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }-        | '[' rule_activation_marker INTEGER ']'-                                { ($2++[mos $1,mj AnnVal $3,mcs $4]-                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }-        | '[' rule_activation_marker ']'-                                { ($2++[mos $1,mcs $3]-                                  ,NeverActive) }--rule_foralls :: { ([AddEpAnn] -> HsRuleAnn, Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs]) }-        : 'forall' rule_vars '.' 'forall' rule_vars '.'    {% let tyvs = mkRuleTyVarBndrs $2-                                                              in hintExplicitForall $1-                                                              >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs $2)-                                                              >> return (\anns -> HsRuleAnn-                                                                          (Just (mu AnnForall $1,mj AnnDot $3))-                                                                          (Just (mu AnnForall $4,mj AnnDot $6))-                                                                          anns,-                                                                         Just (mkRuleTyVarBndrs $2), mkRuleBndrs $5) }-        | 'forall' rule_vars '.'                           { (\anns -> HsRuleAnn Nothing (Just (mu AnnForall $1,mj AnnDot $3)) anns,-                                                              Nothing, mkRuleBndrs $2) }-        -- See Note [%shift: rule_foralls -> {- empty -}]-        | {- empty -}            %shift                    { (\anns -> HsRuleAnn Nothing Nothing anns, Nothing, []) }--rule_vars :: { [LRuleTyTmVar] }-        : rule_var rule_vars                    { $1 : $2 }-        | {- empty -}                           { [] }--rule_var :: { LRuleTyTmVar }-        : varid                         { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) }-        | '(' varid '::' ctype ')'      {% amsA' (sLL $1 $> (RuleTyTmVar [mop $1,mu AnnDcolon $3,mcp $5] $2 (Just $4))) }--{- Note [Parsing explicit foralls in Rules]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We really want the above definition of rule_foralls to be:--  rule_foralls : 'forall' tv_bndrs '.' 'forall' rule_vars '.'-               | 'forall' rule_vars '.'-               | {- empty -}--where rule_vars (term variables) can be named "family" or "role",-but tv_vars (type variables) cannot be. However, such a definition results-in a reduce/reduce conflict. For example, when parsing:-> {-# RULE "name" forall a ... #-}-before the '...' it is impossible to determine whether we should be in the-first or second case of the above.--This is resolved by using rule_vars (which is more general) for both, and-ensuring that type-level quantified variables do not have the names "forall",-"family", or "role" in the function 'checkRuleTyVarBndrNames' in-GHC.Parser.PostProcess.-Thus, whenever the definition of tyvarid (used for tv_bndrs) is changed relative-to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.--}---------------------------------------------------------------------------------- Warnings and deprecations (c.f. rules)--maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }-        : '{-# DEPRECATED' strings '#-}'-                            {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))-                                (AnnPragma (mo $1) (mc $3) (fst $ unLoc $2)) }-        | '{-# WARNING' warning_category strings '#-}'-                            {% fmap Just $ amsr (sLL $1 $> $ WarningTxt $2 (getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))-                                (AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}-        |  {- empty -}      { Nothing }--warning_category :: { Maybe (LocatedE InWarningCategory) }-        : 'in' STRING                  { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)-                                                                    (reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) }-        | {- empty -}                  { Nothing }--warnings :: { OrdList (LWarnDecl GhcPs) }-        : warnings ';' warning         {% if isNilOL $1-                                           then return ($1 `appOL` $3)-                                           else case $1 of-                                             SnocOL hs t -> do-                                              t' <- addTrailingSemiA t (gl $2)-                                              return (snocOL hs t' `appOL` $3) }-        | warnings ';'                 {% if isNilOL $1-                                           then return $1-                                           else case $1 of-                                             SnocOL hs t -> do-                                              t' <- addTrailingSemiA t (gl $2)-                                              return (snocOL hs t') }-        | warning                      { $1 }-        | {- empty -}                  { nilOL }---- SUP: TEMPORARY HACK, not checking for `module Foo'-warning :: { OrdList (LWarnDecl GhcPs) }-        : warning_category namespace_spec namelist strings-                {% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)-                     (Warning (unLoc $2, fst $ unLoc $4) (unLoc $3)-                              (WarningTxt $1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $4))) }--namespace_spec :: { Located NamespaceSpecifier }-  : 'type'      { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }-  | 'data'      { sL1 $1 $ DataNamespaceSpecifier (epTok $1) }-  | {- empty -} { sL0    $ NoNamespaceSpecifier }--deprecations :: { OrdList (LWarnDecl GhcPs) }-        : deprecations ';' deprecation-                                       {% if isNilOL $1-                                           then return ($1 `appOL` $3)-                                           else case $1 of-                                             SnocOL hs t -> do-                                              t' <- addTrailingSemiA t (gl $2)-                                              return (snocOL hs t' `appOL` $3) }-        | deprecations ';'             {% if isNilOL $1-                                           then return $1-                                           else case $1 of-                                             SnocOL hs t -> do-                                              t' <- addTrailingSemiA t (gl $2)-                                              return (snocOL hs t') }-        | deprecation                  { $1 }-        | {- empty -}                  { nilOL }---- SUP: TEMPORARY HACK, not checking for `module Foo'-deprecation :: { OrdList (LWarnDecl GhcPs) }-        : namespace_spec namelist strings-             {% fmap unitOL $ amsA' (sL (comb3 $1 $2 $>) $ (Warning (unLoc $1, fst $ unLoc $3) (unLoc $2)-                                          (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }--strings :: { Located ([AddEpAnn],[Located StringLiteral]) }-    : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }-    | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }--stringlist :: { Located (OrdList (Located StringLiteral)) }-    : stringlist ',' STRING {% if isNilOL (unLoc $1)-                                then return (sLL $1 $> (unLoc $1 `snocOL`-                                                  (L (gl $3) (getStringLiteral $3))))-                                else case (unLoc $1) of-                                   SnocOL hs t -> do-                                     let { t' = addTrailingCommaS t (glAA $2) }-                                     return (sLL $1 $> (snocOL hs t' `snocOL`-                                                  (L (gl $3) (getStringLiteral $3))))--}-    | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }-    | {- empty -}           { noLoc nilOL }---------------------------------------------------------------------------------- Annotations-annotation :: { LHsDecl GhcPs }-    : '{-# ANN' name_var aexp '#-}'      {% runPV (unECP $3) >>= \ $3 ->-                                            amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation-                                            (AnnPragma (mo $1) (mc $4) [],-                                            (getANN_PRAGs $1))-                                            (ValueAnnProvenance $2) $3)) }--    | '{-# ANN' 'type' otycon aexp '#-}' {% runPV (unECP $4) >>= \ $4 ->-                                            amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation-                                            (AnnPragma (mo $1) (mc $5) [mj AnnType $2],-                                            (getANN_PRAGs $1))-                                            (TypeAnnProvenance $3) $4)) }--    | '{-# ANN' 'module' aexp '#-}'      {% runPV (unECP $3) >>= \ $3 ->-                                            amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation-                                                (AnnPragma (mo $1) (mc $4) [mj AnnModule $2],-                                                (getANN_PRAGs $1))-                                                 ModuleAnnProvenance $3)) }---------------------------------------------------------------------------------- Foreign import and export declarations--fdecl :: { Located ([AddEpAnn], [AddEpAnn] -> HsDecl GhcPs) }-fdecl : 'import' callconv safety fspec-               {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->-                 return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }-      | 'import' callconv        fspec-               {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);-                    return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}-      | 'export' callconv fspec-               {% mkExport $2 (snd $ unLoc $3) >>= \i ->-                  return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }--callconv :: { Located CCallConv }-          : 'stdcall'                   { sLL $1 $> StdCallConv }-          | 'ccall'                     { sLL $1 $> CCallConv   }-          | 'capi'                      { sLL $1 $> CApiConv    }-          | 'prim'                      { sLL $1 $> PrimCallConv}-          | 'javascript'                { sLL $1 $> JavaScriptCallConv }--safety :: { Located Safety }-        : 'unsafe'                      { sLL $1 $> PlayRisky }-        | 'safe'                        { sLL $1 $> PlaySafe }-        | 'interruptible'               { sLL $1 $> PlayInterruptible }--fspec :: { Located ([AddEpAnn]-                    ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) }-       : STRING var '::' sigtype        { sLL $1 $> ([mu AnnDcolon $3]-                                             ,(L (getLoc $1)-                                                    (getStringLiteral $1), $2, $4)) }-       |        var '::' sigtype        { sLL $1 $> ([mu AnnDcolon $2]-                                             ,(noLoc (StringLiteral NoSourceText nilFS Nothing), $1, $3)) }-         -- if the entity string is missing, it defaults to the empty string;-         -- the meaning of an empty entity string depends on the calling-         -- convention---------------------------------------------------------------------------------- Type signatures--opt_sig :: { Maybe (AddEpAnn, LHsType GhcPs) }-        : {- empty -}                   { Nothing }-        | '::' ctype                    { Just (mu AnnDcolon $1, $2) }--opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) }-             : {- empty -}              { ([], Nothing) }-             | '::' gtycon              { ([mu AnnDcolon $1], Just $2) }---- Like ktype, but for types that obey the forall-or-nothing rule.--- See Note [forall-or-nothing rule] in GHC.Hs.Type.-sigktype :: { LHsSigType GhcPs }-        : sigtype              { $1 }-        | ctype '::' kind      {% amsA' (sLL $1 $> $ mkHsImplicitSigType $-                                         sLLa $1 $> $ HsKindSig [mu AnnDcolon $2] $1 $3) }---- Like ctype, but for types that obey the forall-or-nothing rule.--- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the--- logic in ctype here, we simply reuse the ctype production and perform--- surgery on the LHsType it returns to turn it into an LHsSigType.-sigtype :: { LHsSigType GhcPs }-        : ctype                            { hsTypeToHsSigType $1 }--sig_vars :: { Located [LocatedN RdrName] }    -- Returned in reversed order-         : sig_vars ',' var           {% case unLoc $1 of-                                           [] -> return (sLL $1 $> ($3 : unLoc $1))-                                           (h:t) -> do-                                             h' <- addTrailingCommaN h (gl $2)-                                             return (sLL $1 $> ($3 : h' : t)) }-         | var                        { sL1 $1 [$1] }--sigtypes1 :: { OrdList (LHsSigType GhcPs) }-   : sigtype                 { unitOL $1 }-   | sigtype ',' sigtypes1   {% do { st <- addTrailingCommaA $1 (gl $2)-                                   ; return $ unitOL st `appOL` $3 } }--------------------------------------------------------------------------------- Types--unpackedness :: { Located UnpackednessPragma }-        : '{-# UNPACK' '#-}'   { sLL $1 $> (UnpackednessPragma [mo $1, mc $2] (getUNPACK_PRAGs $1) SrcUnpack) }-        | '{-# NOUNPACK' '#-}' { sLL $1 $> (UnpackednessPragma [mo $1, mc $2] (getNOUNPACK_PRAGs $1) SrcNoUnpack) }--forall_telescope :: { Located (HsForAllTelescope GhcPs) }-        : 'forall' tv_bndrs '.'  {% do { hintExplicitForall $1-                                       ; acs (comb2 $1 $>) (\loc cs -> (L loc $-                                           mkHsForAllInvisTele (EpAnn (glEE $1 $>) (mu AnnForall $1,mu AnnDot $3) cs) $2 )) }}-        | 'forall' tv_bndrs '->' {% do { hintExplicitForall $1-                                       ; req_tvbs <- fromSpecTyVarBndrs $2-                                       ; acs (comb2 $1 $>) (\loc cs -> (L loc $-                                           mkHsForAllVisTele (EpAnn (glEE $1 $>) (mu AnnForall $1,mu AnnRarrow $3) cs) req_tvbs )) }}---- A ktype is a ctype, possibly with a kind annotation-ktype :: { LHsType GhcPs }-        : ctype                { $1 }-        | ctype '::' kind      {% amsA' (sLL $1 $> $ HsKindSig [mu AnnDcolon $2] $1 $3) }---- A ctype is a for-all type-ctype   :: { LHsType GhcPs }-        : forall_telescope ctype      { sLLa $1 $> $-                                              HsForAllTy { hst_tele = unLoc $1-                                                         , hst_xforall = noExtField-                                                         , hst_body = $2 } }-        | context '=>' ctype          {% acsA (comb2 $1 $>) (\loc cs -> (L loc $-                                            HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs-                                                     , hst_xqual = NoExtField-                                                     , hst_body = $3 })) }--        | ipvar '::' ctype            {% amsA' (sLL $1 $> (HsIParamTy [mu AnnDcolon $2] (reLoc $1) $3)) }-        | type                        { $1 }--------------------------- Notes for 'context'--- We parse a context as a btype so that we don't get reduce/reduce--- errors in ctype.  The basic problem is that---      (Eq a, Ord a)--- looks so much like a tuple type.  We can't tell until we find the =>--context :: { LHsContext GhcPs }-        :  btype                        {% checkContext $1 }--{- Note [GADT decl discards annotations]-~~~~~~~~~~~~~~~~~~~~~-The type production for--    btype `->` ctype--add the AnnRarrow annotation twice, in different places.--This is because if the type is processed as usual, it belongs on the annotations-for the type as a whole.--But if the type is passed to mkGadtDecl, it discards the top level SrcSpan, and-the top-level annotation will be disconnected. Hence for this specific case it-is connected to the first type too.--}--type :: { LHsType GhcPs }-        -- See Note [%shift: type -> btype]-        : btype %shift                 { $1 }-        | btype '->' ctype             {% amsA' (sLL $1 $>-                                            $ HsFunTy noExtField (HsUnrestrictedArrow (epUniTok $2)) $1 $3) }--        | btype mult '->' ctype        {% hintLinear (getLoc $2)-                                       >> let arr = (unLoc $2) (epUniTok $3)-                                          in amsA' (sLL $1 $> $ HsFunTy noExtField arr $1 $4) }--        | btype '->.' ctype            {% hintLinear (getLoc $2) >>-                                          amsA' (sLL $1 $> $ HsFunTy noExtField (HsLinearArrow (EpLolly (epTok $2))) $1 $3) }-                                              -- [mu AnnLollyU $2] }--mult :: { Located (EpUniToken "->" "\8594" -> HsArrow GhcPs) }-        : PREFIX_PERCENT atype          { sLL $1 $> (mkMultTy (epTok $1) $2) }--btype :: { LHsType GhcPs }-        : infixtype                     {% runPV $1 }--infixtype :: { forall b. DisambTD b => PV (LocatedA b) }-        -- See Note [%shift: infixtype -> ftype]-        : ftype %shift                  { $1 }-        | ftype tyop infixtype          { $1 >>= \ $1 ->-                                          $3 >>= \ $3 ->-                                          do { let (op, prom) = $2-                                             ; when (looksLikeMult $1 op $3) $ hintLinear (getLocA op)-                                             ; mkHsOpTyPV prom $1 op $3 } }-        | unpackedness infixtype        { $2 >>= \ $2 ->-                                          mkUnpackednessPV $1 $2 }--ftype :: { forall b. DisambTD b => PV (LocatedA b) }-        : atype                         { mkHsAppTyHeadPV $1 }-        | tyop                          { failOpFewArgs (fst $1) }-        | ftype tyarg                   { $1 >>= \ $1 ->-                                          mkHsAppTyPV $1 $2 }-        | ftype PREFIX_AT atype         { $1 >>= \ $1 ->-                                          mkHsAppKindTyPV $1 (epTok $2) $3 }--tyarg :: { LHsType GhcPs }-        : atype                         { $1 }-        | unpackedness atype            {% addUnpackednessP $1 $2 }--tyop :: { (LocatedN RdrName, PromotionFlag) }-        : qtyconop                      { ($1, NotPromoted) }-        | tyvarop                       { ($1, NotPromoted) }-        | SIMPLEQUOTE qconop            {% do { op <- amsr (sLL $1 $> (unLoc $2))-                                                           (NameAnnQuote (glAA $1) (gl $2) [])-                                              ; return (op, IsPromoted) } }-        | SIMPLEQUOTE varop             {% do { op <- amsr (sLL $1 $> (unLoc $2))-                                                           (NameAnnQuote (glAA $1) (gl $2) [])-                                              ; return (op, IsPromoted) } }--atype :: { LHsType GhcPs }-        : ntgtycon                       {% amsA' (sL1 $1 (HsTyVar [] NotPromoted $1)) }      -- Not including unit tuples-        -- See Note [%shift: atype -> tyvar]-        | tyvar %shift                   {% amsA' (sL1 $1 (HsTyVar [] NotPromoted $1)) }      -- (See Note [Unit tuples])-        | '*'                            {% do { warnStarIsType (getLoc $1)-                                               ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } }--        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        | PREFIX_TILDE atype             {% amsA' (sLL $1 $> (mkBangTy [mj AnnTilde $1] SrcLazy $2)) }-        | PREFIX_BANG  atype             {% amsA' (sLL $1 $> (mkBangTy [mj AnnBang $1] SrcStrict $2)) }--        | '{' fielddecls '}'             {% do { decls <- amsA' (sLL $1 $> $ HsRecTy (AnnList (listAsAnchorM $2) (Just $ moc $1) (Just $ mcc $3) [] []) $2)-                                               ; checkRecordSyntax decls }}-                                                        -- Constructor sigs only--        -- List and tuple syntax whose interpretation depends on the extension ListTuplePuns.-        | '(' ')'                        {% amsA' . sLL $1 $> =<< (mkTupleSyntaxTy (glR $1) [] (glR $>)) }-        | '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $2 (gl $3)-                                               ; amsA' . sLL $1 $> =<< (mkTupleSyntaxTy (glR $1) (h : $4) (glR $>)) }}-        | '(#' '#)'                   {% do { requireLTPuns PEP_TupleSyntaxType $1 $>-                                            ; amsA' (sLL $1 $> $ HsTupleTy (AnnParen AnnParensHash (glAA $1) (glAA $2)) HsUnboxedTuple []) } }-        | '(#' comma_types1 '#)'      {% do { requireLTPuns PEP_TupleSyntaxType $1 $>-                                            ; amsA' (sLL $1 $> $ HsTupleTy (AnnParen AnnParensHash (glAA $1) (glAA $3)) HsUnboxedTuple $2) } }-        | '(#' bar_types2 '#)'        {% do { requireLTPuns PEP_SumSyntaxType $1 $>-                                      ; amsA' (sLL $1 $> $ HsSumTy (AnnParen AnnParensHash (glAA $1) (glAA $3)) $2) } }-        | '[' ktype ']'               {% amsA' . sLL $1 $> =<< (mkListSyntaxTy1 (glR $1) $2 (glR $3)) }-        | '(' ktype ')'               {% amsA' (sLL $1 $> $ HsParTy  (AnnParen AnnParens       (glAA $1) (glAA $3)) $2) }-                                      -- see Note [Promotion] for the followings-        | SIMPLEQUOTE '(' ')'         {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>-                                            ; amsA' (sLL $1 $> $ HsExplicitTupleTy [mj AnnSimpleQuote $1,mop $2,mcp $3] []) }}-        | SIMPLEQUOTE gen_qcon {% amsA' (sLL $1 $> $ HsTyVar [mj AnnSimpleQuote $1,mjN AnnName $2] IsPromoted $2) }-        | SIMPLEQUOTE sysdcon_nolist {% do { requireLTPuns PEP_QuoteDisambiguation $1 (reLoc $>)-                                           ; amsA' (sLL $1 $> $ HsTyVar [mj AnnSimpleQuote $1,mjN AnnName $2] IsPromoted (L (getLoc $2) $ nameRdrName (dataConName (unLoc $2)))) }}-        | SIMPLEQUOTE  '(' ktype ',' comma_types1 ')'-                             {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>-                                   ; h <- addTrailingCommaA $3 (gl $4)-                                   ; amsA' (sLL $1 $> $ HsExplicitTupleTy [mj AnnSimpleQuote $1,mop $2,mcp $6] (h : $5)) }}-        | '[' ']'               {% withCombinedComments $1 $> (mkListSyntaxTy0 (glR $1) (glR $2)) }-        | SIMPLEQUOTE  '[' comma_types0 ']'     {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>-                                                      ; amsA' (sLL $1 $> $ HsExplicitListTy [mj AnnSimpleQuote $1,mos $2,mcs $4] IsPromoted $3) }}-        | SIMPLEQUOTE var                       {% amsA' (sLL $1 $> $ HsTyVar [mj AnnSimpleQuote $1,mjN AnnName $2] IsPromoted $2) }--        | quasiquote                  { mapLocA (HsSpliceTy noExtField) $1 }-        | splice_untyped              { mapLocA (HsSpliceTy noExtField) $1 }--        -- Two or more [ty, ty, ty] must be a promoted list type, just as-        -- if you had written '[ty, ty, ty]-        -- (One means a list type, zero means the list type constructor,-        -- so you have to quote those.)-        | '[' ktype ',' comma_types1 ']'  {% do { h <- addTrailingCommaA $2 (gl $3)-                                                ; amsA' (sLL $1 $> $ HsExplicitListTy [mos $1,mcs $5] NotPromoted (h:$4)) }}-        | INTEGER              { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1)-                                                           (il_value (getINTEGER $1)) }-        | CHAR                 { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1)-                                                                        (getCHAR $1) }-        | STRING               { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1)-                                                                     (getSTRING  $1) }-        | '_'                  { sL1a $1 $ mkAnonWildCardTy }-        -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer.-        -- We let it pass the parser because the renamer can generate a better error message.-        | QVARID                      {% let qname = mkQual tvName (getQVARID $1)-                                         in  amsA' (sL1 $1 (HsTyVar [] NotPromoted (sL1n $1 $ qname)))}---- An inst_type is what occurs in the head of an instance decl---      e.g.  (Foo a, Gaz b) => Wibble a b--- It's kept as a single type for convenience.-inst_type :: { LHsSigType GhcPs }-        : sigtype                       { $1 }--deriv_types :: { [LHsSigType GhcPs] }-        : sigktype                      { [$1] }--        | sigktype ',' deriv_types      {% do { h <- addTrailingCommaA $1 (gl $2)-                                           ; return (h : $3) } }--comma_types0  :: { [LHsType GhcPs] }  -- Zero or more:  ty,ty,ty-        : comma_types1                  { $1 }-        | {- empty -}                   { [] }--comma_types1    :: { [LHsType GhcPs] }  -- One or more:  ty,ty,ty-        : ktype                        { [$1] }-        | ktype  ',' comma_types1      {% do { h <- addTrailingCommaA $1 (gl $2)-                                             ; return (h : $3) }}--bar_types2    :: { [LHsType GhcPs] }  -- Two or more:  ty|ty|ty-        : ktype  '|' ktype             {% do { h <- addTrailingVbarA $1 (gl $2)-                                             ; return [h,$3] }}-        | ktype  '|' bar_types2        {% do { h <- addTrailingVbarA $1 (gl $2)-                                             ; return (h : $3) }}--tv_bndrs :: { [LHsTyVarBndr Specificity GhcPs] }-         : tv_bndr tv_bndrs             { $1 : $2 }-         | {- empty -}                  { [] }--tv_bndr :: { LHsTyVarBndr Specificity GhcPs }-        : tv_bndr_no_braces             { $1 }-        | '{' tyvar '}'                 {% amsA' (sLL $1 $> (UserTyVar   [moc $1, mcc $3] InferredSpec $2)) }-        | '{' tyvar '::' kind '}'       {% amsA' (sLL $1 $> (KindedTyVar [moc $1,mu AnnDcolon $3 ,mcc $5] InferredSpec $2 $4)) }--tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs }-        : tyvar                         {% amsA' (sL1 $1    (UserTyVar   [] SpecifiedSpec $1)) }-        | '(' tyvar '::' kind ')'       {% amsA' (sLL $1 $> (KindedTyVar [mop $1,mu AnnDcolon $3 ,mcp $5] SpecifiedSpec $2 $4)) }--fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) }-        : {- empty -}                   { noLoc ([],[]) }-        | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]-                                                 ,reverse (unLoc $2))) }--fds1 :: { Located [LHsFunDep GhcPs] }-        : fds1 ',' fd   {%-                           do { let (h:t) = unLoc $1 -- Safe from fds1 rules-                              ; h' <- addTrailingCommaA h (gl $2)-                              ; return (sLL $1 $> ($3 : h' : t)) }}-        | fd            { sL1 $1 [$1] }--fd :: { LHsFunDep GhcPs }-        : varids0 '->' varids0  {% amsA' (L (comb3 $1 $2 $3)-                                       (FunDep [mu AnnRarrow $2]-                                               (reverse (unLoc $1))-                                               (reverse (unLoc $3)))) }--varids0 :: { Located [LocatedN RdrName] }-        : {- empty -}                   { noLoc [] }-        | varids0 tyvar                 { sLL $1 $> ($2 : (unLoc $1)) }---------------------------------------------------------------------------------- Kinds--kind :: { LHsKind GhcPs }-        : ctype                  { $1 }--{- Note [Promotion]-   ~~~~~~~~~~~~~~~~--- Syntax of promoted qualified names-We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified-names. Moreover ticks are only allowed in types, not in kinds, for a-few reasons:-  1. we don't need quotes since we cannot define names in kinds-  2. if one day we merge types and kinds, tick would mean look in DataName-  3. we don't have a kind namespace anyway--- Name resolution-When the user write Zero instead of 'Zero in types, we parse it a-HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We-deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not-bounded in the type level, then we look for it in the term level (we-change its namespace to DataName, see Note [Demotion] in GHC.Types.Names.OccName).-And both become a HsTyVar ("Zero", DataName) after the renamer.--- ListTuplePuns-When this extension is disabled, ticked constructors for lists and tuples are-not accepted, while the unticked variants are unconditionally parsed as data-constructors.---}----------------------------------------------------------------------------------- Datatype declarations--gadt_constrlist :: { Located ([AddEpAnn]-                          ,[LConDecl GhcPs]) } -- Returned in order--        : 'where' '{'        gadt_constrs '}'    {% checkEmptyGADTs $-                                                      L (comb2 $1 $4)-                                                        ([mj AnnWhere $1-                                                         ,moc $2-                                                         ,mcc $4]-                                                        , unLoc $3) }-        | 'where' vocurly    gadt_constrs close  {% checkEmptyGADTs $-                                                      L (comb2 $1 $3)-                                                        ([mj AnnWhere $1]-                                                        , unLoc $3) }-        | {- empty -}                            { noLoc ([],[]) }--gadt_constrs :: { Located [LConDecl GhcPs] }-        : gadt_constr ';' gadt_constrs-                  {% do { h <- addTrailingSemiA $1 (gl $2)-                        ; return (L (comb2 $1 $3) (h : unLoc $3)) }}-        | gadt_constr                   { L (glA $1) [$1] }-        | {- empty -}                   { noLoc [] }---- We allow the following forms:---      C :: Eq a => a -> T a---      C :: forall a. Eq a => !a -> T a---      D { x,y :: a } :: T a---      forall a. Eq a => D { x,y :: a } :: T a--gadt_constr :: { LConDecl GhcPs }-    -- see Note [Difference in parsing GADT and data constructors]-    -- Returns a list because of:   C,D :: ty-    -- TODO:AZ capture the optSemi. Why leading?-        : optSemi con_list '::' sigtype-                {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (epUniTok $3) $4 }--{- Note [Difference in parsing GADT and data constructors]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-GADT constructors have simpler syntax than usual data constructors:-in GADTs, types cannot occur to the left of '::', so they cannot be mixed-with constructor names (see Note [Parsing data constructors is hard]).--Due to simplified syntax, GADT constructor names (left-hand side of '::')-use simpler grammar production than usual data constructor names. As a-consequence, GADT constructor names are restricted (names like '(*)' are-allowed in usual data constructors, but not in GADTs).--}--constrs :: { Located ([AddEpAnn],[LConDecl GhcPs]) }-        : '=' constrs1    { sLL $1 $2 ([mj AnnEqual $1],unLoc $2)}--constrs1 :: { Located [LConDecl GhcPs] }-        : constrs1 '|' constr-            {% do { let (h:t) = unLoc $1-                  ; h' <- addTrailingVbarA h (gl $2)-                  ; return (sLL $1 $> ($3 : h' : t)) }}-        | constr                         { sL1 $1 [$1] }--constr :: { LConDecl GhcPs }-        : forall context '=>' constr_stuff-                {% amsA' (let (con,details) = unLoc $4 in-                  (L (comb4 $1 $2 $3 $4) (mkConDeclH98-                                                       (mu AnnDarrow $3:(fst $ unLoc $1))-                                                       con-                                                       (snd $ unLoc $1)-                                                       (Just $2)-                                                       details))) }-        | forall constr_stuff-                {% amsA' (let (con,details) = unLoc $2 in-                  (L (comb2 $1 $2) (mkConDeclH98 (fst $ unLoc $1)-                                                      con-                                                      (snd $ unLoc $1)-                                                      Nothing   -- No context-                                                      details))) }--forall :: { Located ([AddEpAnn], Maybe [LHsTyVarBndr Specificity GhcPs]) }-        : 'forall' tv_bndrs '.'       { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }-        | {- empty -}                 { noLoc ([], Nothing) }--constr_stuff :: { Located (LocatedN RdrName, HsConDeclH98Details GhcPs) }-        : infixtype       {% do { b <- runPV $1-                                ; return (sL1 b (dataConBuilderCon b, dataConBuilderDetails b)) }}-        | '(#' usum_constr '#)' {% let (t, tag, arity) = $2 in pure (sLL $1 $3 $ mkUnboxedSumCon t tag arity)}--usum_constr :: { (LHsType GhcPs, Int, Int) } -- constructor for the data decls SumN#-         : ktype bars { ($1, 1, (snd $2 + 1)) }-         | bars ktype bars0 { ($2, snd $1 + 1, snd $1 + snd $3 + 1) }--fielddecls :: { [LConDeclField GhcPs] }-        : {- empty -}     { [] }-        | fielddecls1     { $1 }--fielddecls1 :: { [LConDeclField GhcPs] }-        : fielddecl ',' fielddecls1-            {% do { h <- addTrailingCommaA $1 (gl $2)-                  ; return (h : $3) }}-        | fielddecl   { [$1] }--fielddecl :: { LConDeclField GhcPs }-                                              -- A list because of   f,g :: Int-        : sig_vars '::' ctype-            {% amsA' (L (comb2 $1 $3)-                      (ConDeclField [mu AnnDcolon $2]-                                    (reverse (map (\ln@(L l n)-                                               -> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc $1))) $3 Nothing))}---- Reversed!-maybe_derivings :: { Located (HsDeriving GhcPs) }-        : {- empty -}             { noLoc [] }-        | derivings               { $1 }---- A list of one or more deriving clauses at the end of a datatype-derivings :: { Located (HsDeriving GhcPs) }-        : derivings deriving      { sLL $1 $> ($2 : unLoc $1) } -- AZ: order?-        | deriving                { sL1 $> [$1] }---- The outer Located is just to allow the caller to--- know the rightmost extremity of the 'deriving' clause-deriving :: { LHsDerivingClause GhcPs }-        : 'deriving' deriv_clause_types-              {% let { full_loc = comb2 $1 $> }-                 in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] Nothing $2) }--        | 'deriving' deriv_strategy_no_via deriv_clause_types-              {% let { full_loc = comb2 $1 $> }-                 in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] (Just $2) $3) }--        | 'deriving' deriv_clause_types deriv_strategy_via-              {% let { full_loc = comb2 $1 $> }-                 in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] (Just $3) $2) }--deriv_clause_types :: { LDerivClauseTys GhcPs }-        : qtycon              { let { tc = sL1a $1 $ mkHsImplicitSigType $-                                           sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in-                                sL1a $1 (DctSingle noExtField tc) }-        | '(' ')'             {% amsr (sLL $1 $> (DctMulti noExtField []))-                                      (AnnContext Nothing [glAA $1] [glAA $2]) }-        | '(' deriv_types ')' {% amsr (sLL $1 $> (DctMulti noExtField $2))-                                      (AnnContext Nothing [glAA $1] [glAA $3])}---------------------------------------------------------------------------------- Value definitions--{- Note [Declaration/signature overlap]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-There's an awkward overlap with a type signature.  Consider-        f :: Int -> Int = ...rhs...-   Then we can't tell whether it's a type signature or a value-   definition with a result signature until we see the '='.-   So we have to inline enough to postpone reductions until we know.--}--{--  ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var-  instead of qvar, we get another shift/reduce-conflict. Consider the-  following programs:--     { (^^) :: Int->Int ; }          Type signature; only var allowed--     { (^^) :: Int->Int = ... ; }    Value defn with result signature;-                                     qvar allowed (because of instance decls)--  We can't tell whether to reduce var to qvar until after we've read the signatures.--}--decl_no_th :: { LHsDecl GhcPs }-        : sigdecl               { $1 }--        | infixexp     opt_sig rhs  {% runPV (unECP $1) >>= \ $1 ->-                                       do { let { l = comb2 $1 $> }-                                          ; r <- checkValDef l $1 (HsNoMultAnn noExtField, $2) $3;-                                        -- Depending upon what the pattern looks like we might get either-                                        -- a FunBind or PatBind back from checkValDef. See Note-                                        -- [FunBind vs PatBind]-                                          ; !cs <- getCommentsFor l-                                          ; return $! (sL (commentsA l cs) $ ValD noExtField r) } }-        | PREFIX_PERCENT atype infixexp     opt_sig rhs  {% runPV (unECP $3) >>= \ $3 ->-                                       do { let { l = comb2 $1 $> }-                                          ; r <- checkValDef l $3 (mkMultAnn (epTok $1) $2, $4) $5;-                                        -- parses bindings of the form %p x or-                                        -- %p x :: sig-                                        ---                                        -- Depending upon what the pattern looks like we might get either-                                        -- a FunBind or PatBind back from checkValDef. See Note-                                        -- [FunBind vs PatBind]-                                          ; !cs <- getCommentsFor l-                                          ; return $! (sL (commentsA l cs) $ ValD noExtField r) } }-        | pattern_synonym_decl  { $1 }--decl    :: { LHsDecl GhcPs }-        : decl_no_th            { $1 }--        -- Why do we only allow naked declaration splices in top-level-        -- declarations and not here? Short answer: because readFail009-        -- fails terribly with a panic in cvBindsAndSigs otherwise.-        | splice_exp            { mkSpliceDecl $1 }--rhs     :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) }-        : '=' exp wherebinds    {% runPV (unECP $2) >>= \ $2 ->-                                  do { let L l (bs, csw) = adaptWhereBinds $3-                                     ; let loc = (comb3 $1 $2 (L l bs))-                                     ; let locg = (comb2 $1 $2)-                                     ; acs loc (\loc cs ->-                                       sL loc (GRHSs csw (unguardedRHS (EpAnn (spanAsAnchor locg) (GrhsAnn Nothing (mj AnnEqual $1)) cs) locg $2)-                                                      bs)) } }-        | gdrhs wherebinds      {% do { let {L l (bs, csw) = adaptWhereBinds $2}-                                      ; acs (comb2 $1 (L l bs)) (\loc cs -> L loc-                                                (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }}--gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }-        : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }-        | gdrh                  { sL1 $1 [$1] }--gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }-        : '|' guardquals '=' exp  {% runPV (unECP $4) >>= \ $4 ->-                                     acsA (comb2 $1 $>) (\loc cs -> L loc $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) }--sigdecl :: { LHsDecl GhcPs }-        :-        -- See Note [Declaration/signature overlap] for why we need infixexp here-          infixexp     '::' sigtype-                        {% do { $1 <- runPV (unECP $1)-                              ; v <- checkValSigLhs $1-                              ; amsA' (sLL $1 $> $ SigD noExtField $-                                  TypeSig (AnnSig (mu AnnDcolon $2) []) [v] (mkHsWildCardBndrs $3))} }--        | var ',' sig_vars '::' sigtype-           {% do { v <- addTrailingCommaN $1 (gl $2)-                 ; let sig = TypeSig (AnnSig (mu AnnDcolon $4) []) (v : reverse (unLoc $3))-                                      (mkHsWildCardBndrs $5)-                 ; amsA' (sLL $1 $> $ SigD noExtField sig ) }}--        | infix prec namespace_spec ops-             {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $4-                                                      ; pure (mj AnnVal l2) })-                                       $2-                   ; let (fixText, fixPrec) = case $2 of-                                                -- If an explicit precedence isn't supplied,-                                                -- it defaults to maxPrecedence-                                                Nothing -> (NoSourceText, maxPrecedence)-                                                Just l2 -> (fst $ unLoc l2, snd $ unLoc l2)-                   ; amsA' (sLL $1 $> $ SigD noExtField-                            (FixSig (mj AnnInfix $1 : maybeToList mbPrecAnn) (FixitySig (unLoc $3) (fromOL $ unLoc $4)-                                    (Fixity fixText fixPrec (unLoc $1)))))-                   }}--        | pattern_synonym_sig   { L (getLoc $1) . SigD noExtField . unLoc $ $1 }--        | '{-# COMPLETE' qcon_list opt_tyconsig  '#-}'-                {% let (dcolon, tc) = $3-                   in amsA' (sLL $1 $>-                         (SigD noExtField (CompleteMatchSig ([ mo $1 ] ++ dcolon ++ [mc $4], (getCOMPLETE_PRAGs $1)) $2 tc))) }--        -- This rule is for both INLINE and INLINABLE pragmas-        | '{-# INLINE' activation qvarcon '#-}'-                {% amsA' (sLL $1 $> $ SigD noExtField (InlineSig ((mo $1:fst $2) ++ [mc $4]) $3-                            (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)-                                            (snd $2)))) }-        | '{-# OPAQUE' qvar '#-}'-                {% amsA' (sLL $1 $> $ SigD noExtField (InlineSig [mo $1, mc $3] $2-                            (mkOpaquePragma (getOPAQUE_PRAGs $1)))) }-        | '{-# SCC' qvar '#-}'-          {% amsA' (sLL $1 $> (SigD noExtField (SCCFunSig ([mo $1, mc $3], (getSCC_PRAGs $1)) $2 Nothing))) }--        | '{-# SCC' qvar STRING '#-}'-          {% do { scc <- getSCC $3-                ; let str_lit = StringLiteral (getSTRINGs $3) scc Nothing-                ; amsA' (sLL $1 $> (SigD noExtField (SCCFunSig ([mo $1, mc $4], (getSCC_PRAGs $1)) $2 (Just ( sL1a $3 str_lit))))) }}--        | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'-             {% amsA' (-                 let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)-                                             (NoUserInlinePrag, FunLike) (snd $2)-                  in sLL $1 $> $ SigD noExtField (SpecSig (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) $3 (fromOL $5) inl_prag)) }--        | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'-             {% amsA' (sLL $1 $> $ SigD noExtField (SpecSig (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) $3 (fromOL $5)-                               (mkInlinePragma (getSPEC_INLINE_PRAGs $1)-                                               (getSPEC_INLINE $1) (snd $2)))) }--        | '{-# SPECIALISE' 'instance' inst_type '#-}'-                {% amsA' (sLL $1 $> $ SigD noExtField (SpecInstSig ([mo $1,mj AnnInstance $2,mc $4], (getSPEC_PRAGs $1)) $3)) }--        -- A minimal complete definition-        | '{-# MINIMAL' name_boolformula_opt '#-}'-            {% amsA' (sLL $1 $> $ SigD noExtField (MinimalSig ([mo $1,mc $3], (getMINIMAL_PRAGs $1)) $2)) }--activation :: { ([AddEpAnn],Maybe Activation) }-        -- See Note [%shift: activation -> {- empty -}]-        : {- empty -} %shift                    { ([],Nothing) }-        | explicit_activation                   { (fst $1,Just (snd $1)) }--explicit_activation :: { ([AddEpAnn],Activation) }  -- In brackets-        : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]-                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }-        | '[' rule_activation_marker INTEGER ']'-                                { ($2++[mj AnnOpenS $1,mj AnnVal $3,mj AnnCloseS $4]-                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }---------------------------------------------------------------------------------- Expressions--quasiquote :: { Located (HsUntypedSplice GhcPs) }-        : TH_QUASIQUOTE   { let { loc = getLoc $1-                                ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1-                                ; quoterId = mkUnqual varName quoter }-                            in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) }-        | TH_QQUASIQUOTE  { let { loc = getLoc $1-                                ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1-                                ; quoterId = mkQual varName (qual, quoter) }-                            in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) }--exp   :: { ECP }-        : infixexp '::' ctype-                                { ECP $-                                   unECP $1 >>= \ $1 ->-                                   rejectPragmaPV $1 >>-                                   mkHsTySigPV (noAnnSrcSpan $ comb2 $1 $>) $1 $3-                                          [(mu AnnDcolon $2)] }-        | infixexp '-<' exp     {% runPV (unECP $1) >>= \ $1 ->-                                   runPV (unECP $3) >>= \ $3 ->-                                   fmap ecpFromCmd $-                                   amsA' (sLL $1 $> $ HsCmdArrApp (mu Annlarrowtail $2) $1 $3-                                                        HsFirstOrderApp True) }-        | infixexp '>-' exp     {% runPV (unECP $1) >>= \ $1 ->-                                   runPV (unECP $3) >>= \ $3 ->-                                   fmap ecpFromCmd $-                                   amsA' (sLL $1 $> $ HsCmdArrApp (mu Annrarrowtail $2) $3 $1-                                                      HsFirstOrderApp False) }-        | infixexp '-<<' exp    {% runPV (unECP $1) >>= \ $1 ->-                                   runPV (unECP $3) >>= \ $3 ->-                                   fmap ecpFromCmd $-                                   amsA' (sLL $1 $> $ HsCmdArrApp (mu AnnLarrowtail $2) $1 $3-                                                      HsHigherOrderApp True) }-        | infixexp '>>-' exp    {% runPV (unECP $1) >>= \ $1 ->-                                   runPV (unECP $3) >>= \ $3 ->-                                   fmap ecpFromCmd $-                                   amsA' (sLL $1 $> $ HsCmdArrApp (mu AnnRarrowtail $2) $3 $1-                                                      HsHigherOrderApp False) }-        -- See Note [%shift: exp -> infixexp]-        | infixexp %shift       { $1 }-        | exp_prag(exp)         { $1 } -- See Note [Pragmas and operator fixity]--        -- Embed types into expressions and patterns for required type arguments-        | 'type' atype-                {% do { requireExplicitNamespaces (getLoc $1)-                      ; return $ ECP $ mkHsEmbTyPV (comb2 $1 $>) (epTok $1) $2 } }--infixexp :: { ECP }-        : exp10 { $1 }-        | infixexp qop exp10p    -- See Note [Pragmas and operator fixity]-                               { ECP $-                                 superInfixOp $-                                 $2 >>= \ $2 ->-                                 unECP $1 >>= \ $1 ->-                                 unECP $3 >>= \ $3 ->-                                 rejectPragmaPV $1 >>-                                 (mkHsOpAppPV (comb2 $1 $3) $1 $2 $3) }-                 -- AnnVal annotation for NPlusKPat, which discards the operator--exp10p :: { ECP }-  : exp10            { $1 }-  | exp_prag(exp10p) { $1 } -- See Note [Pragmas and operator fixity]--exp_prag(e) :: { ECP }-  : prag_e e  -- See Note [Pragmas and operator fixity]-      {% runPV (unECP $2) >>= \ $2 ->-         fmap ecpFromExp $-         amsA' $ (sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) }--exp10 :: { ECP }-        -- See Note [%shift: exp10 -> '-' fexp]-        : '-' fexp %shift               { ECP $-                                           unECP $2 >>= \ $2 ->-                                           mkHsNegAppPV (comb2 $1 $>) $2-                                                 [mj AnnMinus $1] }-        -- See Note [%shift: exp10 -> fexp]-        | fexp %shift                  { $1 }--optSemi :: { (Maybe EpaLocation,Bool) }-        : ';'         { (msemim $1,True) }-        | {- empty -} { (Nothing,False) }--{- Note [Pragmas and operator fixity]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-'prag_e' is an expression pragma, such as {-# SCC ... #-}.--It must be used with care, or else #15730 happens. Consider this infix-expression:--         1 / 2 / 2--There are two ways to parse it:--    1.   (1 / 2) / 2   =  0.25-    2.   1 / (2 / 2)   =  1.0--Due to the fixity of the (/) operator (assuming it comes from Prelude),-option 1 is the correct parse. However, in the past GHC's parser used to get-confused by the SCC annotation when it occurred in the middle of an infix-expression:--         1 / {-# SCC ann #-} 2 / 2    -- used to get parsed as option 2--There are several ways to address this issue, see GHC Proposal #176 for a-detailed exposition:--  https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst--The accepted fix is to disallow pragmas that occur within infix expressions.-Infix expressions are assembled out of 'exp10', so 'exp10' must not accept-pragmas. Instead, we accept them in exactly two places:--* at the start of an expression or a parenthesized subexpression:--    f = {-# SCC ann #-} 1 / 2 / 2          -- at the start of the expression-    g = 5 + ({-# SCC ann #-} 1 / 2 / 2)    -- at the start of a parenthesized subexpression--* immediately after the last operator:--    f = 1 / 2 / {-# SCC ann #-} 2--In both cases, the parse does not depend on operator fixity. The second case-may sound unnecessary, but it's actually needed to support a common idiom:--    f $ {-# SCC ann $-} ...---}-prag_e :: { Located (HsPragE GhcPs) }-      : '{-# SCC' STRING '#-}'      {% do { scc <- getSCC $2-                                          ; return (sLL $1 $>-                                             (HsPragSCC-                                                (AnnPragma (mo $1) (mc $3) [mj AnnValStr $2],-                                                (getSCC_PRAGs $1))-                                                (StringLiteral (getSTRINGs $2) scc Nothing)))} }-      | '{-# SCC' VARID  '#-}'      { sLL $1 $>-                                             (HsPragSCC-                                               (AnnPragma (mo $1) (mc $3) [mj AnnVal $2],-                                               (getSCC_PRAGs $1))-                                               (StringLiteral NoSourceText (getVARID $2) Nothing)) }--fexp    :: { ECP }-        : fexp aexp                  { ECP $-                                          superFunArg $-                                          unECP $1 >>= \ $1 ->-                                          unECP $2 >>= \ $2 ->-                                          spanWithComments (comb2 $1 $>) >>= \l ->-                                          mkHsAppPV l $1 $2 }--        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        | fexp PREFIX_AT atype       { ECP $-                                        unECP $1 >>= \ $1 ->-                                        mkHsAppTypePV (noAnnSrcSpan $ comb2 $1 $>) $1 (epTok $2) $3 }--        | 'static' aexp              {% runPV (unECP $2) >>= \ $2 ->-                                        fmap ecpFromExp $-                                        amsA' (sLL $1 $> $ HsStatic [mj AnnStatic $1] $2) }--        | aexp                       { $1 }--aexp    :: { ECP }-        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        : qvar TIGHT_INFIX_AT aexp-                                { ECP $-                                   unECP $3 >>= \ $3 ->-                                     mkHsAsPatPV (comb2 $1 $>) $1 (epTok $2) $3 }---        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        | PREFIX_TILDE aexp     { ECP $-                                   unECP $2 >>= \ $2 ->-                                   mkHsLazyPatPV (comb2 $1 $>) $2 [mj AnnTilde $1] }-        | PREFIX_BANG aexp      { ECP $-                                   unECP $2 >>= \ $2 ->-                                   mkHsBangPatPV (comb2 $1 $>) $2 [mj AnnBang $1] }-        | PREFIX_MINUS aexp     { ECP $-                                   unECP $2 >>= \ $2 ->-                                   mkHsNegAppPV (comb2 $1 $>) $2 [mj AnnMinus $1] }-        | 'let' binds 'in' exp          {  ECP $-                                           unECP $4 >>= \ $4 ->-                                           mkHsLetPV (comb2 $1 $>) (epTok $1) (unLoc $2) (epTok $3) $4 }-        | '\\' argpats '->' exp { ECP $-                      unECP $4 >>= \ $4 ->-                      mkHsLamPV (comb2 $1 $>) LamSingle-                            (sLLl $1 $>-                            [sLLa $1 $>-                                         $ Match { m_ext = []-                                                 , m_ctxt = LamAlt LamSingle-                                                 , m_pats = $2-                                                 , m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])-                            [mj AnnLam $1] }-        | '\\' 'lcase' altslist(pats1)-            {  ECP $ $3 >>= \ $3 ->-                 mkHsLamPV (comb3 $1 $2 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] }-        | '\\' 'lcases' altslist(argpats)-            {  ECP $ $3 >>= \ $3 ->-                 mkHsLamPV (comb3 $1 $2 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] }-        | 'if' exp optSemi 'then' exp optSemi 'else' exp-                         {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->-                            return $ ECP $-                              unECP $5 >>= \ $5 ->-                              unECP $8 >>= \ $8 ->-                              mkHsIfPV (comb2 $1 $>) $2 (snd $3) $5 (snd $6) $8-                                    (AnnsIf-                                      { aiIf = glAA $1-                                      , aiThen = glAA $4-                                      , aiElse = glAA $7-                                      , aiThenSemi = fst $3-                                      , aiElseSemi = fst $6})}--        | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>= \_ ->-                                           fmap ecpFromExp $-                                           amsA' (sLL $1 $> $ HsMultiIf (mj AnnIf $1:(fst $ unLoc $2))-                                                     (reverse $ snd $ unLoc $2)) }-        | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->-                                             return $ ECP $-                                               $4 >>= \ $4 ->-                                               mkHsCasePV (comb3 $1 $3 $4) $2 $4-                                                    (EpAnnHsCase (glAA $1) (glAA $3) []) }-        -- QualifiedDo.-        | DO  stmtlist               {% do-                                      hintQualifiedDo $1-                                      return $ ECP $-                                        $2 >>= \ $2 ->-                                        mkHsDoPV (comb2 $1 $2)-                                                 (fmap mkModuleNameFS (getDO $1))-                                                 $2-                                                 (AnnList (Just $ glR $2) Nothing Nothing [mj AnnDo $1] []) }-        | MDO stmtlist             {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 ->-                                       fmap ecpFromExp $-                                       amsA' (L (comb2 $1 $2)-                                              (mkHsDoAnns (MDoExpr $-                                                          fmap mkModuleNameFS (getMDO $1))-                                                          $2-                                              (AnnList (Just $ glR $2) Nothing Nothing [mj AnnMdo $1] []) )) }-        | 'proc' aexp '->' exp-                       {% (checkPattern <=< runPV) (unECP $2) >>= \ p ->-                           runPV (unECP $4) >>= \ $4@cmd ->-                           fmap ecpFromExp $-                           amsA' (sLL $1 $> $ HsProc [mj AnnProc $1,mu AnnRarrow $3] p (sLLa $1 $> $ HsCmdTop noExtField cmd)) }--        | aexp1                 { $1 }--aexp1   :: { ECP }-        : aexp1 '{' fbinds '}' { ECP $-                                   getBit OverloadedRecordUpdateBit >>= \ overloaded ->-                                   unECP $1 >>= \ $1 ->-                                   $3 >>= \ $3 ->-                                   mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 $3-                                        [moc $2,mcc $4]-                               }--        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        | aexp1 TIGHT_INFIX_PROJ field-            {% runPV (unECP $1) >>= \ $1 ->-               fmap ecpFromExp $ amsA' (-                 let fl = sLLa $2 $> (DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) $3) in-               sLL $1 $> $ mkRdrGetField $1 fl)  }----        | aexp2                { $1 }--aexp2   :: { ECP }-        : qvar                          { ECP $ mkHsVarPV $! $1 }-        | qcon                          { ECP $ mkHsVarPV $! $1 }-        -- See Note [%shift: aexp2 -> ipvar]-        | ipvar %shift                  {% fmap ecpFromExp-                                           (ams1 $1 (HsIPVar NoExtField $! unLoc $1)) }-        | overloaded_label              {% fmap ecpFromExp-                                           (ams1 $1 (HsOverLabel NoExtField (fst $! unLoc $1) (snd $! unLoc $1))) }-        | literal                       { ECP $ mkHsLitPV $! $1 }--- This will enable overloaded strings permanently.  Normally the renamer turns HsString--- into HsOverLit when -XOverloadedStrings is on.---      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)---                                       (getSTRING $1) noExtField) }-        | INTEGER   { ECP $ mkHsOverLitPV (sL1a $1 $ mkHsIntegral   (getINTEGER  $1)) }-        | RATIONAL  { ECP $ mkHsOverLitPV (sL1a $1 $ mkHsFractional (getRATIONAL $1)) }--        -- N.B.: sections get parsed by these next two productions.-        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't-        -- correct Haskell (you'd have to write '((+ 3), (4 -))')-        -- but the less cluttered version fell out of having texps.-        | '(' texp ')'                  { ECP $-                                           unECP $2 >>= \ $2 ->-                                           mkHsParPV (comb2 $1 $>) (epTok $1) $2 (epTok $3) }-        | '(' tup_exprs ')'             { ECP $-                                           $2 >>= \ $2 ->-                                           mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2-                                                [mop $1,mcp $3]}--        -- This case is only possible when 'OverloadedRecordDotBit' is enabled.-        | '(' projection ')'            { ECP $-                                            amsA' (sLL $1 $> $ mkRdrProjection (NE.reverse (unLoc $2)) (AnnProjection (glAA $1) (glAA $3)) )-                                            >>= ecpFromExp'-                                        }--        | '(#' texp '#)'                { ECP $-                                           unECP $2 >>= \ $2 ->-                                           mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed (Tuple [Right $2])-                                                 [moh $1,mch $3] }-        | '(#' tup_exprs '#)'           { ECP $-                                           $2 >>= \ $2 ->-                                           mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed $2-                                                [moh $1,mch $3] }--        | '[' list ']'      { ECP $ $2 (comb2 $1 $>) (mos $1,mcs $3) }-        | '_'               { ECP $ mkHsWildCardPV (getLoc $1) }--        -- Template Haskell Extension-        | splice_untyped { ECP $ mkHsSplicePV $1 }-        | splice_typed   { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLoc $1) }--        | SIMPLEQUOTE  qvar     {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnSimpleQuote $1] (VarBr noExtField True  $2)) }-        | SIMPLEQUOTE  qcon     {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnSimpleQuote $1] (VarBr noExtField True  $2)) }-        | TH_TY_QUOTE tyvar     {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnThTyQuote $1  ] (VarBr noExtField False $2)) }-        | TH_TY_QUOTE gtycon    {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnThTyQuote $1  ] (VarBr noExtField False $2)) }-        -- See Note [%shift: aexp2 -> TH_TY_QUOTE]-        | TH_TY_QUOTE %shift    {% reportEmptyDoubleQuotes (getLoc $1) }-        | '[|' exp '|]'       {% runPV (unECP $2) >>= \ $2 ->-                                 fmap ecpFromExp $-                                 amsA' (sLL $1 $> $ HsUntypedBracket (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]-                                                                                         else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) (ExpBr noExtField $2)) }-        | '[||' exp '||]'     {% runPV (unECP $2) >>= \ $2 ->-                                 fmap ecpFromExp $-                                 amsA' (sLL $1 $> $ HsTypedBracket (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) $2) }-        | '[t|' ktype '|]'    {% fmap ecpFromExp $-                                 amsA' (sLL $1 $> $ HsUntypedBracket [mo $1,mu AnnCloseQ $3] (TypBr noExtField $2)) }-        | '[p|' infixexp '|]' {% (checkPattern <=< runPV) (unECP $2) >>= \p ->-                                      fmap ecpFromExp $-                                      amsA' (sLL $1 $> $ HsUntypedBracket [mo $1,mu AnnCloseQ $3] (PatBr noExtField p)) }-        | '[d|' cvtopbody '|]' {% fmap ecpFromExp $-                                  amsA' (sLL $1 $> $ HsUntypedBracket (mo $1:mu AnnCloseQ $3:fst $2) (DecBrL noExtField (snd $2))) }-        | quasiquote          { ECP $ mkHsSplicePV $1 }--        -- arrow notation extension-        | '(|' aexp cmdargs '|)'  {% runPV (unECP $2) >>= \ $2 ->-                                      fmap ecpFromCmd $-                                      amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (Just $ mu AnnOpenB $1) (Just $ mu AnnCloseB $4) [] []) $2 Prefix-                                                           Nothing (reverse $3)) }--projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) }-projection-        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer-        : projection TIGHT_INFIX_PROJ field-                             { sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) $3) `NE.cons` unLoc $1) }-        | PREFIX_PROJ field  { sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (AnnFieldLabel (Just $ glAA $1)) $2) :| [])}--splice_exp :: { LHsExpr GhcPs }-        : splice_untyped { fmap (HsUntypedSplice noExtField) (reLoc $1) }-        | splice_typed   { fmap (uncurry HsTypedSplice) (reLoc $1) }--splice_untyped :: { Located (HsUntypedSplice GhcPs) }-        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        : PREFIX_DOLLAR aexp2   {% runPV (unECP $2) >>= \ $2 ->-                                   return (sLL $1 $> $ HsUntypedSpliceExpr [mj AnnDollar $1] $2) }--splice_typed :: { Located ([AddEpAnn], LHsExpr GhcPs) }-        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        : PREFIX_DOLLAR_DOLLAR aexp2-                                {% runPV (unECP $2) >>= \ $2 ->-                                   return (sLL $1 $> $ ([mj AnnDollarDollar $1], $2)) }--cmdargs :: { [LHsCmdTop GhcPs] }-        : cmdargs acmd                  { $2 : $1 }-        | {- empty -}                   { [] }--acmd    :: { LHsCmdTop GhcPs }-        : aexp                  {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) ->-                                   runPV (checkCmdBlockArguments cmd) >>= \ _ ->-                                   return (sL1a cmd $ HsCmdTop noExtField cmd) }--cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) }-        :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1-                                                  ,mj AnnCloseC $3],$2) }-        |      vocurly    cvtopdecls0 close    { ([],$2) }--cvtopdecls0 :: { [LHsDecl GhcPs] }-        : topdecls_semi         { cvTopDecls $1 }-        | topdecls              { cvTopDecls $1 }---------------------------------------------------------------------------------- Tuple expressions---- "texp" is short for tuple expressions:--- things that can appear unparenthesized as long as they're--- inside parens or delimited by commas-texp :: { ECP }-        : exp                           { $1 }--        -- Note [Parsing sections]-        -- ~~~~~~~~~~~~~~~~~~~~~~~-        -- We include left and right sections here, which isn't-        -- technically right according to the Haskell standard.-        -- For example (3 +, True) isn't legal.-        -- However, we want to parse bang patterns like-        --      (!x, !y)-        -- and it's convenient to do so here as a section-        -- Then when converting expr to pattern we unravel it again-        -- Meanwhile, the renamer checks that real sections appear-        -- inside parens.-        | infixexp qop-                             {% runPV (unECP $1) >>= \ $1 ->-                                runPV (rejectPragmaPV $1) >>-                                runPV $2 >>= \ $2 ->-                                return $ ecpFromExp $-                                sLLa $1 $> $ SectionL noExtField $1 (n2l $2) }-        | qopm infixexp      { ECP $-                                superInfixOp $-                                unECP $2 >>= \ $2 ->-                                $1 >>= \ $1 ->-                                mkHsSectionR_PV (comb2 $1 $>) (n2l $1) $2 }--       -- View patterns get parenthesized above-        | exp '->' texp   { ECP $-                             unECP $1 >>= \ $1 ->-                             unECP $3 >>= \ $3 ->-                             mkHsViewPatPV (comb2 $1 $>) $1 $3 [mu AnnRarrow $2] }---- Always at least one comma or bar.--- Though this can parse just commas (without any expressions), it won't--- in practice, because (,,,) is parsed as a name. See Note [ExplicitTuple]--- in GHC.Hs.Expr.-tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }-           : texp commas_tup_tail-                           { unECP $1 >>= \ $1 ->-                             $2 >>= \ $2 ->-                             do { t <- amsA $1 [AddCommaAnn (srcSpan2e $ fst $2)]-                                ; return (Tuple (Right t : snd $2)) } }-           | commas tup_tail-                 { $2 >>= \ $2 ->-                   do { let {cos = map (\ll -> (Left (EpAnn (spanAsAnchor ll) True emptyComments))) (fst $1) }-                      ; return (Tuple (cos ++ $2)) } }--           | texp bars   { unECP $1 >>= \ $1 -> return $-                            (Sum 1  (snd $2 + 1) $1 [] (map srcSpan2e $ fst $2)) }--           | bars texp bars0-                { unECP $2 >>= \ $2 -> return $-                  (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2-                    (map srcSpan2e $ fst $1)-                    (map srcSpan2e $ fst $3)) }---- Always starts with commas; always follows an expr-commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)]) }-commas_tup_tail : commas tup_tail-        { $2 >>= \ $2 ->-          do { let {cos = map (\l -> (Left (EpAnn (spanAsAnchor l) True emptyComments))) (tail $ fst $1) }-             ; return ((head $ fst $1, cos ++ $2)) } }---- Always follows a comma-tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] }-          : texp commas_tup_tail { unECP $1 >>= \ $1 ->-                                   $2 >>= \ $2 ->-                                   do { t <- amsA $1 [AddCommaAnn (srcSpan2e $ fst $2)]-                                      ; return (Right t : snd $2) } }-          | texp                 { unECP $1 >>= \ $1 ->-                                   return [Right $1] }-          -- See Note [%shift: tup_tail -> {- empty -}]-          | {- empty -} %shift   { return [Left noAnn] }---------------------------------------------------------------------------------- List expressions---- The rules below are little bit contorted to keep lexps left-recursive while--- avoiding another shift/reduce-conflict.--- Never empty.-list :: { forall b. DisambECP b => SrcSpan -> (AddEpAnn, AddEpAnn) -> PV (LocatedA b) }-        : texp    { \loc (ao,ac) -> unECP $1 >>= \ $1 ->-                            mkHsExplicitListPV loc [$1] (AnnList Nothing (Just ao) (Just ac) [] []) }-        | lexps   { \loc (ao,ac) -> $1 >>= \ $1 ->-                            mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (Just ao) (Just ac) [] []) }-        | texp '..'  { \loc (ao,ac) -> unECP $1 >>= \ $1 ->-                                  amsA' (L loc $ ArithSeq [ao,mj AnnDotdot $2,ac] Nothing (From $1))-                                      >>= ecpFromExp' }-        | texp ',' exp '..' { \loc (ao,ac) ->-                                   unECP $1 >>= \ $1 ->-                                   unECP $3 >>= \ $3 ->-                                   amsA' (L loc $ ArithSeq [ao,mj AnnComma $2,mj AnnDotdot $4,ac] Nothing (FromThen $1 $3))-                                       >>= ecpFromExp' }-        | texp '..' exp  { \loc (ao,ac) ->-                                   unECP $1 >>= \ $1 ->-                                   unECP $3 >>= \ $3 ->-                                   amsA' (L loc $ ArithSeq [ao,mj AnnDotdot $2,ac] Nothing (FromTo $1 $3))-                                       >>= ecpFromExp' }-        | texp ',' exp '..' exp { \loc (ao,ac) ->-                                   unECP $1 >>= \ $1 ->-                                   unECP $3 >>= \ $3 ->-                                   unECP $5 >>= \ $5 ->-                                   amsA' (L loc $ ArithSeq [ao,mj AnnComma $2,mj AnnDotdot $4,ac] Nothing (FromThenTo $1 $3 $5))-                                       >>= ecpFromExp' }-        | texp '|' flattenedpquals-             { \loc (ao,ac) ->-                checkMonadComp >>= \ ctxt ->-                unECP $1 >>= \ $1 -> do { t <- addTrailingVbarA $1 (gl $2)-                ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (AnnList Nothing (Just ao) (Just ac) [] []))-                    >>= ecpFromExp' } }--lexps :: { forall b. DisambECP b => PV [LocatedA b] }-        : lexps ',' texp           { $1 >>= \ $1 ->-                                     unECP $3 >>= \ $3 ->-                                     case $1 of-                                       (h:t) -> do-                                         h' <- addTrailingCommaA h (gl $2)-                                         return (((:) $! $3) $! (h':t)) }-        | texp ',' texp             { unECP $1 >>= \ $1 ->-                                      unECP $3 >>= \ $3 ->-                                      do { h <- addTrailingCommaA $1 (gl $2)-                                         ; return [$3,h] }}---------------------------------------------------------------------------------- List Comprehensions--flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }-    : pquals   { case (unLoc $1) of-                    [qs] -> sL1 $1 qs-                    -- We just had one thing in our "parallel" list so-                    -- we simply return that thing directly--                    qss -> sL1 $1 [sL1a $1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr |-                                            qs <- qss]-                                            noExpr noSyntaxExpr]-                    -- We actually found some actual parallel lists so-                    -- we wrap them into as a ParStmt-                }--pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }-    : squals '|' pquals-                     {% case unLoc $1 of-                          (h:t) -> do-                            h' <- addTrailingVbarA h (gl $2)-                            return (sLL $1 $> (reverse (h':t) : unLoc $3)) }-    | squals         { L (getLoc $1) [reverse (unLoc $1)] }--squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, because the last-                                        -- one can "grab" the earlier ones-    : squals ',' transformqual-             {% case unLoc $1 of-                  (h:t) -> do-                    h' <- addTrailingCommaA h (gl $2)-                    return (sLL $1 $> [sLLa $1 $> ((unLoc $3) (reverse (h':t)))]) }-    | squals ',' qual-             {% runPV $3 >>= \ $3 ->-                case unLoc $1 of-                  (h:t) -> do-                    h' <- addTrailingCommaA h (gl $2)-                    return (sLL $1 $> ($3 : (h':t))) }-    | transformqual        { sLL $1 $> [L (getLocAnn $1) ((unLoc $1) [])] }-    | qual                               {% runPV $1 >>= \ $1 ->-                                            return $ sL1 $1 [$1] }---  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }---  | '{|' pquals '|}'                       { sL1 $1 [$2] }---- It is possible to enable bracketing (associating) qualifier lists--- by uncommenting the lines with {| |} above. Due to a lack of--- consensus on the syntax, this feature is not being used until we--- get user demand.--transformqual :: { Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }-                        -- Function is applied to a list of stmts *in order*-    : 'then' exp              {% runPV (unECP $2) >>= \ $2 ->-                                 return (-                                 sLL $1 $> (\ss -> (mkTransformStmt [mj AnnThen $1] ss $2))) }-    | 'then' exp 'by' exp     {% runPV (unECP $2) >>= \ $2 ->-                                 runPV (unECP $4) >>= \ $4 ->-                                 return (sLL $1 $> (\ss -> (mkTransformByStmt [mj AnnThen $1,mj AnnBy $3] ss $2 $4))) }-    | 'then' 'group' 'using' exp-            {% runPV (unECP $4) >>= \ $4 ->-               return (sLL $1 $> (\ss -> (mkGroupUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] ss $4))) }--    | 'then' 'group' 'by' exp 'using' exp-            {% runPV (unECP $4) >>= \ $4 ->-               runPV (unECP $6) >>= \ $6 ->-               return (sLL $1 $> (\ss -> (mkGroupByUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] ss $4 $6))) }---- Note that 'group' is a special_id, which means that you can enable--- TransformListComp while still using Data.List.group. However, this--- introduces a shift/reduce conflict. Happy chooses to resolve the conflict--- in by choosing the "group by" variant, which is what we want.---------------------------------------------------------------------------------- Guards--guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }-    : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }--guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }-    : guardquals1 ',' qual  {% runPV $3 >>= \ $3 ->-                               case unLoc $1 of-                                 (h:t) -> do-                                   h' <- addTrailingCommaA h (gl $2)-                                   return (sLL $1 $> ($3 : (h':t))) }-    | qual                  {% runPV $1 >>= \ $1 ->-                               return $ sL1 $1 [$1] }---------------------------------------------------------------------------------- Case alternatives--altslist(PATS) :: { forall b. DisambECP b => PV (LocatedL [LMatch GhcPs (LocatedA b)]) }-        : '{'        alts(PATS) '}'    { $2 >>= \ $2 -> amsr-                                           (sLL $1 $> (reverse (snd $ unLoc $2)))-                                           (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) []) }-        | vocurly    alts(PATS)  close { $2 >>= \ $2 -> amsr-                                           (L (getLoc $2) (reverse (snd $ unLoc $2)))-                                           (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) []) }-        | '{'              '}'   { amsr (sLL $1 $> []) (AnnList Nothing (Just $ moc $1) (Just $ mcc $2) [] []) }-        | vocurly          close { return $ noLocA [] }--alts(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (LocatedA b)])) }-        : alts1(PATS)              { $1 >>= \ $1 -> return $-                                     sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }-        | ';' alts(PATS)           { $2 >>= \ $2 -> return $-                                     sLL $1 $> (((mz AnnSemi $1) ++ (fst $ unLoc $2) )-                                               ,snd $ unLoc $2) }--alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (LocatedA b)])) }-        : alts1(PATS) ';' alt(PATS) { $1 >>= \ $1 ->-                                        $3 >>= \ $3 ->-                                          case snd $ unLoc $1 of-                                            [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)-                                                                            ,[$3]))-                                            (h:t) -> do-                                              h' <- addTrailingSemiA h (gl $2)-                                              return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) }-        | alts1(PATS) ';'           {  $1 >>= \ $1 ->-                                         case snd $ unLoc $1 of-                                           [] -> return (sLZ $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2)-                                                                           ,[]))-                                           (h:t) -> do-                                             h' <- addTrailingSemiA h (gl $2)-                                             return (sLZ $1 $> (fst $ unLoc $1, h' : t)) }-        | alt(PATS)                 { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }--alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }-        : PATS alt_rhs { $2 >>= \ $2 ->-                         amsA' (sLLAsl $1 $>-                                         (Match { m_ext = []-                                                , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing-                                                , m_pats = $1-                                                , m_grhss = unLoc $2 }))}--alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) }-        : ralt wherebinds           { $1 >>= \alt ->-                                      do { let {L l (bs, csw) = adaptWhereBinds $2}-                                         ; acs (comb2 alt (L l bs)) (\loc cs -> L loc (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) }}--ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) }-        : '->' exp            { unECP $2 >>= \ $2 ->-                                acs (comb2 $1 $>) (\loc cs -> L loc (unguardedRHS (EpAnn (spanAsAnchor $ comb2 $1 $2) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) }-        | gdpats              { $1 >>= \gdpats ->-                                return $ sL1 gdpats (reverse (unLoc gdpats)) }--gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) }-        : gdpats gdpat { $1 >>= \gdpats ->-                         $2 >>= \gdpat ->-                         return $ sLL gdpats gdpat (gdpat : unLoc gdpats) }-        | gdpat        { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] }---- layout for MultiWayIf doesn't begin with an open brace, because it's hard to--- generate the open brace in addition to the vertical bar in the lexer, and--- we don't need it.-ifgdpats :: { Located ([AddEpAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }-         : '{' gdpats '}'                 {% runPV $2 >>= \ $2 ->-                                             return $ sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }-         |     gdpats close               {% runPV $1 >>= \ $1 ->-                                             return $ sL1 $1 ([],unLoc $1) }--gdpat   :: { forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b)) }-        : '|' guardquals '->' exp-                                   { unECP $4 >>= \ $4 ->-                                     acsA (comb2 $1 $>) (\loc cs -> sL loc $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) }---- 'pat' recognises a pattern, including one with a bang at the top---      e.g.  "!x" or "!(x,y)" or "C a b" etc--- Bangs inside are parsed as infix operator applications, so that--- we parse them right when bang-patterns are off-pat     :: { LPat GhcPs }-pat     :  exp          {% (checkPattern <=< runPV) (unECP $1) }---- 'pats1' does the same thing as 'pat', but returns it as a singleton--- list so that it can be used with a parameterized production rule------ It is used only for parsing patterns in `\case` and `case of`-pats1   :: { [LPat GhcPs] }-pats1   : pat { [ $1 ] }--bindpat :: { LPat GhcPs }-bindpat :  exp            {% -- See Note [Parser-Validator Details] in GHC.Parser.PostProcess-                             checkPattern_details incompleteDoBlock-                                              (unECP $1) }--argpat   :: { LPat GhcPs }-argpat    : apat                  { $1 }-          | PREFIX_AT atype       { sLLa $1 $> (InvisPat (epTok $1) (mkHsTyPat $2)) }--argpats :: { [LPat GhcPs] }-          : argpat argpats            { $1 : $2 }-          | {- empty -}               { [] }---apat   :: { LPat GhcPs }-apat    : aexp                  {% (checkPattern <=< runPV) (unECP $1) }--apats  :: { [LPat GhcPs] }-        : apat apats            { $1 : $2 }-        | {- empty -}           { [] }---------------------------------------------------------------------------------- Statement sequences--stmtlist :: { forall b. DisambECP b => PV (LocatedL [LocatedA (Stmt GhcPs (LocatedA b))]) }-        : '{'           stmts '}'       { $2 >>= \ $2 ->-                                          amsr (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) (Just $ moc $1) (Just $ mcc $3) (fromOL $ fst $ unLoc $2) []) }-        |     vocurly   stmts close     { $2 >>= \ $2 -> amsr-                                          (L (stmtsLoc $2) (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) Nothing Nothing (fromOL $ fst $ unLoc $2) []) }----      do { ;; s ; s ; ; s ;; }--- The last Stmt should be an expression, but that's hard to enforce--- here, because we need too much lookahead if we see do { e ; }--- So we use BodyStmts throughout, and switch the last one over--- in ParseUtils.checkDo instead--stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs (LocatedA b)])) }-        : stmts ';' stmt  { $1 >>= \ $1 ->-                            $3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) ->-                            case (snd $ unLoc $1) of-                              [] -> return (sLL $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2)-                                                     ,$3   : (snd $ unLoc $1)))-                              (h:t) -> do-                               { h' <- addTrailingSemiA h (gl $2)-                               ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(h':t)) }}--        | stmts ';'     {  $1 >>= \ $1 ->-                           case (snd $ unLoc $1) of-                             [] -> return (sLZ $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2),snd $ unLoc $1))-                             (h:t) -> do-                               { h' <- addTrailingSemiA h (gl $2)-                               ; return $ sLZ $1 $> (fst $ unLoc $1,h':t) }}-        | stmt                   { $1 >>= \ $1 ->-                                   return $ sL1 $1 (nilOL,[$1]) }-        | {- empty -}            { return $ noLoc (nilOL,[]) }----- For typing stmts at the GHCi prompt, where--- the input may consist of just comments.-maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }-        : stmt                          {% fmap Just (runPV $1) }-        | {- nothing -}                 { Nothing }---- For GHC API.-e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }-        : stmt                          {% runPV $1 }--stmt  :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }-        : qual                          { $1 }-        | 'rec' stmtlist                {  $2 >>= \ $2 ->-                                           amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn $1 $2 AnnRec) $2) }--qual  :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }-    : bindpat '<-' exp                   { unECP $3 >>= \ $3 ->-                                           amsA' (sLL $1 $> $ mkPsBindStmt [mu AnnLarrow $2] $1 $3) }-    | exp                                { unECP $1 >>= \ $1 ->-                                           return $ sL1a $1 $ mkBodyStmt $1 }-    | 'let' binds                        { amsA' (sLL $1 $> $ mkLetStmt [mj AnnLet $1] (unLoc $2)) }---------------------------------------------------------------------------------- Record Field Update/Construction--fbinds  :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) }-        : fbinds1                       { $1 }-        | {- empty -}                   { return ([], Nothing) }--fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) }-        : fbind ',' fbinds1-                 { $1 >>= \ $1 ->-                   $3 >>= \ $3 -> do-                   h <- addTrailingCommaFBind $1 (gl $2)-                   return (case $3 of (flds, dd) -> (h : flds, dd)) }-        | fbind                         { $1 >>= \ $1 ->-                                          return ([$1], Nothing) }-        | '..'                          { return ([],   Just (getLoc $1)) }--fbind   :: { forall b. DisambECP b => PV (Fbind b) }-        : qvar '=' texp  { unECP $3 >>= \ $3 ->-                           fmap Left $ amsA' (sLL $1 $> $ HsFieldBind [mj AnnEqual $2] (sL1a $1 $ mkFieldOcc $1) $3 False) }-                        -- RHS is a 'texp', allowing view patterns (#6038)-                        -- and, incidentally, sections.  Eg-                        -- f (R { x = show -> s }) = ...--        | qvar          { placeHolderPunRhs >>= \rhs ->-                          fmap Left $ amsA' (sL1 $1 $ HsFieldBind [] (sL1a $1 $ mkFieldOcc $1) rhs True) }-                        -- In the punning case, use a place-holder-                        -- The renamer fills in the final value--        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        -- AZ: need to pull out the let block into a helper-        | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp-                        { do-                            let top = sL1a $1 $ DotFieldOcc noAnn $1-                                ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)-                                lf' = comb2 $2 (L lf ())-                                fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ glAA $2))  f) : t-                                final = last fields-                                l = comb2 $1 $3-                                isPun = False-                            $5 <- unECP $5-                            fmap Right $ mkHsProjUpdatePV (comb2 $1 $5) (L l fields) $5 isPun-                                            [mj AnnEqual $4]-                        }--        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer-        -- AZ: need to pull out the let block into a helper-        | field TIGHT_INFIX_PROJ fieldToUpdate-                        { do-                            let top =  sL1a $1 $ DotFieldOcc noAnn $1-                                ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)-                                lf' = comb2 $2 (L lf ())-                                fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) f) : t-                                final = last fields-                                l = comb2 $1 $3-                                isPun = True-                            var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final))-                            fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun []-                        }--fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] }-fieldToUpdate-        -- See Note [Whitespace-sensitive operator parsing] in Lexer.x-        : fieldToUpdate TIGHT_INFIX_PROJ field   { sLL $1 $> ((sLLa $2 $> (DotFieldOcc (AnnFieldLabel $ Just $ glAA $2) $3)) : unLoc $1) }-        | field       { sL1 $1 [sL1a $1 (DotFieldOcc (AnnFieldLabel Nothing) $1)] }---------------------------------------------------------------------------------- Implicit Parameter Bindings--dbinds  :: { Located [LIPBind GhcPs] } -- reversed-        : dbinds ';' dbind-                      {% case unLoc $1 of-                           (h:t) -> do-                             h' <- addTrailingSemiA h (gl $2)-                             return (let { this = $3; rest = h':t }-                                in rest `seq` this `seq` sLL $1 $> (this : rest)) }-        | dbinds ';'  {% case unLoc $1 of-                           (h:t) -> do-                             h' <- addTrailingSemiA h (gl $2)-                             return (sLZ $1 $> (h':t)) }-        | dbind                        { let this = $1 in this `seq` (sL1 $1 [this]) }---      | {- empty -}                  { [] }--dbind   :: { LIPBind GhcPs }-dbind   : ipvar '=' exp                {% runPV (unECP $3) >>= \ $3 ->-                                          amsA' (sLL $1 $> (IPBind [mj AnnEqual $2] (reLoc $1) $3)) }--ipvar   :: { Located HsIPName }-        : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }---------------------------------------------------------------------------------- Overloaded labels--overloaded_label :: { Located (SourceText, FastString) }-        : LABELVARID          { sL1 $1 (getLABELVARIDs $1, getLABELVARID $1) }---------------------------------------------------------------------------------- Warnings and deprecations--name_boolformula_opt :: { LBooleanFormula (LocatedN RdrName) }-        : name_boolformula          { $1 }-        | {- empty -}               { noLocA mkTrue }--name_boolformula :: { LBooleanFormula (LocatedN RdrName) }-        : name_boolformula_and                      { $1 }-        | name_boolformula_and '|' name_boolformula-                           {% do { h <- addTrailingVbarL $1 (gl $2)-                                 ; return (sLLa $1 $> (Or [h,$3])) } }--name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) }-        : name_boolformula_and_list-                  { sLLa (head $1) (last $1) (And ($1)) }--name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] }-        : name_boolformula_atom                               { [$1] }-        | name_boolformula_atom ',' name_boolformula_and_list-            {% do { h <- addTrailingCommaL $1 (gl $2)-                  ; return (h : $3) } }--name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) }-        : '(' name_boolformula ')'  {% amsr (sLL $1 $> (Parens $2))-                                      (AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) }-        | name_var                  { sL1a $1 (Var $1) }--namelist :: { Located [LocatedN RdrName] }-namelist : name_var              { sL1 $1 [$1] }-         | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2)-                                       ; return (sLL $1 $> (h : unLoc $3)) }}--name_var :: { LocatedN RdrName }-name_var : var { $1 }-         | con { $1 }---------------------------------------------- Data constructors--- There are two different productions here as lifted list constructors--- are parsed differently.--qcon :: { LocatedN RdrName }-  : gen_qcon              { $1}-  | sysdcon               { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) }--gen_qcon :: { LocatedN RdrName }-  : qconid                { $1 }-  | '(' qconsym ')'       {% amsr (sLL $1 $> (unLoc $2))-                                  (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }--con     :: { LocatedN RdrName }-        : conid                 { $1 }-        | '(' consym ')'        {% amsr (sLL $1 $> (unLoc $2))-                                        (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }-        | sysdcon               { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) }--con_list :: { Located (NonEmpty (LocatedN RdrName)) }-con_list : con                  { sL1 $1 (pure $1) }-         | con ',' con_list     {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) }--qcon_list :: { [LocatedN RdrName] }-qcon_list : qcon                  { [$1] }-          | qcon ',' qcon_list    {% do { h <- addTrailingCommaN $1 (gl $2)-                                        ; return (h : $3) }}---- See Note [ExplicitTuple] in GHC.Hs.Expr-sysdcon_nolist :: { LocatedN DataCon }  -- Wired in data constructors-        : '(' commas ')'        {% amsr (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))-                                       (NameAnnCommas NameParens (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }-        | '(#' '#)'             {% amsr (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }-        | '(#' commas '#)'      {% amsr (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))-                                       (NameAnnCommas NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }---- See Note [Empty lists] in GHC.Hs.Expr-sysdcon :: { LocatedN DataCon }-        : sysdcon_nolist                 { $1 }-        | '(' ')'               {% amsr (sLL $1 $> unitDataCon) (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }-        |  '[' ']'               {% amsr (sLL $1 $> nilDataCon) (NameAnnOnly NameSquare (glAA $1) (glAA $2) []) }--conop :: { LocatedN RdrName }-        : consym                { $1 }-        | '`' conid '`'         {% amsr (sLL $1 $> (unLoc $2))-                                          (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }--qconop :: { LocatedN RdrName }-        : qconsym               { $1 }-        | '`' qconid '`'        {% amsr (sLL $1 $> (unLoc $2))-                                          (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }--------------------------------------------------------------------------------- Type constructors----- See Note [Unit tuples] in GHC.Hs.Type for the distinction--- between gtycon and ntgtycon-gtycon :: { LocatedN RdrName }  -- A "general" qualified tycon, including unit tuples-        : ntgtycon                     { $1 }-        | '(' ')'                      {% amsr (sLL $1 $> $ getRdrName unitTyCon)-                                                (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }-        | '(#' '#)'                    {% amsr (sLL $1 $> $ getRdrName unboxedUnitTyCon)-                                                (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }-        | '[' ']'               {% amsr (sLL $1 $> $ listTyCon_RDR)-                                      (NameAnnOnly NameSquare (glAA $1) (glAA $2) []) }--ntgtycon :: { LocatedN RdrName }  -- A "general" qualified tycon, excluding unit tuples-        : oqtycon               { $1 }-        | '(' commas ')'        {% do { n <- mkTupleSyntaxTycon Boxed (snd $2 + 1)-                                      ; amsr (sLL $1 $> n) (NameAnnCommas NameParens (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }}-        | '(#' commas '#)'      {% do { n <- mkTupleSyntaxTycon Unboxed (snd $2 + 1)-                                      ; amsr (sLL $1 $> n) (NameAnnCommas NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }}-        | '(#' bars '#)'        {% do { requireLTPuns PEP_SumSyntaxType $1 $>-                                      ; amsr (sLL $1 $> $ (getRdrName (sumTyCon (snd $2 + 1))))-                                       (NameAnnBars NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) } }-        | '(' '->' ')'          {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)-                                       (NameAnnRArrow (isUnicode $2) (Just $ glAA $1) (glAA $2) (Just $ glAA $3) []) }--oqtycon :: { LocatedN RdrName }  -- An "ordinary" qualified tycon;-                                -- These can appear in export lists-        : qtycon                        { $1 }-        | '(' qtyconsym ')'             {% amsr (sLL $1 $> (unLoc $2))-                                                  (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }--oqtycon_no_varcon :: { LocatedN RdrName }  -- Type constructor which cannot be mistaken-                                          -- for variable constructor in export lists-                                          -- see Note [Type constructors in export list]-        :  qtycon            { $1 }-        | '(' QCONSYM ')'    {% let { name :: Located RdrName-                                    ; name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2) }-                                in amsr (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }-        | '(' CONSYM ')'     {% let { name :: Located RdrName-                                    ; name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2) }-                                in amsr (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }-        | '(' ':' ')'        {% let { name :: Located RdrName-                                    ; name = sL1 $2 $! consDataCon_RDR }-                                in amsr (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }--{- Note [Type constructors in export list]-~~~~~~~~~~~~~~~~~~~~~-Mixing type constructors and data constructors in export lists introduces-ambiguity in grammar: e.g. (*) may be both a type constructor and a function.---XExplicitNamespaces allows to disambiguate by explicitly prefixing type-constructors with 'type' keyword.--This ambiguity causes reduce/reduce conflicts in parser, which are always-resolved in favour of data constructors. To get rid of conflicts we demand-that ambiguous type constructors (those, which are formed by the same-productions as variable constructors) are always prefixed with 'type' keyword.-Unambiguous type constructors may occur both with or without 'type' keyword.--Note that in the parser we still parse data constructors as type-constructors. As such, they still end up in the type constructor namespace-until after renaming when we resolve the proper namespace for each exported-child.--}--qtyconop :: { LocatedN RdrName } -- Qualified or unqualified-        -- See Note [%shift: qtyconop -> qtyconsym]-        : qtyconsym %shift              { $1 }-        | '`' qtycon '`'                {% amsr (sLL $1 $> (unLoc $2))-                                                (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }--qtycon :: { LocatedN RdrName }   -- Qualified or unqualified-        : QCONID            { sL1n $1 $! mkQual tcClsName (getQCONID $1) }-        | tycon             { $1 }--tycon   :: { LocatedN RdrName }  -- Unqualified-        : CONID                   { sL1n $1 $! mkUnqual tcClsName (getCONID $1) }--qtyconsym :: { LocatedN RdrName }-        : QCONSYM            { sL1n $1 $! mkQual tcClsName (getQCONSYM $1) }-        | QVARSYM            { sL1n $1 $! mkQual tcClsName (getQVARSYM $1) }-        | tyconsym           { $1 }--tyconsym :: { LocatedN RdrName }-        : CONSYM                { sL1n $1 $! mkUnqual tcClsName (getCONSYM $1) }-        | VARSYM                { sL1n $1 $! mkUnqual tcClsName (getVARSYM $1) }-        | ':'                   { sL1n $1 $! consDataCon_RDR }-        | '-'                   { sL1n $1 $! mkUnqual tcClsName (fsLit "-") }-        | '.'                   { sL1n $1 $! mkUnqual tcClsName (fsLit ".") }---- An "ordinary" unqualified tycon. See `oqtycon` for the qualified version.--- These can appear in `ANN type` declarations (#19374).-otycon :: { LocatedN RdrName }-        : tycon                 { $1 }-        | '(' tyconsym ')'      {% amsr (sLL $1 $> (unLoc $2))-                                        (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }---------------------------------------------------------------------------------- Operators--op      :: { LocatedN RdrName }   -- used in infix decls-        : varop                 { $1 }-        | conop                 { $1 }-        | '->'                  {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)-                                     (NameAnnRArrow (isUnicode $1) Nothing (glAA $1) Nothing []) }--varop   :: { LocatedN RdrName }-        : varsym                { $1 }-        | '`' varid '`'         {% amsr (sLL $1 $> (unLoc $2))-                                           (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }--qop     :: { forall b. DisambInfixOp b => PV (LocatedN b) }   -- used in sections-        : qvarop                { mkHsVarOpPV $1 }-        | qconop                { mkHsConOpPV $1 }-        | hole_op               { mkHsInfixHolePV $1 }--qopm    :: { forall b. DisambInfixOp b => PV (LocatedN b) }   -- used in sections-        : qvaropm               { mkHsVarOpPV $1 }-        | qconop                { mkHsConOpPV $1 }-        | hole_op               { mkHsInfixHolePV $1 }--hole_op :: { LocatedN (HsExpr GhcPs) }   -- used in sections-hole_op : '`' '_' '`'           { sLLa $1 $> (hsHoleExpr (Just $ EpAnnUnboundVar (glAA $1, glAA $3) (glAA $2))) }--qvarop :: { LocatedN RdrName }-        : qvarsym               { $1 }-        | '`' qvarid '`'        {% amsr (sLL $1 $> (unLoc $2))-                                           (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }--qvaropm :: { LocatedN RdrName }-        : qvarsym_no_minus      { $1 }-        | '`' qvarid '`'        {% amsr (sLL $1 $> (unLoc $2))-                                           (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }---------------------------------------------------------------------------------- Type variables--tyvar   :: { LocatedN RdrName }-tyvar   : tyvarid               { $1 }--tyvarop :: { LocatedN RdrName }-tyvarop : '`' tyvarid '`'       {% amsr (sLL $1 $> (unLoc $2))-                                           (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }--tyvarid :: { LocatedN RdrName }-        : VARID            { sL1n $1 $! mkUnqual tvName (getVARID $1) }-        | special_id       { sL1n $1 $! mkUnqual tvName (unLoc $1) }-        | 'unsafe'         { sL1n $1 $! mkUnqual tvName (fsLit "unsafe") }-        | 'safe'           { sL1n $1 $! mkUnqual tvName (fsLit "safe") }-        | 'interruptible'  { sL1n $1 $! mkUnqual tvName (fsLit "interruptible") }-        -- If this changes relative to varid, update 'checkRuleTyVarBndrNames'-        -- in GHC.Parser.PostProcess-        -- See Note [Parsing explicit foralls in Rules]---------------------------------------------------------------------------------- Variables--var     :: { LocatedN RdrName }-        : varid                 { $1 }-        | '(' varsym ')'        {% amsr (sLL $1 $> (unLoc $2))-                                   (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }--qvar    :: { LocatedN RdrName }-        : qvarid                { $1 }-        | '(' varsym ')'        {% amsr (sLL $1 $> (unLoc $2))-                                   (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }-        | '(' qvarsym1 ')'      {% amsr (sLL $1 $> (unLoc $2))-                                   (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }--- We've inlined qvarsym here so that the decision about--- whether it's a qvar or a var can be postponed until--- *after* we see the close paren.--field :: { LocatedN FieldLabelString  }-      : varid { fmap (FieldLabelString . occNameFS . rdrNameOcc) $1 }--qvarid :: { LocatedN RdrName }-        : varid               { $1 }-        | QVARID              { sL1n $1 $! mkQual varName (getQVARID $1) }---- Note that 'role' and 'family' get lexed separately regardless of--- the use of extensions. However, because they are listed here,--- this is OK and they can be used as normal varids.--- See Note [Lexing type pseudo-keywords] in GHC.Parser.Lexer-varid :: { LocatedN RdrName }-        : VARID            { sL1n $1 $! mkUnqual varName (getVARID $1) }-        | special_id       { sL1n $1 $! mkUnqual varName (unLoc $1) }-        | 'unsafe'         { sL1n $1 $! mkUnqual varName (fsLit "unsafe") }-        | 'safe'           { sL1n $1 $! mkUnqual varName (fsLit "safe") }-        | 'interruptible'  { sL1n $1 $! mkUnqual varName (fsLit "interruptible")}-        | 'family'         { sL1n $1 $! mkUnqual varName (fsLit "family") }-        | 'role'           { sL1n $1 $! mkUnqual varName (fsLit "role") }-        -- If this changes relative to tyvarid, update 'checkRuleTyVarBndrNames'-        -- in GHC.Parser.PostProcess-        -- See Note [Parsing explicit foralls in Rules]--qvarsym :: { LocatedN RdrName }-        : varsym                { $1 }-        | qvarsym1              { $1 }--qvarsym_no_minus :: { LocatedN RdrName }-        : varsym_no_minus       { $1 }-        | qvarsym1              { $1 }--qvarsym1 :: { LocatedN RdrName }-qvarsym1 : QVARSYM              { sL1n $1 $ mkQual varName (getQVARSYM $1) }--varsym :: { LocatedN RdrName }-        : varsym_no_minus       { $1 }-        | '-'                   { sL1n $1 $ mkUnqual varName (fsLit "-") }--varsym_no_minus :: { LocatedN RdrName } -- varsym not including '-'-        : VARSYM               { sL1n $1 $ mkUnqual varName (getVARSYM $1) }-        | special_sym          { sL1n $1 $ mkUnqual varName (unLoc $1) }----- These special_ids are treated as keywords in various places,--- but as ordinary ids elsewhere.   'special_id' collects all these--- except 'unsafe', 'interruptible', 'forall', 'family', 'role', 'stock', and--- 'anyclass', whose treatment differs depending on context-special_id :: { Located FastString }-special_id-        : 'as'                  { sL1 $1 (fsLit "as") }-        | 'qualified'           { sL1 $1 (fsLit "qualified") }-        | 'hiding'              { sL1 $1 (fsLit "hiding") }-        | 'export'              { sL1 $1 (fsLit "export") }-        | 'label'               { sL1 $1 (fsLit "label")  }-        | 'dynamic'             { sL1 $1 (fsLit "dynamic") }-        | 'stdcall'             { sL1 $1 (fsLit "stdcall") }-        | 'ccall'               { sL1 $1 (fsLit "ccall") }-        | 'capi'                { sL1 $1 (fsLit "capi") }-        | 'prim'                { sL1 $1 (fsLit "prim") }-        | 'javascript'          { sL1 $1 (fsLit "javascript") }-        -- See Note [%shift: special_id -> 'group']-        | 'group' %shift        { sL1 $1 (fsLit "group") }-        | 'stock'               { sL1 $1 (fsLit "stock") }-        | 'anyclass'            { sL1 $1 (fsLit "anyclass") }-        | 'via'                 { sL1 $1 (fsLit "via") }-        | 'unit'                { sL1 $1 (fsLit "unit") }-        | 'dependency'          { sL1 $1 (fsLit "dependency") }-        | 'signature'           { sL1 $1 (fsLit "signature") }--special_sym :: { Located FastString }-special_sym : '.'       { sL1 $1 (fsLit ".") }-            | '*'       { sL1 $1 (starSym (isUnicode $1)) }---------------------------------------------------------------------------------- Data constructors--qconid :: { LocatedN RdrName }   -- Qualified or unqualified-        : conid              { $1 }-        | QCONID             { sL1n $1 $! mkQual dataName (getQCONID $1) }--conid   :: { LocatedN RdrName }-        : CONID                { sL1n $1 $ mkUnqual dataName (getCONID $1) }--qconsym :: { LocatedN RdrName }  -- Qualified or unqualified-        : consym               { $1 }-        | QCONSYM              { sL1n $1 $ mkQual dataName (getQCONSYM $1) }--consym :: { LocatedN RdrName }-        : CONSYM              { sL1n $1 $ mkUnqual dataName (getCONSYM $1) }--        -- ':' means only list cons-        | ':'                { sL1n $1 $ consDataCon_RDR }----------------------------------------------------------------------------------- Literals--literal :: { Located (HsLit GhcPs) }-        : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }-        | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)-                                                    $ getSTRING $1 }-        | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)-                                                    $ getPRIMINTEGER $1 }-        | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)-                                                    $ getPRIMWORD $1 }-        | PRIMINTEGER8      { sL1 $1 $ HsInt8Prim   (getPRIMINTEGER8s $1)-                                                    $ getPRIMINTEGER8 $1 }-        | PRIMINTEGER16     { sL1 $1 $ HsInt16Prim  (getPRIMINTEGER16s $1)-                                                    $ getPRIMINTEGER16 $1 }-        | PRIMINTEGER32     { sL1 $1 $ HsInt32Prim  (getPRIMINTEGER32s $1)-                                                    $ getPRIMINTEGER32 $1 }-        | PRIMINTEGER64     { sL1 $1 $ HsInt64Prim  (getPRIMINTEGER64s $1)-                                                    $ getPRIMINTEGER64 $1 }-        | PRIMWORD8         { sL1 $1 $ HsWord8Prim  (getPRIMWORD8s $1)-                                                    $ getPRIMWORD8 $1 }-        | PRIMWORD16        { sL1 $1 $ HsWord16Prim (getPRIMWORD16s $1)-                                                    $ getPRIMWORD16 $1 }-        | PRIMWORD32        { sL1 $1 $ HsWord32Prim (getPRIMWORD32s $1)-                                                    $ getPRIMWORD32 $1 }-        | PRIMWORD64        { sL1 $1 $ HsWord64Prim (getPRIMWORD64s $1)-                                                    $ getPRIMWORD64 $1 }-        | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)-                                                    $ getPRIMCHAR $1 }-        | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)-                                                    $ getPRIMSTRING $1 }-        | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  noExtField $ getPRIMFLOAT $1 }-        | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim noExtField $ getPRIMDOUBLE $1 }---------------------------------------------------------------------------------- Layout--{- Note [Layout and error]-~~~~~~~~~~~~~~~~~~~~~~~~~~-The Haskell 2010 report (Section 10.3, Note 5) dictates the use of the error-token in `close`. To recall why that is necessary, consider--  f x = case x of-    True -> False-    where y = x+1--The virtual pass L inserts vocurly, semi, vccurly to return a laid-out-token stream. It must insert a vccurly before `where` to close the layout-block introduced by `of`.-But there is no good way to do so other than L becoming aware of the grammar!-Thus, L is specified to detect the ensuing parse error (implemented via-happy's `error` token) and then insert the vccurly.-Thus in effect, L is distributed between Lexer.x and Parser.y.--There are a bunch of other, less "tricky" examples:--  let x = x {- vccurly -} in x   -- could just track bracketing of-                                 -- let..in on layout stack to fix-  (case x of-   True -> False {- vccurly -})  -- ditto for surrounding delimiters such as ()--  data T = T;{- vccurly -}       -- Need insert vccurly at EOF--Many of these are not that hard to fix, but still tedious and prone to break-when the grammar changes; but the `of`/`where` example is especially gnarly,-because it demonstrates a grammatical interaction between two lexically-unrelated tokens.--}-close :: { () }-        : vccurly               { () } -- context popped in lexer.-        | error                 {% popContext } -- See Note [Layout and error]---------------------------------------------------------------------------------- Miscellaneous (mostly renamings)--modid   :: { LocatedA ModuleName }-        : CONID                 { sL1a $1 $ mkModuleNameFS (getCONID $1) }-        | QCONID                { sL1a $1 $ let (mod,c) = getQCONID $1 in-                                  mkModuleNameFS-                                   (concatFS [mod, fsLit ".", c])-                                }--commas :: { ([SrcSpan],Int) }   -- One or more commas-        : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }-        | ','                    { ([gl $1],1) }--bars0 :: { ([SrcSpan],Int) }     -- Zero or more bars-        : bars                   { $1 }-        |                        { ([], 0) }--bars :: { ([SrcSpan],Int) }     -- One or more bars-        : bars '|'               { ((fst $1)++[gl $2],snd $1 + 1) }-        | '|'                    { ([gl $1],1) }--{-happyError :: P a-happyError = srcParseFail--getVARID          (L _ (ITvarid    x)) = x-getCONID          (L _ (ITconid    x)) = x-getVARSYM         (L _ (ITvarsym   x)) = x-getCONSYM         (L _ (ITconsym   x)) = x-getDO             (L _ (ITdo      x)) = x-getMDO            (L _ (ITmdo     x)) = x-getQVARID         (L _ (ITqvarid   x)) = x-getQCONID         (L _ (ITqconid   x)) = x-getQVARSYM        (L _ (ITqvarsym  x)) = x-getQCONSYM        (L _ (ITqconsym  x)) = x-getIPDUPVARID     (L _ (ITdupipvarid   x)) = x-getLABELVARID     (L _ (ITlabelvarid _ x)) = x-getCHAR           (L _ (ITchar   _ x)) = x-getSTRING         (L _ (ITstring _ x)) = x-getINTEGER        (L _ (ITinteger x))  = x-getRATIONAL       (L _ (ITrational x)) = x-getPRIMCHAR       (L _ (ITprimchar _ x)) = x-getPRIMSTRING     (L _ (ITprimstring _ x)) = x-getPRIMINTEGER    (L _ (ITprimint  _ x)) = x-getPRIMWORD       (L _ (ITprimword _ x)) = x-getPRIMINTEGER8   (L _ (ITprimint8 _ x)) = x-getPRIMINTEGER16  (L _ (ITprimint16 _ x)) = x-getPRIMINTEGER32  (L _ (ITprimint32 _ x)) = x-getPRIMINTEGER64  (L _ (ITprimint64 _ x)) = x-getPRIMWORD8      (L _ (ITprimword8 _ x)) = x-getPRIMWORD16     (L _ (ITprimword16 _ x)) = x-getPRIMWORD32     (L _ (ITprimword32 _ x)) = x-getPRIMWORD64     (L _ (ITprimword64 _ x)) = x-getPRIMFLOAT      (L _ (ITprimfloat x)) = x-getPRIMDOUBLE     (L _ (ITprimdouble x)) = x-getINLINE         (L _ (ITinline_prag _ inl conl)) = (inl,conl)-getSPEC_INLINE    (L _ (ITspec_inline_prag src True))  = (Inline src,FunLike)-getSPEC_INLINE    (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike)-getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x-getVOCURLY        (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l--getINTEGERs       (L _ (ITinteger (IL src _ _))) = src-getCHARs          (L _ (ITchar       src _)) = src-getSTRINGs        (L _ (ITstring     src _)) = src-getPRIMCHARs      (L _ (ITprimchar   src _)) = src-getPRIMSTRINGs    (L _ (ITprimstring src _)) = src-getPRIMINTEGERs   (L _ (ITprimint    src _)) = src-getPRIMWORDs      (L _ (ITprimword   src _)) = src-getPRIMINTEGER8s  (L _ (ITprimint8   src _)) = src-getPRIMINTEGER16s (L _ (ITprimint16  src _)) = src-getPRIMINTEGER32s (L _ (ITprimint32  src _)) = src-getPRIMINTEGER64s (L _ (ITprimint64  src _)) = src-getPRIMWORD8s     (L _ (ITprimword8  src _)) = src-getPRIMWORD16s    (L _ (ITprimword16 src _)) = src-getPRIMWORD32s    (L _ (ITprimword32 src _)) = src-getPRIMWORD64s    (L _ (ITprimword64 src _)) = src--getLABELVARIDs    (L _ (ITlabelvarid src _)) = src---- See Note [Pragma source text] in "GHC.Types.SourceText" for the following-getINLINE_PRAGs       (L _ (ITinline_prag       _ inl _)) = inlineSpecSource inl-getOPAQUE_PRAGs       (L _ (ITopaque_prag       src))     = src-getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src-getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src-getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src-getRULES_PRAGs        (L _ (ITrules_prag        src)) = src-getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src-getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src-getSCC_PRAGs          (L _ (ITscc_prag          src)) = src-getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src-getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src-getANN_PRAGs          (L _ (ITann_prag          src)) = src-getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src-getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src-getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src-getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src-getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src-getCTYPEs             (L _ (ITctype             src)) = src--getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l) Nothing--isUnicode :: Located Token -> Bool-isUnicode (L _ (ITforall         iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITdarrow         iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITdcolon         iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITlarrow         iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITrarrow         iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITlarrowtail     iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITrarrowtail     iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITLarrowtail     iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITRarrowtail     iu)) = iu == UnicodeSyntax-isUnicode (L _ (IToparenbar      iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITcparenbar      iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITcloseQuote     iu)) = iu == UnicodeSyntax-isUnicode (L _ (ITstar           iu)) = iu == UnicodeSyntax-isUnicode (L _ ITlolly)               = True-isUnicode _                           = False--hasE :: Located Token -> Bool-hasE (L _ (ITopenExpQuote HasE _)) = True-hasE (L _ (ITopenTExpQuote HasE))  = True-hasE _                             = False--getSCC :: Located Token -> P FastString-getSCC lt = do let s = getSTRING lt-               -- We probably actually want to be more restrictive than this-               if ' ' `elem` unpackFS s-                   then addFatalError $ mkPlainErrorMsgEnvelope (getLoc lt) $ PsErrSpaceInSCC-                   else return s--stringLiteralToHsDocWst :: Located StringLiteral -> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)-stringLiteralToHsDocWst  sl = reLoc $ lexStringLiteral parseIdentifier sl---- Utilities for combining source spans-comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan-comb2 !a !b = combineHasLocs a b--comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan-comb3 !a !b !c = combineSrcSpans (getHasLoc a) (combineHasLocs b c)--comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan-comb4 !a !b !c !d =-    combineSrcSpans (getHasLoc a) $-    combineSrcSpans (getHasLoc b) $-    combineSrcSpans (getHasLoc c) (getHasLoc d)--comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan-comb5 !a !b !c !d !e =-    combineSrcSpans (getHasLoc a) $-    combineSrcSpans (getHasLoc b) $-    combineSrcSpans (getHasLoc c) $-    combineSrcSpans (getHasLoc d) (getHasLoc e)---- strict constructor version:-{-# INLINE sL #-}-sL :: l -> a -> GenLocated l a-sL !loc !a = L loc a---- See Note [Adding location info] for how these utility functions are used---- replaced last 3 CPP macros in this file-{-# INLINE sL0 #-}-sL0 :: a -> Located a-sL0 = L noSrcSpan       -- #define L0   L noSrcSpan--{-# INLINE sL1 #-}-sL1 :: HasLoc a => a -> b -> Located b-sL1 !x = sL (getHasLoc x)   -- #define sL1   sL (getLoc $1)--{-# INLINE sL1a #-}-sL1a :: (HasLoc a, HasAnnotation t) =>  a -> b -> GenLocated t b-sL1a !x = sL (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)--{-# INLINE sL1n #-}-sL1n :: HasLoc a => a -> b -> LocatedN b-sL1n !x = L (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)--{-# INLINE sLL #-}-sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c-sLL !x !y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)--{-# INLINE sLLa #-}-sLLa :: (HasLoc a, HasLoc b, NoAnn t) => a -> b -> c -> LocatedAn t c-sLLa !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)--{-# INLINE sLLl #-}-sLLl :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedL c-sLLl !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)--{-# INLINE sLLAsl #-}-sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c-sLLAsl [] = sL1-sLLAsl (!x:_) = sLL x--{-# INLINE sLZ #-}-sLZ :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c-sLZ !x !y = if isZeroWidthSpan (getHasLoc y)-                 then sL (getHasLoc x)-                 else sL (comb2 x y)--{- Note [Adding location info]-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~--This is done using the three functions below, sL0, sL1-and sLL.  Note that these functions were mechanically-converted from the three macros that used to exist before,-namely L0, L1 and LL.--They each add a SrcSpan to their argument.--   sL0  adds 'noSrcSpan', used for empty productions-     -- This doesn't seem to work anymore -=chak--   sL1  for a production with a single token on the lhs.  Grabs the SrcSpan-        from that token.--   sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from-        the first and last tokens.--These suffice for the majority of cases.  However, we must be-especially careful with empty productions: sLL won't work if the first-or last token on the lhs can represent an empty span.  In these cases,-we have to calculate the span using more of the tokens from the lhs, eg.--        | 'newtype' tycl_hdr '=' newconstr deriving-                { L (comb3 $1 $4 $5)-                    (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }--We provide comb3 and comb4 functions which are useful in such cases.--Be careful: there's no checking that you actually got this right, the-only symptom will be that the SrcSpans of your syntax will be-incorrect.---}---- Make a source location for the file.  We're a bit lazy here and just--- make a point SrcSpan at line 1, column 0.  Strictly speaking we should--- try to find the span of the whole file (ToDo).-fileSrcSpan :: P SrcSpan-fileSrcSpan = do-  l <- getRealSrcLoc;-  let loc = mkSrcLoc (srcLocFile l) 1 1;-  return (mkSrcSpan loc loc)---- Hint about linear types-hintLinear :: MonadP m => SrcSpan -> m ()-hintLinear span = do-  linearEnabled <- getBit LinearTypesBit-  unless linearEnabled $ addError $ mkPlainErrorMsgEnvelope span $ PsErrLinearFunction---- Does this look like (a %m)?-looksLikeMult :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> Bool-looksLikeMult ty1 l_op ty2-  | Unqual op_name <- unLoc l_op-  , occNameFS op_name == fsLit "%"-  , Strict.Just ty1_pos <- getBufSpan (getLocA ty1)-  , Strict.Just pct_pos <- getBufSpan (getLocA l_op)-  , Strict.Just ty2_pos <- getBufSpan (getLocA ty2)-  , bufSpanEnd ty1_pos /= bufSpanStart pct_pos-  , bufSpanEnd pct_pos == bufSpanStart ty2_pos-  = True-  | otherwise = False---- Hint about the MultiWayIf extension-hintMultiWayIf :: SrcSpan -> P ()-hintMultiWayIf span = do-  mwiEnabled <- getBit MultiWayIfBit-  unless mwiEnabled $ addError $ mkPlainErrorMsgEnvelope span PsErrMultiWayIf---- Hint about explicit-forall-hintExplicitForall :: Located Token -> P ()-hintExplicitForall tok = do-    explicit_forall_enabled <- getBit ExplicitForallBit-    in_rule_prag <- getBit InRulePragBit-    unless (explicit_forall_enabled || in_rule_prag) $-      addError $ mkPlainErrorMsgEnvelope (getLoc tok) $-        PsErrExplicitForall (isUnicode tok)---- Hint about qualified-do-hintQualifiedDo :: Located Token -> P ()-hintQualifiedDo tok = do-    qualifiedDo   <- getBit QualifiedDoBit-    case maybeQDoDoc of-      Just qdoDoc | not qualifiedDo ->-        addError $ mkPlainErrorMsgEnvelope (getLoc tok) $-          (PsErrIllegalQualifiedDo qdoDoc)-      _ -> return ()-  where-    maybeQDoDoc = case unLoc tok of-      ITdo (Just m) -> Just $ ftext m <> text ".do"-      ITmdo (Just m) -> Just $ ftext m <> text ".mdo"-      t -> Nothing---- When two single quotes don't followed by tyvar or gtycon, we report the--- error as empty character literal, or TH quote that missing proper type--- variable or constructor. See #13450.-reportEmptyDoubleQuotes :: SrcSpan -> P a-reportEmptyDoubleQuotes span = do-    thQuotes <- getBit ThQuotesBit-    addFatalError $ mkPlainErrorMsgEnvelope span $ PsErrEmptyDoubleQuotes thQuotes--{--%************************************************************************-%*                                                                      *-        Helper functions for generating annotations in the parser-%*                                                                      *-%************************************************************************--For the general principles of the following routines, see Note [exact print annotations]-in GHC.Parser.Annotation---}---- |Construct an AddEpAnn from the annotation keyword and the location--- of the keyword itself-mj :: AnnKeywordId -> Located e -> AddEpAnn-mj !a !l = AddEpAnn a (srcSpan2e $ gl l)--mjN :: AnnKeywordId -> LocatedN e -> AddEpAnn-mjN !a !l = AddEpAnn a (srcSpan2e $ glA l)---- |Construct an AddEpAnn from the annotation keyword and the location--- of the keyword itself, provided the span is not zero width-mz :: AnnKeywordId -> Located e -> [AddEpAnn]-mz !a !l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)]--msemi :: Located e -> [TrailingAnn]-msemi !l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)]--msemiA :: Located e -> [AddEpAnn]-msemiA !l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)]--msemim :: Located e -> Maybe EpaLocation-msemim !l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l)---- |Construct an AddEpAnn from the annotation keyword and the Located Token. If--- the token has a unicode equivalent and this has been used, provide the--- unicode variant of the annotation.-mu :: AnnKeywordId -> Located Token -> AddEpAnn-mu !a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (srcSpan2e l)---- | If the 'Token' is using its unicode variant return the unicode variant of---   the annotation-toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId-toUnicodeAnn !a !t = if isUnicode t then unicodeAnn a else a--toUnicode :: Located Token -> IsUnicodeSyntax-toUnicode t = if isUnicode t then UnicodeSyntax else NormalSyntax---- ---------------------------------------gl :: GenLocated l a -> l-gl = getLoc--glA :: HasLoc a => a -> SrcSpan-glA = getHasLoc--glR :: HasLoc a => a -> Anchor-glR !la = EpaSpan (getHasLoc la)--glEE :: (HasLoc a, HasLoc b) => a -> b -> Anchor-glEE !x !y = spanAsAnchor $ comb2 x y--glRM :: Located a -> Maybe Anchor-glRM (L !l _) = Just $ spanAsAnchor l--glAA :: HasLoc a => a -> EpaLocation-glAA = srcSpan2e . getHasLoc--n2l :: LocatedN a -> LocatedA a-n2l (L !la !a) = L (l2l la) a---- Called at the very end to pick up the EOF position, as well as any comments not allocated yet.-acsFinal :: (EpAnnComments -> Maybe (RealSrcSpan, RealSrcSpan) -> Located a) -> P (Located a)-acsFinal a = do-  let (L l _) = a emptyComments Nothing-  !cs <- getCommentsFor l-  csf <- getFinalCommentsFor l-  meof <- getEofPos-  let ce = case meof of-             Strict.Nothing  -> Nothing-             Strict.Just (pos `Strict.And` gap) -> Just (pos,gap)-  return (a (cs Semi.<> csf) ce)--acs :: (HasLoc l, MonadP m) => l -> (l -> EpAnnComments -> GenLocated l a) -> m (GenLocated l a)-acs !l a = do-  !cs <- getCommentsFor (locA l)-  return (a l cs)--acsA :: (HasLoc l, HasAnnotation t, MonadP m) => l -> (l -> EpAnnComments -> Located a) -> m (GenLocated t a)-acsA !l a = do-  !cs <- getCommentsFor (locA l)-  return $ reLoc (a l cs)--ams1 :: MonadP m => Located a -> b -> m (LocatedA b)-ams1 (L l a) b = do-  !cs <- getCommentsFor l-  return (L (EpAnn (spanAsAnchor l) noAnn cs) b)--amsA' :: (NoAnn t, MonadP m) => Located a -> m (GenLocated (EpAnn t) a)-amsA' (L l a) = do-  !cs <- getCommentsFor l-  return (L (EpAnn (spanAsAnchor l) noAnn cs) a)--amsA :: MonadP m => LocatedA a -> [TrailingAnn] -> m (LocatedA a)-amsA (L !l a) bs = do-  !cs <- getCommentsFor (locA l)-  return (L (addAnnsA l bs cs) a)--amsAl :: MonadP m => LocatedA a -> SrcSpan -> [TrailingAnn] -> m (LocatedA a)-amsAl (L l a) loc bs = do-  !cs <- getCommentsFor loc-  return (L (addAnnsA l bs cs) a)--amsr :: MonadP m => Located a -> an -> m (LocatedAn an a)-amsr (L l a) an = do-  !cs <- getCommentsFor l-  return (L (EpAnn (spanAsAnchor l) an cs) a)---- |Synonyms for AddEpAnn versions of AnnOpen and AnnClose-mo,mc :: Located Token -> AddEpAnn-mo !ll = mj AnnOpen ll-mc !ll = mj AnnClose ll--moc,mcc :: Located Token -> AddEpAnn-moc !ll = mj AnnOpenC ll-mcc !ll = mj AnnCloseC ll--mop,mcp :: Located Token -> AddEpAnn-mop !ll = mj AnnOpenP ll-mcp !ll = mj AnnCloseP ll--moh,mch :: Located Token -> AddEpAnn-moh !ll = mj AnnOpenPH ll-mch !ll = mj AnnClosePH ll--mos,mcs :: Located Token -> AddEpAnn-mos !ll = mj AnnOpenS ll-mcs !ll = mj AnnCloseS ll---- | Parse a Haskell module with Haddock comments. This is done in two steps:------ * 'parseModuleNoHaddock' to build the AST--- * 'addHaddockToModule' to insert Haddock comments into it------ This and the signature module parser are the only parser entry points that--- deal with Haddock comments. The other entry points ('parseDeclaration',--- 'parseExpression', etc) do not insert them into the AST.-parseModule :: P (Located (HsModule GhcPs))-parseModule = parseModuleNoHaddock >>= addHaddockToModule---- | Parse a Haskell signature module with Haddock comments. This is done in two--- steps:------ * 'parseSignatureNoHaddock' to build the AST--- * 'addHaddockToModule' to insert Haddock comments into it------ This and the module parser are the only parser entry points that deal with--- Haddock comments. The other entry points ('parseDeclaration',--- 'parseExpression', etc) do not insert them into the AST.-parseSignature :: P (Located (HsModule GhcPs))-parseSignature = parseSignatureNoHaddock >>= addHaddockToModule--commentsA :: (NoAnn ann) => SrcSpan -> EpAnnComments -> EpAnn ann-commentsA loc cs = EpAnn (EpaSpan loc) noAnn cs--spanWithComments :: (NoAnn ann, MonadP m) => SrcSpan -> m (EpAnn ann)-spanWithComments l = do-  !cs <- getCommentsFor l-  return (commentsA l cs)---- | Instead of getting the *enclosed* comments, this includes the--- *preceding* ones.  It is used at the top level to get comments--- between top level declarations.-commentsPA :: (NoAnn ann) => LocatedAn ann a -> P (LocatedAn ann a)-commentsPA la@(L l a) = do-  !cs <- getPriorCommentsFor (getLocA la)-  return (L (addCommentsToEpAnn l cs) a)--hsDoAnn :: Located a -> LocatedAn t b -> AnnKeywordId -> AnnList-hsDoAnn (L l _) (L ll _) kw-  = AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (srcSpan2e l)] []--listAsAnchor :: [LocatedAn t a] -> Located b -> Anchor-listAsAnchor [] (L l _) = spanAsAnchor l-listAsAnchor (h:_) s = spanAsAnchor (comb2 h s)--listAsAnchorM :: [LocatedAn t a] -> Maybe Anchor-listAsAnchorM [] = Nothing-listAsAnchorM (L l _:_) =-  case locA l of-    RealSrcSpan ll _ -> Just $ realSpanAsAnchor ll-    _                -> Nothing--epTok :: Located Token -> EpToken tok-epTok (L !l _) = EpTok (EpaSpan l)--epUniTok :: Located Token -> EpUniToken tok utok-epUniTok t@(L !l _) = EpUniTok (EpaSpan l) u-  where-    u = if isUnicode t then UnicodeSyntax else NormalSyntax--epExplicitBraces :: Located Token -> Located Token -> EpLayout-epExplicitBraces !t1 !t2 = EpExplicitBraces (epTok t1) (epTok t2)---- ---------------------------------------addTrailingCommaFBind :: MonadP m => Fbind b -> SrcSpan -> m (Fbind b)-addTrailingCommaFBind (Left b)  l = fmap Left  (addTrailingCommaA b l)-addTrailingCommaFBind (Right b) l = fmap Right (addTrailingCommaA b l)--addTrailingVbarA :: MonadP m => LocatedA a -> SrcSpan -> m (LocatedA a)-addTrailingVbarA  la span = addTrailingAnnA la span AddVbarAnn--addTrailingSemiA :: MonadP m => LocatedA a -> SrcSpan -> m (LocatedA a)-addTrailingSemiA  la span = addTrailingAnnA la span AddSemiAnn--addTrailingCommaA :: MonadP m => LocatedA a -> SrcSpan -> m (LocatedA a)-addTrailingCommaA  la span = addTrailingAnnA la span AddCommaAnn--addTrailingAnnA :: MonadP m => LocatedA a -> SrcSpan -> (EpaLocation -> TrailingAnn) -> m (LocatedA a)-addTrailingAnnA (L anns a) ss ta = do-  let cs = emptyComments-  -- AZ:TODO: generalise updating comments into an annotation-  let-    anns' = if isZeroWidthSpan ss-              then anns-              else addTrailingAnnToA (ta (srcSpan2e ss)) cs anns-  return (L anns' a)---- ---------------------------------------addTrailingVbarL :: MonadP m => LocatedL a -> SrcSpan -> m (LocatedL a)-addTrailingVbarL  la span = addTrailingAnnL la (AddVbarAnn (srcSpan2e span))--addTrailingCommaL :: MonadP m => LocatedL a -> SrcSpan -> m (LocatedL a)-addTrailingCommaL  la span = addTrailingAnnL la (AddCommaAnn (srcSpan2e span))--addTrailingAnnL :: MonadP m => LocatedL a -> TrailingAnn -> m (LocatedL a)-addTrailingAnnL (L anns a) ta = do-  !cs <- getCommentsFor (locA anns)-  let anns' = addTrailingAnnToL ta cs anns-  return (L anns' a)---- ----------------------------------------- Mostly use to add AnnComma, special case it to NOP if adding a zero-width annotation-addTrailingCommaN :: MonadP m => LocatedN a -> SrcSpan -> m (LocatedN a)-addTrailingCommaN (L anns a) span = do-  let cs = emptyComments-  -- AZ:TODO: generalise updating comments into an annotation-  let anns' = if isZeroWidthSpan span-                then anns-                else addTrailingCommaToN anns (srcSpan2e span)-  return (L anns' a)--addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral-addTrailingCommaS (L l sl) span-    = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaToNoCommentsLocation span) })---- ---------------------------------------addTrailingDarrowC :: LocatedC a -> Located Token -> EpAnnComments -> LocatedC a-addTrailingDarrowC (L (EpAnn lr (AnnContext _ o c) csc) a) lt cs =-  let-    u = if (isUnicode lt) then UnicodeSyntax else NormalSyntax-  in L (EpAnn lr (AnnContext (Just (u,glAA lt)) o c) (cs Semi.<> csc)) a---- -------------------------------------+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Context:+    sigdecl -> '{-# INLINE' . activation qvarcon '#-}'+    activation -> {- empty -}+    activation -> explicit_activation++Example:++    {-# INLINE [0] Something #-}++Ambiguity:+    We don't know whether the '[' is the start of the activation or the beginning+    of the [] data constructor.+    We parse this as having '[0]' activation for inlining 'Something', rather than+    empty activation and inlining '[0] Something'.+-}++{- Note [%shift: orpats -> exp]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Context:++    texp -> exp .+    orpats -> exp .+    texp -> exp . '->' texp+    orpats -> exp . ';' orpats++    in Lookahead ')': reduce/reduce conflict between the two first productions++Example:++    f (True) = 3+       ----^++Ambiguity:+    We don't know whether the ')' encloses a parenthesized pat (reduce with+    first production) or a unary Or pattern (reduce with second production).+    We want to parse it as a parenthesized pat, because+      * That is the status quo+      * Parsing it as a unary Or patterns prompts the user to activate -XOrPatterns.+    Thus, we add a %shift pragma to `orpats -> exp` to lower its precedence,+    which has the effect of letting `texp -> exp` win (!).++An alternative to resolve this ambiguity would be to accept only OrPatterns+with at least two patterns in `orpats`, just as in `tup_exprs`.+But the present code seems simpler, because it just needs one non-terminal,+at the expense of using a small pragma.+-}++{- Note [Parser API Annotations]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A lot of the productions are now cluttered with calls to+aa,am,acs,acsA etc.++These are helper functions to make sure that the locations of the+various keywords such as do / let / in are captured for use by tools+that want to do source to source conversions, such as refactorers or+structured editors.++The helper functions are defined at the bottom of this file.++See+  https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations and+  https://gitlab.haskell.org/ghc/ghc/wikis/ghc-ast-annotations+for some background.++-}++{- Note [Parsing lists]+~~~~~~~~~~~~~~~~~~~~~~~+You might be wondering why we spend so much effort encoding our lists this+way:++importdecls+        : importdecls ';' importdecl+        | importdecls ';'+        | importdecl+        | {- empty -}++This might seem like an awfully roundabout way to declare a list; plus, to add+insult to injury you have to reverse the results at the end.  The answer is that+left recursion prevents us from running out of stack space when parsing long+sequences. See:+https://haskell-happy.readthedocs.io/en/latest/using.html#parsing-sequences+for more guidance.++By adding/removing branches, you can affect what lists are accepted.  Here+are the most common patterns, rewritten as regular expressions for clarity:++    -- Equivalent to: ';'* (x ';'+)* x?  (can be empty, permits leading/trailing semis)+    xs : xs ';' x+       | xs ';'+       | x+       | {- empty -}++    -- Equivalent to x (';' x)* ';'*  (non-empty, permits trailing semis)+    xs : xs ';' x+       | xs ';'+       | x++    -- Equivalent to ';'* alts (';' alts)* ';'* (non-empty, permits leading/trailing semis)+    alts : alts1+         | ';' alts+    alts1 : alts1 ';' alt+          | alts1 ';'+          | alt++    -- Equivalent to x (',' x)+ (non-empty, no trailing semis)+    xs : x+       | x ',' xs+-}++%token+ '_'            { L _ ITunderscore }            -- Haskell keywords+ 'as'           { L _ ITas }+ 'case'         { L _ ITcase }+ 'class'        { L _ ITclass }+ 'data'         { L _ ITdata }+ 'default'      { L _ ITdefault }+ 'deriving'     { L _ ITderiving }+ 'else'         { L _ ITelse }+ 'hiding'       { L _ IThiding }+ 'if'           { L _ ITif }+ 'import'       { L _ ITimport }+ 'in'           { L _ ITin }+ 'infix'        { L _ ITinfix }+ 'infixl'       { L _ ITinfixl }+ 'infixr'       { L _ ITinfixr }+ 'instance'     { L _ ITinstance }+ 'let'          { L _ ITlet }+ 'module'       { L _ ITmodule }+ 'newtype'      { L _ ITnewtype }+ 'of'           { L _ ITof }+ 'qualified'    { L _ ITqualified }+ 'then'         { L _ ITthen }+ 'type'         { L _ ITtype }+ 'where'        { L _ ITwhere }++ 'forall'       { L _ (ITforall _) }                -- GHC extension keywords+ 'foreign'      { L _ ITforeign }+ 'export'       { L _ ITexport }+ 'label'        { L _ ITlabel }+ 'dynamic'      { L _ ITdynamic }+ 'safe'         { L _ ITsafe }+ 'interruptible' { L _ ITinterruptible }+ 'unsafe'       { L _ ITunsafe }+ 'family'       { L _ ITfamily }+ 'role'         { L _ ITrole }+ 'stdcall'      { L _ ITstdcallconv }+ 'ccall'        { L _ ITccallconv }+ 'capi'         { L _ ITcapiconv }+ 'prim'         { L _ ITprimcallconv }+ 'javascript'   { L _ ITjavascriptcallconv }+ 'proc'         { L _ ITproc }          -- for arrow notation extension+ 'rec'          { L _ ITrec }           -- for arrow notation extension+ 'group'    { L _ ITgroup }     -- for list transform extension+ 'by'       { L _ ITby }        -- for list transform extension+ 'using'    { L _ ITusing }     -- for list transform extension+ 'pattern'      { L _ ITpattern } -- for pattern synonyms+ 'static'       { L _ ITstatic }  -- for static pointers extension+ 'stock'        { L _ ITstock }    -- for DerivingStrategies extension+ 'anyclass'     { L _ ITanyclass } -- for DerivingStrategies extension+ 'via'          { L _ ITvia }      -- for DerivingStrategies extension++ 'unit'         { L _ ITunit }+ 'signature'    { L _ ITsignature }+ 'dependency'   { L _ ITdependency }++ '{-# INLINE'             { L _ (ITinline_prag _ _ _) } -- INLINE or INLINABLE+ '{-# OPAQUE'             { L _ (ITopaque_prag _) }+ '{-# SPECIALISE'         { L _ (ITspec_prag _) }+ '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }+ '{-# SOURCE'             { L _ (ITsource_prag _) }+ '{-# RULES'              { L _ (ITrules_prag _) }+ '{-# SCC'                { L _ (ITscc_prag _)}+ '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }+ '{-# WARNING'            { L _ (ITwarning_prag _) }+ '{-# UNPACK'             { L _ (ITunpack_prag _) }+ '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }+ '{-# ANN'                { L _ (ITann_prag _) }+ '{-# MINIMAL'            { L _ (ITminimal_prag _) }+ '{-# CTYPE'              { L _ (ITctype _) }+ '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }+ '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }+ '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }+ '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }+ '{-# COMPLETE'           { L _ (ITcomplete_prag _)   }+ '#-}'                    { L _ ITclose_prag }++ '..'           { L _ ITdotdot }                        -- reserved symbols+ ':'            { L _ ITcolon }+ '::'           { L _ (ITdcolon _) }+ '='            { L _ ITequal }+ '\\'           { L _ ITlam }+ 'lcase'        { L _ ITlcase }+ 'lcases'       { L _ ITlcases }+ '|'            { L _ ITvbar }+ '<-'           { L _ (ITlarrow _) }+ '->'           { L _ (ITrarrow _) }+ '->.'          { L _ ITlolly }+ TIGHT_INFIX_AT { L _ ITat }+ '=>'           { L _ (ITdarrow _) }+ '-'            { L _ ITminus }+ PREFIX_TILDE   { L _ ITtilde }+ PREFIX_BANG    { L _ ITbang }+ PREFIX_MINUS   { L _ ITprefixminus }+ '*'            { L _ (ITstar _) }+ '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation+ '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation+ '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation+ '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation+ '.'            { L _ ITdot }+ PREFIX_PROJ    { L _ (ITproj True) }               -- RecordDotSyntax+ TIGHT_INFIX_PROJ { L _ (ITproj False) }            -- RecordDotSyntax+ PREFIX_AT      { L _ ITtypeApp }+ PREFIX_PERCENT { L _ ITpercent }                   -- for linear types++ '{'            { L _ ITocurly }                        -- special symbols+ '}'            { L _ ITccurly }+ vocurly        { L _ ITvocurly } -- virtual open curly (from layout)+ vccurly        { L _ ITvccurly } -- virtual close curly (from layout)+ '['            { L _ ITobrack }+ ']'            { L _ ITcbrack }+ '('            { L _ IToparen }+ ')'            { L _ ITcparen }+ '(#'           { L _ IToubxparen }+ '#)'           { L _ ITcubxparen }+ '(|'           { L _ (IToparenbar _) }+ '|)'           { L _ (ITcparenbar _) }+ ';'            { L _ ITsemi }+ ','            { L _ ITcomma }+ '`'            { L _ ITbackquote }+ SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x++ VARID          { L _ (ITvarid    _) }          -- identifiers+ CONID          { L _ (ITconid    _) }+ VARSYM         { L _ (ITvarsym   _) }+ CONSYM         { L _ (ITconsym   _) }+ QVARID         { L _ (ITqvarid   _) }+ QCONID         { L _ (ITqconid   _) }+ QVARSYM        { L _ (ITqvarsym  _) }+ QCONSYM        { L _ (ITqconsym  _) }+++ -- QualifiedDo+ DO             { L _ (ITdo  _) }+ MDO            { L _ (ITmdo _) }++ IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension+ LABELVARID     { L _ (ITlabelvarid _ _) }++ CHAR           { L _ (ITchar   _ _) }+ STRING         { L _ (ITstring _ _) }+ STRING_MULTI   { L _ (ITstringMulti _ _) }+ INTEGER        { L _ (ITinteger _) }+ RATIONAL       { L _ (ITrational _) }++ PRIMCHAR       { L _ (ITprimchar   _ _) }+ PRIMSTRING     { L _ (ITprimstring _ _) }+ PRIMINTEGER    { L _ (ITprimint    _ _) }+ PRIMWORD       { L _ (ITprimword   _ _) }+ PRIMINTEGER8   { L _ (ITprimint8   _ _) }+ PRIMINTEGER16  { L _ (ITprimint16  _ _) }+ PRIMINTEGER32  { L _ (ITprimint32  _ _) }+ PRIMINTEGER64  { L _ (ITprimint64  _ _) }+ PRIMWORD8      { L _ (ITprimword8  _ _) }+ PRIMWORD16     { L _ (ITprimword16 _ _) }+ PRIMWORD32     { L _ (ITprimword32 _ _) }+ PRIMWORD64     { L _ (ITprimword64 _ _) }+ PRIMFLOAT      { L _ (ITprimfloat  _) }+ PRIMDOUBLE     { L _ (ITprimdouble _) }++-- Template Haskell+'[|'            { L _ (ITopenExpQuote _ _) }+'[p|'           { L _ ITopenPatQuote  }+'[t|'           { L _ ITopenTypQuote  }+'[d|'           { L _ ITopenDecQuote  }+'|]'            { L _ (ITcloseQuote _) }+'[||'           { L _ (ITopenTExpQuote _) }+'||]'           { L _ ITcloseTExpQuote  }+PREFIX_DOLLAR   { L _ ITdollar }+PREFIX_DOLLAR_DOLLAR { L _ ITdollardollar }+TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T+TH_QUASIQUOTE   { L _ (ITquasiQuote _) }+TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }++%monad { P } { >>= } { return }+%lexer { (lexer True) } { L _ ITeof }+  -- Replace 'lexer' above with 'lexerDbg'+  -- to dump the tokens fed to the parser.+%tokentype { (Located Token) }++-- Exported parsers+%name parseModuleNoHaddock module+%name parseSignatureNoHaddock signature+%name parseImport importdecl+%name parseStatement e_stmt+%name parseDeclaration topdecl+%name parseExpression exp+%name parsePattern pat+%name parseTypeSignature sigdecl+%name parseStmt   maybe_stmt+%name parseIdentifier  identifier+%name parseType ktype+%name parseBackpack backpack+%partial parseHeader header+%%++-----------------------------------------------------------------------------+-- Identifiers; one of the entry points+identifier :: { LocatedN RdrName }+        : qvar                          { $1 }+        | qcon                          { $1 }+        | qvarop                        { $1 }+        | qconop                        { $1 }+    | '->'              {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)+                                (NameAnnRArrow  Nothing (epUniTok $1) Nothing []) }++-----------------------------------------------------------------------------+-- Backpack stuff++backpack :: { [LHsUnit PackageName] }+         : implicit_top units close { fromOL $2 }+         | '{' units '}'            { fromOL $2 }++units :: { OrdList (LHsUnit PackageName) }+         : units ';' unit { $1 `appOL` unitOL $3 }+         | units ';'      { $1 }+         | unit           { unitOL $1 }++unit :: { LHsUnit PackageName }+        : 'unit' pkgname 'where' unitbody+            { sL1 $1 $ HsUnit { hsunitName = $2+                              , hsunitBody = fromOL $4 } }++unitid :: { LHsUnitId PackageName }+        : pkgname                  { sL1 $1 $ HsUnitId $1 [] }+        | pkgname '[' msubsts ']'  { sLL $1 $> $ HsUnitId $1 (fromOL $3) }++msubsts :: { OrdList (LHsModuleSubst PackageName) }+        : msubsts ',' msubst { $1 `appOL` unitOL $3 }+        | msubsts ','        { $1 }+        | msubst             { unitOL $1 }++msubst :: { LHsModuleSubst PackageName }+        : modid '=' moduleid { sLL $1 $> $ (reLoc $1, $3) }+        | modid VARSYM modid VARSYM { sLL $1 $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) }++moduleid :: { LHsModuleId PackageName }+          : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) }+          | unitid ':' modid    { sLL $1 $> $ HsModuleId $1 (reLoc $3) }++pkgname :: { Located PackageName }+        : STRING     { sL1 $1 $ PackageName (getSTRING $1) }+        | litpkgname { sL1 $1 $ PackageName (unLoc $1) }++litpkgname_segment :: { Located FastString }+        : VARID  { sL1 $1 $ getVARID $1 }+        | CONID  { sL1 $1 $ getCONID $1 }+        | special_id { $1 }++-- Parse a minus sign regardless of whether -XLexicalNegation is turned on or off.+-- See Note [Minus tokens] in GHC.Parser.Lexer+HYPHEN :: { () }+      : '-'          { () }+      | PREFIX_MINUS { () }+      | VARSYM       { () }++litpkgname :: { Located FastString }+        : litpkgname_segment { $1 }+        -- a bit of a hack, means p - b is parsed same as p-b, enough for now.+        | litpkgname_segment HYPHEN litpkgname  { sLL $1 $> $ concatFS [unLoc $1, fsLit "-", (unLoc $3)] }++mayberns :: { Maybe [LRenaming] }+        : {- empty -} { Nothing }+        | '(' rns ')' { Just (fromOL $2) }++rns :: { OrdList LRenaming }+        : rns ',' rn { $1 `appOL` unitOL $3 }+        | rns ','    { $1 }+        | rn         { unitOL $1 }++rn :: { LRenaming }+        : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) }+        | modid            { sL1 $1    $ Renaming (reLoc $1) Nothing }++unitbody :: { OrdList (LHsUnitDecl PackageName) }+        : '{'     unitdecls '}'   { $2 }+        | vocurly unitdecls close { $2 }++unitdecls :: { OrdList (LHsUnitDecl PackageName) }+        : unitdecls ';' unitdecl { $1 `appOL` unitOL $3 }+        | unitdecls ';'         { $1 }+        | unitdecl              { unitOL $1 }++unitdecl :: { LHsUnitDecl PackageName }+        : 'module' maybe_src modid maybe_warning_pragma maybeexports 'where' body+             -- XXX not accurate+             { sL1 $1 $ DeclD+                 (case snd $2 of+                   NotBoot -> HsSrcFile+                   IsBoot  -> HsBootFile)+                 (reLoc $3)+                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7))) }+        | 'signature' modid maybe_warning_pragma maybeexports 'where' body+             { sL1 $1 $ DeclD+                 HsigFile+                 (reLoc $2)+                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6))) }+        | 'dependency' unitid mayberns+             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2+                                              , idModRenaming = $3+                                              , idSignatureInclude = False }) }+        | 'dependency' 'signature' unitid+             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $3+                                              , idModRenaming = Nothing+                                              , idSignatureInclude = True }) }++-----------------------------------------------------------------------------+-- Module Header++-- The place for module deprecation is really too restrictive, but if it+-- was allowed at its natural place just before 'module', we get an ugly+-- s/r conflict with the second alternative. Another solution would be the+-- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,+-- either, and DEPRECATED is only expected to be used by people who really+-- know what they are doing. :-)++signature :: { Located (HsModule GhcPs) }+       : 'signature' modid maybe_warning_pragma maybeexports 'where' body+             {% fileSrcSpan >>= \ loc ->+                acs loc (\loc cs-> (L loc (HsModule (XModulePs+                                               (EpAnn (spanAsAnchor loc) (AnnsModule (epTok $1) NoEpTok (epTok $5) (fstOf3 $6) [] Nothing) cs)+                                               (thdOf3 $6) $3 Nothing)+                                            (Just $2) $4 (fst $ sndOf3 $6)+                                            (snd $ sndOf3 $6)))+                    ) }++module :: { Located (HsModule GhcPs) }+       : 'module' modid maybe_warning_pragma maybeexports 'where' body+             {% fileSrcSpan >>= \ loc ->+                acsFinal (\cs eof -> (L loc (HsModule (XModulePs+                                                     (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fstOf3 $6) [] eof) cs)+                                                     (thdOf3 $6) $3 Nothing)+                                                  (Just $2) $4 (fst $ sndOf3 $6)+                                                  (snd $ sndOf3 $6))+                    )) }+        | body2+                {% fileSrcSpan >>= \ loc ->+                   acsFinal (\cs eof -> (L loc (HsModule (XModulePs+                                                        (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok (fstOf3 $1) [] eof) cs)+                                                        (thdOf3 $1) Nothing Nothing)+                                                     Nothing Nothing+                                                     (fst $ sndOf3 $1) (snd $ sndOf3 $1)))) }++missing_module_keyword :: { () }+        : {- empty -}                           {% pushModuleContext }++implicit_top :: { () }+        : {- empty -}                           {% pushModuleContext }++body    :: { ([TrailingAnn]+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])+             ,EpLayout) }+        :  '{'            top '}'      { (fst $2, snd $2, epExplicitBraces $1 $3) }+        |      vocurly    top close    { (fst $2, snd $2, EpVirtualBraces (getVOCURLY $1)) }++body2   :: { ([TrailingAnn]+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])+             ,EpLayout) }+        :  '{' top '}'                          { (fst $2, snd $2, epExplicitBraces $1 $3) }+        |  missing_module_keyword top close     { ([], snd $2, EpVirtualBraces leftmostColumn) }+++top     :: { ([TrailingAnn]+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }+        : semis top1                            { (reverse $1, $2) }++top1    :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }+        : importdecls_semi topdecls_cs_semi        { (reverse $1, cvTopDecls $2) }+        | importdecls_semi topdecls_cs             { (reverse $1, cvTopDecls $2) }+        | importdecls                              { (reverse $1, []) }++-----------------------------------------------------------------------------+-- Module declaration & imports only++header  :: { Located (HsModule GhcPs) }+        : 'module' modid maybe_warning_pragma maybeexports 'where' header_body+                {% fileSrcSpan >>= \ loc ->+                   acs loc (\loc cs -> (L loc (HsModule (XModulePs+                                                   (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok  $1) (epTok $5) [] [] Nothing) cs)+                                                   EpNoLayout $3 Nothing)+                                                (Just $2) $4 $6 []+                          ))) }+        | 'signature' modid maybe_warning_pragma maybeexports 'where' header_body+                {% fileSrcSpan >>= \ loc ->+                   acs loc (\loc cs -> (L loc (HsModule (XModulePs+                                                   (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) [] [] Nothing) cs)+                                                   EpNoLayout $3 Nothing)+                                                (Just $2) $4 $6 []+                          ))) }+        | header_body2+                {% fileSrcSpan >>= \ loc ->+                   return (L loc (HsModule (XModulePs noAnn EpNoLayout Nothing Nothing) Nothing Nothing $1 [])) }++header_body :: { [LImportDecl GhcPs] }+        :  '{'            header_top            { $2 }+        |      vocurly    header_top            { $2 }++header_body2 :: { [LImportDecl GhcPs] }+        :  '{' header_top                       { $2 }+        |  missing_module_keyword header_top    { $2 }++header_top :: { [LImportDecl GhcPs] }+        :  semis header_top_importdecls         { $2 }++header_top_importdecls :: { [LImportDecl GhcPs] }+        :  importdecls_semi                     { $1 }+        |  importdecls                          { $1 }++-----------------------------------------------------------------------------+-- The Export List++maybeexports :: { (Maybe (LocatedLI [LIE GhcPs])) }+        :  '(' exportlist ')'       {% fmap Just $ amsr (sLL $1 $> (fromOL $ snd $2))+                                        (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) []) }+        |  {- empty -}              { Nothing }++exportlist :: { ([EpToken ","], OrdList (LIE GhcPs)) }+        : exportlist1     { ([], $1) }+        | {- empty -}     { ([], nilOL) }++        -- trailing comma:+        | exportlist1 ',' {% case $1 of+                               SnocOL hs t -> do+                                 t' <- addTrailingCommaA t (epTok $2)+                                 return ([], snocOL hs t')}+        | ','             { ([epTok $1], nilOL) }++exportlist1 :: { OrdList (LIE GhcPs) }+        : exportlist1 ',' export_cs+                          {% let ls = $1+                             in if isNilOL ls+                                  then return (ls `appOL` $3)+                                  else case ls of+                                         SnocOL hs t -> do+                                           t' <- addTrailingCommaA t (epTok $2)+                                           return (snocOL hs t' `appOL` $3)}+        | export_cs       { $1 }+++export_cs :: { OrdList (LIE GhcPs) }+export_cs : export {% return (unitOL $1) }++   -- No longer allow things like [] and (,,,) to be exported+   -- They are built in syntax, always available+export  :: { LIE GhcPs }+        : maybe_warning_pragma qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> }+                                                          ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)+                                                          ; return $ reLoc $ sL span $ impExp } }+        | maybe_warning_pragma 'module' modid            {% do { let { span = (maybe comb2 comb3 $1) $2 $>+                                                                     ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }+                                                          ; locImpExp <- return (sL span (IEModuleContents ($1, (epTok $2)) $3))+                                                          ; return $ reLoc $ locImpExp } }+        | maybe_warning_pragma 'pattern' qcon            { let span = (maybe comb2 comb3 $1) $2 $>+                                                           in reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (epTok $2) $3)) Nothing }+        | maybe_warning_pragma 'default' qtycon          {% do { let { span = (maybe comb2 comb3 $1) $2 $> }+                                                          ; locImpExp <- return (sL span (IEThingAbs $1 (sLLa $2 $> (IEDefault (epTok $2) $3)) Nothing))+                                                          ; return $ reLoc $ locImpExp } }+++export_subspec :: { Located ((EpToken "(", EpToken ")"), ImpExpSubSpec) }+        : {- empty -}             { sL0 (noAnn,ImpExpAbs) }+        | '(' qcnames ')'         {% mkImpExpSubSpec (reverse $2)+                                      >>= \ie -> return $ sLL $1 $>+                                            ((epTok $1, epTok $3), ie) }++qcnames :: { [LocatedA ImpExpQcSpec] }+  : {- empty -}                   { [] }+  | qcnames1                      { $1 }++qcnames1 :: { [LocatedA ImpExpQcSpec] }     -- A reversed list+        :  qcnames1 ',' qcname_ext_w_wildcard  {% case $1 of+                                                    ((L la (ImpExpQcWildcard tok _)):t) ->+                                                       do { return ($3 : L la (ImpExpQcWildcard tok (epTok $2)) : t) }+                                                    (l:t) ->+                                                       do { l' <- addTrailingCommaA l (epTok $2)+                                                          ; return ($3 : l' : t)} }++        -- Annotations re-added in mkImpExpSubSpec+        |  qcname_ext_w_wildcard                   { [$1] }++-- Variable, data constructor or wildcard+-- or tagged type constructor+qcname_ext_w_wildcard :: { LocatedA ImpExpQcSpec }+        :  qcname_ext               { $1 }+        |  '..'                     { sL1a $1 (ImpExpQcWildcard (epTok $1) NoEpTok)  }++qcname_ext :: { LocatedA ImpExpQcSpec }+        :  qcname                   { sL1a $1 (ImpExpQcName $1) }+        |  'type' oqtycon           {% do { n <- mkTypeImpExp $2+                                          ; return $ sLLa $1 $> (ImpExpQcType (epTok $1) n) }}++qcname  :: { LocatedN RdrName }  -- Variable or type constructor+        :  qvar                 { $1 } -- Things which look like functions+                                       -- Note: This includes record selectors but+                                       -- also (-.->), see #11432+        |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]++-----------------------------------------------------------------------------+-- Import Declarations++-- importdecls and topdecls must contain at least one declaration;+-- top handles the fact that these may be optional.++-- One or more semicolons+semis1  :: { Located [TrailingAnn] }+semis1  : semis1 ';'  { if isZeroWidthSpan (gl $2) then (sL1 $1 $ unLoc $1) else (sLL $1 $> $ AddSemiAnn (epTok $2) : (unLoc $1)) }+        | ';'         { case msemi $1 of+                          [] -> noLoc []+                          ms -> sL1 $1 $ ms }++-- Zero or more semicolons+semis   :: { [TrailingAnn] }+semis   : semis ';'   { if isZeroWidthSpan (gl $2) then $1 else (AddSemiAnn (epTok $2) : $1) }+        | {- empty -} { [] }++-- No trailing semicolons, non-empty+importdecls :: { [LImportDecl GhcPs] }+importdecls+        : importdecls_semi importdecl+                                { $2 : $1 }++-- May have trailing semicolons, can be empty+importdecls_semi :: { [LImportDecl GhcPs] }+importdecls_semi+        : importdecls_semi importdecl semis1+                                {% do { i <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3)+                                      ; return (i : $1)} }+        | {- empty -}           { [] }++importdecl :: { LImportDecl GhcPs }+        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec+                {% do {+                  ; let { ; mPreQual = unLoc $4+                          ; mPostQual = unLoc $7 }+                  ; checkImportDecl mPreQual mPostQual+                  ; let anns+                         = EpAnnImportDecl+                             { importDeclAnnImport    = epTok $1+                             , importDeclAnnPragma    = fst $ fst $2+                             , importDeclAnnSafe      = fst $3+                             , importDeclAnnQualified = fst $ importDeclQualifiedStyle mPreQual mPostQual+                             , importDeclAnnPackage   = fst $5+                             , importDeclAnnAs        = fst $8+                             }+                  ; let loc = (comb5 $1 $6 $7 (snd $8) $9);+                  ; fmap reLoc $ acs loc (\loc cs -> L loc $+                      ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False+                                  , ideclName = $6, ideclPkgQual = snd $5+                                  , ideclSource = snd $2, ideclSafe = snd $3+                                  , ideclQualified = snd $ importDeclQualifiedStyle mPreQual mPostQual+                                  , ideclAs = unLoc (snd $8)+                                  , ideclImportList = unLoc $9 })+                  }+                }+++maybe_src :: { ((Maybe (EpaLocation,EpToken "#-}"),SourceText),IsBootInterface) }+        : '{-# SOURCE' '#-}'        { ((Just (glR $1,epTok $2),getSOURCE_PRAGs $1)+                                      , IsBoot) }+        | {- empty -}               { ((Nothing,NoSourceText),NotBoot) }++maybe_safe :: { (Maybe (EpToken "safe"),Bool) }+        : 'safe'                                { (Just (epTok $1),True) }+        | {- empty -}                           { (Nothing,      False) }++maybe_pkg :: { (Maybe EpaLocation, RawPkgQual) }+        : STRING  {% do { let { pkgFS = getSTRING $1 }+                        ; unless (looksLikePackageName (unpackFS pkgFS)) $+                             addError $ mkPlainErrorMsgEnvelope (getLoc $1) $+                               (PsErrInvalidPackageName pkgFS)+                        ; return (Just (glR $1), RawPkgQual (StringLiteral (getSTRINGs $1) pkgFS Nothing)) } }+        | {- empty -}                           { (Nothing,NoRawPkgQual) }++optqualified :: { Located (Maybe (EpToken "qualified")) }+        : 'qualified'                           { sL1 $1 (Just (epTok $1)) }+        | {- empty -}                           { noLoc Nothing }++maybeas :: { (Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName))) }+        : 'as' modid                           { (Just (epTok $1)+                                                 ,sLL $1 $> (Just $2)) }+        | {- empty -}                          { (Nothing,noLoc Nothing) }++maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs])) }+        : impspec                  {% let (b, ie) = unLoc $1 in+                                       checkImportSpec ie+                                        >>= \checkedIe ->+                                          return (L (gl $1) (Just (b, checkedIe)))  }+        | {- empty -}              { noLoc Nothing }++impspec :: { Located (ImportListInterpretation, LocatedLI [LIE GhcPs]) }+        :  '(' importlist ')'               {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $2)+                                                               (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) [])+                                                  ; return $ sLL $1 $> (Exactly, es)} }+        |  'hiding' '(' importlist ')'      {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $3)+                                                               (AnnList Nothing (ListParens (epTok $2) (epTok $4)) [] (epTok $1,fst $3) [])+                                                  ; return $ sLL $1 $> (EverythingBut, es)} }++importlist :: { ([EpToken ","], OrdList (LIE GhcPs)) }+        : importlist1     { ([], $1) }+        | {- empty -}     { ([], nilOL) }++        -- trailing comma:+        | importlist1 ',' {% case $1 of+                               SnocOL hs t -> do+                                 t' <- addTrailingCommaA t (epTok $2)+                                 return ([], snocOL hs t')}+        | ','             { ([epTok $1], nilOL) }++importlist1 :: { OrdList (LIE GhcPs) }+        : importlist1 ',' import+                          {% let ls = $1+                             in if isNilOL ls+                                  then return (ls `appOL` $3)+                                  else case ls of+                                         SnocOL hs t -> do+                                           t' <- addTrailingCommaA t (epTok $2)+                                           return (snocOL hs t' `appOL` $3)}+        | import          { $1 }++import  :: { OrdList (LIE GhcPs) }+        : qcname_ext export_subspec {% fmap (unitOL . reLoc . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }+        | 'module' modid            {% fmap (unitOL . reLoc) $ return (sLL $1 $> (IEModuleContents (Nothing, (epTok $1)) $2)) }+        | 'pattern' qcon            { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (epTok $1) $2)) Nothing }++-----------------------------------------------------------------------------+-- Fixity Declarations++prec    :: { Maybe (Located (SourceText,Int)) }+        : {- empty -}           { Nothing }+        | INTEGER+                 { Just (sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1)))) }++infix   :: { Located FixityDirection }+        : 'infix'                               { sL1 $1 InfixN  }+        | 'infixl'                              { sL1 $1 InfixL  }+        | 'infixr'                              { sL1 $1 InfixR }++ops     :: { Located (OrdList (LocatedN RdrName)) }+        : ops ',' op       {% case (unLoc $1) of+                                SnocOL hs t -> do+                                  t' <- addTrailingCommaN t (gl $2)+                                  return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) }+        | op               { sL1 $1 (unitOL $1) }++-----------------------------------------------------------------------------+-- Top-Level Declarations++-- No trailing semicolons, non-empty+topdecls :: { OrdList (LHsDecl GhcPs) }+        : topdecls_semi topdecl        { $1 `snocOL` $2 }++-- May have trailing semicolons, can be empty+topdecls_semi :: { OrdList (LHsDecl GhcPs) }+        : topdecls_semi topdecl semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3)+                                             ; return ($1 `snocOL` t) }}+        | {- empty -}                  { nilOL }+++-----------------------------------------------------------------------------+-- Each topdecl accumulates prior comments+-- No trailing semicolons, non-empty+topdecls_cs :: { OrdList (LHsDecl GhcPs) }+        : topdecls_cs_semi topdecl_cs        { $1 `snocOL` $2 }++-- May have trailing semicolons, can be empty+topdecls_cs_semi :: { OrdList (LHsDecl GhcPs) }+        : topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3)+                                                   ; return ($1 `snocOL` t) }}+        | {- empty -}                  { nilOL }++-- Each topdecl accumulates prior comments+topdecl_cs :: { LHsDecl GhcPs }+topdecl_cs : topdecl {% commentsPA $1 }++-----------------------------------------------------------------------------+topdecl :: { LHsDecl GhcPs }+        : cl_decl                               { L (getLoc $1) (TyClD noExtField (unLoc $1)) }+        | ty_decl                               { L (getLoc $1) (TyClD noExtField (unLoc $1)) }+        | standalone_kind_sig                   { L (getLoc $1) (KindSigD noExtField (unLoc $1)) }+        | inst_decl                             { L (getLoc $1) (InstD noExtField (unLoc $1)) }+        | stand_alone_deriving                  { L (getLoc $1) (DerivD noExtField (unLoc $1)) }+        | role_annot                            { L (getLoc $1) (RoleAnnotD noExtField (unLoc $1)) }+        | default_decl                          { L (getLoc $1) (DefD noExtField (unLoc $1)) }+        | 'foreign' fdecl                       {% amsA' (sLL $1 $> ((unLoc $2) (epTok $1))) }+        | '{-# DEPRECATED' deprecations '#-}'   {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ((glR $1,epTok $3), (getDEPRECATED_PRAGs $1)) (fromOL $2))) }+        | '{-# WARNING' warnings '#-}'          {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ((glR $1,epTok $3), (getWARNING_PRAGs $1)) (fromOL $2))) }+        | '{-# RULES' rules '#-}'               {% amsA' (sLL $1 $> $ RuleD noExtField (HsRules ((glR $1,epTok $3), (getRULES_PRAGs $1)) (reverse $2))) }+        | annotation { $1 }+        | decl_no_th                            { $1 }++        -- Template Haskell Extension+        -- The $(..) form is one possible form of infixexp+        -- but we treat an arbitrary expression just as if+        -- it had a $(..) wrapped around it+        | infixexp                              {% runPV (unECP $1) >>= \ $1 ->+                                                       commentsPA $ mkSpliceDecl $1 }++-- Type classes+--+cl_decl :: { LTyClDecl GhcPs }+        : 'class' tycl_hdr fds where_cls+                {% do { let {(wtok, (oc,semis,cc)) = fstOf3 $ unLoc $4}+                      ; mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (sndOf3 $ unLoc $4) (thdOf3 $ unLoc $4)+                        (AnnClassDecl (epTok $1) [] [] (fst $ unLoc $3) wtok oc cc semis) }}++-- Default declarations (toplevel)+--+default_decl :: { LDefaultDecl GhcPs }+             : 'default' opt_class '(' comma_types0 ')'+               {% amsA' (sLL $1 $> (DefaultDecl (epTok $1,epTok $3,epTok $5) $2 $4)) }+++-- Type declarations (toplevel)+--+ty_decl :: { LTyClDecl GhcPs }+           -- ordinary type synonyms+        : 'type' type '=' ktype+                -- Note ktype, not sigtype, on the right of '='+                -- We allow an explicit for-all but we don't insert one+                -- in   type Foo a = (b,b)+                -- Instead we just say b is out of scope+                --+                -- Note the use of type for the head; this allows+                -- infix type constructors to be declared+                {% mkTySynonym (comb2 $1 $4) $2 $4 (epTok $1) (epTok $3) }++           -- type family declarations+        | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info+                          where_type_family+                -- Note the use of type for the head; this allows+                -- infix type constructors to be declared+             {% do { let { (tdcolon, tequal) = fst $ unLoc $4 }+                   ; let { tvbar = fst $ unLoc $5 }+                   ; let { (twhere, (toc, tdd, tcc)) = fst $ unLoc $6  }+                   ; mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3+                                   (snd $ unLoc $4) (snd $ unLoc $5)+                           (AnnFamilyDecl [] [] (epTok $1) noAnn (epTok $2) tdcolon tequal tvbar twhere toc tdd tcc) }}++          -- ordinary data type or newtype declaration+        | type_data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings+            {% do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc $1}+                  ; let { tequal = fst $ unLoc $4 }+                  ; mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3+                           Nothing (reverse (snd $ unLoc $4))+                                   (fmap reverse $5)+                           (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)+                             }}+                                   -- We need the location on tycl_hdr in case+                                   -- constrs and deriving are both empty++          -- ordinary GADT declaration+        | type_data_or_newtype capi_ctype tycl_hdr opt_kind_sig+                 gadt_constrlist+                 maybe_derivings+            {% do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc $1}+                  ; let { tdcolon = fst $ unLoc $4 }+                  ; let { (twhere, oc, cc) = fst $ unLoc $5 }+                  ; mkTyData (comb5 $1 $3 $4 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3+                            (snd $ unLoc $4) (snd $ unLoc $5)+                            (fmap reverse $6)+                            (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok tdcolon twhere oc cc NoEpTok)}}+                                   -- We need the location on tycl_hdr in case+                                   -- constrs and deriving are both empty++          -- data/newtype family+        | 'data' 'family' type opt_datafam_kind_sig+             {% do { let { tdcolon = fst $ unLoc $4 }+                   ; mkFamDecl (comb4 $1 $2 $3 $4) DataFamily TopLevel $3+                                   (snd $ unLoc $4) Nothing+                           (AnnFamilyDecl [] [] noAnn (epTok $1) (epTok $2) tdcolon noAnn noAnn noAnn noAnn noAnn noAnn) }}++-- standalone kind signature+standalone_kind_sig :: { LStandaloneKindSig GhcPs }+  : 'type' sks_vars '::' sigktype+      {% mkStandaloneKindSig (comb2 $1 $4) (L (gl $2) $ unLoc $2) $4+               (epTok $1,epUniTok $3)}++-- See also: sig_vars+sks_vars :: { Located [LocatedN RdrName] }  -- Returned in reverse order+  : sks_vars ',' oqtycon+      {% case unLoc $1 of+           (h:t) -> do+             h' <- addTrailingCommaN h (gl $2)+             return (sLL $1 $> ($3 : h' : t)) }+  | oqtycon { sL1 $1 [$1] }++inst_decl :: { LInstDecl GhcPs }+        : 'instance' maybe_warning_pragma overlap_pragma inst_type where_inst+       {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $5)+             ; let (twhere, (openc, closec, semis)) = fst $ unLoc $5+             ; let anns = AnnClsInstDecl (epTok $1) twhere openc semis closec+             ; let cid = ClsInstDecl+                                  { cid_ext = ($2, anns, NoAnnSortKey)+                                  , cid_poly_ty = $4, cid_binds = binds+                                  , cid_sigs = mkClassOpSigs sigs+                                  , cid_tyfam_insts = ats+                                  , cid_overlap_mode = $3+                                  , cid_datafam_insts = adts }+             ; amsA' (L (comb3 $1 $4 $5)+                             (ClsInstD { cid_d_ext = noExtField, cid_inst = cid }))+                   } }++           -- type instance declarations+        | 'type' 'instance' ty_fam_inst_eqn+                {% mkTyFamInst (comb2 $1 $3) (unLoc $3)+                        (epTok $1) (epTok $2) }++          -- data/newtype instance declaration+        | data_or_newtype 'instance' capi_ctype datafam_inst_hdr constrs+                          maybe_derivings+            {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }+                  ; let { tequal = fst $ unLoc $5 }+                  ; mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)+                                      Nothing (reverse (snd  $ unLoc $5))+                                              (fmap reverse $6)+                            (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)}}++          -- GADT instance declaration+        | data_or_newtype 'instance' capi_ctype datafam_inst_hdr opt_kind_sig+                 gadt_constrlist+                 maybe_derivings+            {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }+                  ; let { dcolon = fst $ unLoc $5 }+                  ; let { (twhere, oc, cc) = fst $ unLoc $6 }+                  ; mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (unLoc $4)+                                   (snd $ unLoc $5) (snd $ unLoc $6)+                                   (fmap reverse $7)+                            (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}}++overlap_pragma :: { Maybe (LocatedP OverlapMode) }+  : '{-# OVERLAPPABLE'    '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))+                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }+  | '{-# OVERLAPPING'     '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))+                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }+  | '{-# OVERLAPS'        '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1)))+                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }+  | '{-# INCOHERENT'      '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1)))+                                       (AnnPragma (glR $1) (epTok $2) noAnn noAnn noAnn noAnn noAnn) }+  | {- empty -}                 { Nothing }++deriv_strategy_no_via :: { LDerivStrategy GhcPs }+  : 'stock'                     {% amsA' (sL1 $1 (StockStrategy (epTok $1))) }+  | 'anyclass'                  {% amsA' (sL1 $1 (AnyclassStrategy (epTok $1))) }+  | 'newtype'                   {% amsA' (sL1 $1 (NewtypeStrategy (epTok $1))) }++deriv_strategy_via :: { LDerivStrategy GhcPs }+  : 'via' sigktype          {% amsA' (sLL $1 $> (ViaStrategy (XViaStrategyPs (epTok $1) $2))) }++deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) }+  : 'stock'                     {% fmap Just $ amsA' (sL1 $1 (StockStrategy (epTok $1))) }+  | 'anyclass'                  {% fmap Just $ amsA' (sL1 $1 (AnyclassStrategy (epTok $1))) }+  | 'newtype'                   {% fmap Just $ amsA' (sL1 $1 (NewtypeStrategy (epTok $1))) }+  | deriv_strategy_via          { Just $1 }+  | {- empty -}                 { Nothing }++-- Optional class reference for default declarations+opt_class :: { Maybe (LIdP GhcPs) }+          : {- empty -}         { Nothing }+          | qtycon              {% fmap Just $ amsA' (reLoc $1) }++-- Injective type families++opt_injective_info :: { Located (EpToken "|", Maybe (LInjectivityAnn GhcPs)) }+        : {- empty -}               { noLoc (noAnn, Nothing) }+        | '|' injectivity_cond      { sLL $1 $> ((epTok $1)+                                                , Just ($2)) }++injectivity_cond :: { LInjectivityAnn GhcPs }+        : tyvarid '->' inj_varids+           {% amsA' (sLL $1 $> (InjectivityAnn (epUniTok $2) $1 (reverse (unLoc $3)))) }++inj_varids :: { Located [LocatedN RdrName] }+        : inj_varids tyvarid  { sLL $1 $> ($2 : unLoc $1) }+        | tyvarid             { sL1  $1 [$1]               }++-- Closed type families++where_type_family :: { Located ((EpToken "where", (EpToken "{", EpToken "..", EpToken "}")),FamilyInfo GhcPs) }+        : {- empty -}                      { noLoc (noAnn,OpenTypeFamily) }+        | 'where' ty_fam_inst_eqn_list+               { sLL $1 $> ((epTok $1,(fst $ unLoc $2))+                    ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }++ty_fam_inst_eqn_list :: { Located ((EpToken "{", EpToken "..", EpToken "}"),Maybe [LTyFamInstEqn GhcPs]) }+        :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ((epTok $1,noAnn, epTok $3)+                                                ,Just (unLoc $2)) }+        | vocurly ty_fam_inst_eqns close   { let (L loc _) = $2 in+                                             L loc (noAnn,Just (unLoc $2)) }+        |     '{' '..' '}'                 { sLL $1 $> ((epTok $1,epTok $2 ,epTok $3),Nothing) }+        | vocurly '..' close               { let (L loc _) = $2 in+                                             L loc ((noAnn,epTok $2, noAnn),Nothing) }++ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }+        : ty_fam_inst_eqns ';' ty_fam_inst_eqn+                                      {% let (L loc eqn) = $3 in+                                         case unLoc $1 of+                                           [] -> return (sLL $1 $> (L loc eqn : unLoc $1))+                                           (h:t) -> do+                                             h' <- addTrailingSemiA h (epTok $2)+                                             return (sLL $1 $> ($3 : h' : t)) }+        | ty_fam_inst_eqns ';'        {% case unLoc $1 of+                                           [] -> return (sLZ $1 $> (unLoc $1))+                                           (h:t) -> do+                                             h' <- addTrailingSemiA h (epTok $2)+                                             return (sLZ $1 $>  (h':t)) }+        | ty_fam_inst_eqn             { sLL $1 $> [$1] }+        | {- empty -}                 { noLoc [] }++ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs }+        : 'forall' tv_bndrs '.' type '=' ktype+              {% do { hintExplicitForall $1+                    ; tvbs <- fromSpecTyVarBndrs $2+                    ; let loc = comb2 $1 $>+                    ; !cs <- getCommentsFor loc+                    ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glEE $1 $3) (epUniTok $1, epTok $3) cs) tvbs) $4 $6 (epTok $5) }}+        | type '=' ktype+              {% mkTyFamInstEqn (comb2 $1 $>) mkHsOuterImplicit $1 $3 (epTok $2) }+              -- Note the use of type for the head; this allows+              -- infix type constructors and type patterns++-- Associated type family declarations+--+-- * They have a different syntax than on the toplevel (no family special+--   identifier).+--+-- * They also need to be separate from instances; otherwise, data family+--   declarations without a kind signature cause parsing conflicts with empty+--   data declarations.+--+at_decl_cls :: { LHsDecl GhcPs }+        :  -- data family declarations, with optional 'family' keyword+          'data' opt_family type opt_datafam_kind_sig+             {% do { let { tdcolon = fst $ unLoc $4 }+                   ; liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3+                                                  (snd $ unLoc $4) Nothing+                           (AnnFamilyDecl [] [] noAnn (epTok $1) $2 tdcolon noAnn noAnn noAnn noAnn noAnn noAnn)) }}++           -- type family declarations, with optional 'family' keyword+           -- (can't use opt_instance because you get shift/reduce errors+        | 'type' type opt_at_kind_inj_sig+            {% do { let { (tdcolon, tequal, tvbar) = fst $ unLoc $3 }+                  ; liftM mkTyClD+                        (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2+                                   (fst . snd $ unLoc $3)+                                   (snd . snd $ unLoc $3)+                         (AnnFamilyDecl [] [] (epTok $1) noAnn noAnn tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) }}+        | 'type' 'family' type opt_at_kind_inj_sig+            {% do { let { (tdcolon, tequal, tvbar) = fst $ unLoc $4 }+                  ; liftM mkTyClD+                        (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3+                                   (fst . snd $ unLoc $4)+                                   (snd . snd $ unLoc $4)+                           (AnnFamilyDecl [] [] (epTok $1) noAnn (epTok $2) tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) }}+           -- default type instances, with optional 'instance' keyword+        | 'type' ty_fam_inst_eqn+                {% liftM mkInstD (mkTyFamInst (comb2 $1 $2) (unLoc $2)+                          (epTok $1) NoEpTok) }+        | 'type' 'instance' ty_fam_inst_eqn+                {% liftM mkInstD (mkTyFamInst (comb2 $1 $3) (unLoc $3)+                              (epTok $1) (epTok $2) )}++opt_family   :: { EpToken "family" }+              : {- empty -}   { noAnn }+              | 'family'      { (epTok $1) }++opt_instance :: { EpToken "instance" }+              : {- empty -} { NoEpTok }+              | 'instance'  { epTok $1 }++-- Associated type instances+--+at_decl_inst :: { LInstDecl GhcPs }+           -- type instance declarations, with optional 'instance' keyword+        : 'type' opt_instance ty_fam_inst_eqn+                -- Note the use of type for the head; this allows+                -- infix type constructors and type patterns+                {% mkTyFamInst (comb2 $1 $3) (unLoc $3)+                          (epTok $1) $2 }++        -- data/newtype instance declaration, with optional 'instance' keyword+        | data_or_newtype opt_instance capi_ctype datafam_inst_hdr constrs maybe_derivings+            {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }+                  ; let { tequal = fst $ unLoc $5 }+                  ; mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)+                                    Nothing (reverse (snd $ unLoc $5))+                                             (fmap reverse $6)+                            (AnnDataDefn [] [] NoEpTok tnewtype tdata $2 NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)}}++        -- GADT instance declaration, with optional 'instance' keyword+        | data_or_newtype opt_instance capi_ctype datafam_inst_hdr opt_kind_sig+                 gadt_constrlist+                 maybe_derivings+             {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }+                   ; let { dcolon = fst $ unLoc $5 }+                   ; let { (twhere, oc, cc) = fst $ unLoc $6 }+                   ; mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3+                                (unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6)+                                (fmap reverse $7)+                            (AnnDataDefn [] [] NoEpTok tnewtype tdata $2 dcolon twhere oc cc NoEpTok)}}++type_data_or_newtype :: { Located ((EpToken "data", EpToken "newtype", EpToken "type")+                                   , Bool, NewOrData) }+        : 'data'        { sL1 $1 ((epTok $1, NoEpTok,  NoEpTok),  False,DataType) }+        | 'newtype'     { sL1 $1 ((NoEpTok,  epTok $1, NoEpTok),  False,NewType) }+        | 'type' 'data' { sL1 $1 ((epTok $2, NoEpTok,  epTok $1), True ,DataType) }++data_or_newtype :: { Located ((EpToken "data", EpToken "newtype"), NewOrData) }+        : 'data'        { sL1 $1 ((epTok $1, NoEpTok), DataType) }+        | 'newtype'     { sL1 $1 ((NoEpTok,  epTok $1),NewType) }++-- Family result/return kind signatures++opt_kind_sig :: { Located (TokDcolon, Maybe (LHsKind GhcPs)) }+        :               { noLoc     (NoEpUniTok , Nothing) }+        | '::' kind     { sLL $1 $> (epUniTok $1, Just $2) }++opt_datafam_kind_sig :: { Located (TokDcolon, LFamilyResultSig GhcPs) }+        :               { noLoc     (noAnn,       noLocA (NoSig noExtField)         )}+        | '::' kind     { sLL $1 $> (epUniTok $1, sLLa $1 $> (KindSig noExtField $2))}++opt_tyfam_kind_sig :: { Located ((TokDcolon, EpToken "="), LFamilyResultSig GhcPs) }+        :              { noLoc     (noAnn               , noLocA     (NoSig    noExtField)   )}+        | '::' kind    { sLL $1 $> ((epUniTok $1, noAnn), sLLa $1 $> (KindSig  noExtField $2))}+        | '='  tv_bndr {% do { tvb <- fromSpecTyVarBndr $2+                             ; return $ sLL $1 $> ((noAnn, epTok $1), sLLa $1 $> (TyVarSig noExtField tvb))} }++opt_at_kind_inj_sig :: { Located ((TokDcolon, EpToken "=", EpToken "|"), ( LFamilyResultSig GhcPs+                                            , Maybe (LInjectivityAnn GhcPs)))}+        :            { noLoc (noAnn, (noLocA (NoSig noExtField), Nothing)) }+        | '::' kind  { sLL $1 $> ( (epUniTok $1, noAnn, noAnn)+                                 , (sL1a $> (KindSig noExtField $2), Nothing)) }+        | '='  tv_bndr_no_braces '|' injectivity_cond+                {% do { tvb <- fromSpecTyVarBndr $2+                      ; return $ sLL $1 $> ((noAnn, epTok $1, epTok $3)+                                           , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} }++-- tycl_hdr parses the header of a class or data type decl,+-- which takes the form+--      T a b+--      Eq a => T a+--      (Eq a, Ord b) => T a b+--      T Int [a]                       -- for associated types+-- Rather a lot of inlining here, else we get reduce/reduce errors+tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }+        : context '=>' type         {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), $3))) }+        | type                      { sL1 $1 (Nothing, $1) }++datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) }+        : 'forall' tv_bndrs '.' context '=>' type   {% hintExplicitForall $1+                                                       >> fromSpecTyVarBndrs $2+                                                         >>= \tvbs ->+                                                             (acs (comb2 $1 $>) (\loc cs -> (L loc+                                                                                  (Just ( addTrailingDarrowC $4 $5 cs)+                                                                                        , mkHsOuterExplicit (EpAnn (glEE $1 $3) (epUniTok $1, epTok $3) emptyComments) tvbs, $6))))+                                                    }+        | 'forall' tv_bndrs '.' type   {% do { hintExplicitForall $1+                                             ; tvbs <- fromSpecTyVarBndrs $2+                                             ; let loc = comb2 $1 $>+                                             ; !cs <- getCommentsFor loc+                                             ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE $1 $3) (epUniTok $1, epTok $3) cs) tvbs, $4))+                                       } }+        | context '=>' type         {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) }+        | type                      { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }+++capi_ctype :: { Maybe (LocatedP CType) }+capi_ctype : '{-# CTYPE' STRING STRING '#-}'+                       {% fmap Just $ amsr (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))+                                        (getSTRINGs $3,getSTRING $3)))+                              (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) }++           | '{-# CTYPE'        STRING '#-}'+                       {% fmap Just $ amsr (sLL $1 $> (CType (getCTYPEs $1) Nothing (getSTRINGs $2, getSTRING $2)))+                              (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) }++           |           { Nothing }++-----------------------------------------------------------------------------+-- Stand-alone deriving++-- Glasgow extension: stand-alone deriving declarations+stand_alone_deriving :: { LDerivDecl GhcPs }+  : 'deriving' deriv_standalone_strategy 'instance' maybe_warning_pragma overlap_pragma inst_type+                {% do { let { err = text "in the stand-alone deriving instance"+                                    <> colon <+> quotes (ppr $6) }+                      ; amsA' (sLL $1 $>+                                 (DerivDecl ($4, (epTok $1, epTok $3)) (mkHsWildCardBndrs $6) $2 $5)) }}++-----------------------------------------------------------------------------+-- Role annotations++role_annot :: { LRoleAnnotDecl GhcPs }+role_annot : 'type' 'role' oqtycon maybe_roles+          {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4))+                   (epTok $1,epTok $2) }++-- Reversed!+maybe_roles :: { Located [Located (Maybe FastString)] }+maybe_roles : {- empty -}    { noLoc [] }+            | roles          { $1 }++roles :: { Located [Located (Maybe FastString)] }+roles : role             { sLL $1 $> [$1] }+      | roles role       { sLL $1 $> $ $2 : unLoc $1 }++-- read it in as a varid for better error messages+role :: { Located (Maybe FastString) }+role : VARID             { sL1 $1 $ Just $ getVARID $1 }+     | '_'               { sL1 $1 Nothing }++-- Pattern synonyms++-- Glasgow extension: pattern synonyms+pattern_synonym_decl :: { LHsDecl GhcPs }+        : 'pattern' pattern_synonym_lhs '=' pat_syn_pat+         {%      let (name, args, (mo, mc) ) = $2 in+                 amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4+                                                    ImplicitBidirectional+                      (AnnPSB (epTok $1) mo mc Nothing (Just (epTok $3)))) }++        | 'pattern' pattern_synonym_lhs '<-' pat_syn_pat+         {%    let (name, args, (mo,mc)) = $2 in+               amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional+                       (AnnPSB (epTok $1) mo mc (Just (epUniTok $3)) Nothing)) }++        | 'pattern' pattern_synonym_lhs '<-' pat_syn_pat where_decls+            {% do { let (name, args, (mo,mc)) = $2+                  ; mg <- mkPatSynMatchGroup name $5+                  ; amsA' (sLL $1 $> . ValD noExtField $+                           mkPatSynBind name args $4 (ExplicitBidirectional mg)+                            (AnnPSB (epTok $1) mo mc (Just (epUniTok $3)) Nothing))+                   }}++pattern_synonym_lhs :: { (LocatedN RdrName, HsPatSynDetails GhcPs, (Maybe (EpToken "{"), Maybe (EpToken "}"))) }+        : con vars0 { ($1, PrefixCon noTypeArgs $2, noAnn) }+        | varid conop varid { ($2, InfixCon $1 $3, noAnn) }+        | con '{' cvars1 '}' { ($1, RecCon $3, (Just (epTok $2), Just (epTok $4))) }++vars0 :: { [LocatedN RdrName] }+        : {- empty -}                 { [] }+        | varid vars0                 { $1 : $2 }++cvars1 :: { [RecordPatSynField GhcPs] }+       : var                          { [RecordPatSynField (mkFieldOcc $1) $1] }+       | var ',' cvars1               {% do { h <- addTrailingCommaN $1 (gl $2)+                                            ; return ((RecordPatSynField (mkFieldOcc h) h) : $3 )}}++where_decls :: { LocatedLW (OrdList (LHsDecl GhcPs)) }+        : 'where' '{' decls '}'       {% amsr (sLL $1 $> (thdOf3 $ unLoc $3))+                                              (AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3) (epTok $1) []) }+        | 'where' vocurly decls close {% amsr (sLL $1 $3 (thdOf3 $ unLoc $3))+                                              (AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3) (epTok $1) []) }++pattern_synonym_sig :: { LSig GhcPs }+        : 'pattern' con_list '::' sigtype+                   {% amsA' (sLL $1 $>+                                $ PatSynSig (AnnSig (epUniTok $3) (Just (epTok $1)) Nothing)+                                  (toList $ unLoc $2) $4) }++qvarcon :: { LocatedN RdrName }+        : qvar                          { $1 }+        | qcon                          { $1 }++-----------------------------------------------------------------------------+-- Nested declarations++-- Declaration in class bodies+--+decl_cls  :: { LHsDecl GhcPs }+decl_cls  : at_decl_cls                 { $1 }+          | decl                        { $1 }++          -- A 'default' signature used with the generic-programming extension+          | 'default' infixexp '::' sigtype+                    {% runPV (unECP $2) >>= \ $2 ->+                       do { v <- checkValSigLhs $2+                          ; let err = text "in default signature" <> colon <+>+                                      quotes (ppr $2)+                          ; amsA' (sLL $1 $> $ SigD noExtField $ ClassOpSig (AnnSig (epUniTok $3) Nothing (Just (epTok $1))) True [v] $4) }}++decls_cls :: { Located ([EpToken ";"],OrdList (LHsDecl GhcPs)) }  -- Reversed+          : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)+                                             then return (sLL $1 $> ((fst $ unLoc $1) ++ [mzEpTok $2]+                                                                    , unitOL $3))+                                            else case (snd $ unLoc $1) of+                                              SnocOL hs t -> do+                                                 t' <- addTrailingSemiA t (epTok $2)+                                                 return (sLL $1 $> (fst $ unLoc $1+                                                                , snocOL hs t' `appOL` unitOL $3)) }+          | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)+                                             then return (sLZ $1 $> ( (fst $ unLoc $1) ++ [mzEpTok $2]+                                                                                   ,snd $ unLoc $1))+                                             else case (snd $ unLoc $1) of+                                               SnocOL hs t -> do+                                                  t' <- addTrailingSemiA t (epTok $2)+                                                  return (sLZ $1 $> (fst $ unLoc $1+                                                                 , snocOL hs t')) }+          | decl_cls                    { sL1 $1 ([], unitOL $1) }+          | {- empty -}                 { noLoc ([],nilOL) }++decllist_cls+        :: { Located ((EpToken "{", [EpToken ";"], EpToken "}")+                     , OrdList (LHsDecl GhcPs)+                     , EpLayout) }      -- Reversed+        : '{'         decls_cls '}'     { sLL $1 $> ((epTok $1, fst $ unLoc $2, epTok $3)+                                             ,snd $ unLoc $2, epExplicitBraces $1 $3) }+        |     vocurly decls_cls close   { let { L l (anns, decls) = $2 }+                                           in L l ((NoEpTok, anns, NoEpTok), decls, EpVirtualBraces (getVOCURLY $1)) }++-- Class body+--+where_cls :: { Located ((EpToken "where", (EpToken "{", [EpToken ";"], EpToken "}"))+                       ,(OrdList (LHsDecl GhcPs))    -- Reversed+                       ,EpLayout) }+                                -- No implicit parameters+                                -- May have type declarations+        : 'where' decllist_cls          { sLL $1 $> ((epTok $1,fstOf3 $ unLoc $2)+                                             ,sndOf3 $ unLoc $2,thdOf3 $ unLoc $2) }+        | {- empty -}                   { noLoc ((noAnn, noAnn),nilOL,EpNoLayout) }++-- Declarations in instance bodies+--+decl_inst  :: { Located (OrdList (LHsDecl GhcPs)) }+decl_inst  : at_decl_inst               { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) }+           | decl                       { sL1 $1 (unitOL $1) }++decls_inst :: { Located ([EpToken ";"],OrdList (LHsDecl GhcPs)) }   -- Reversed+           : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)+                                             then return (sLL $1 $> ((fst $ unLoc $1) ++ [mzEpTok $2]+                                                                    , unLoc $3))+                                             else case (snd $ unLoc $1) of+                                               SnocOL hs t -> do+                                                  t' <- addTrailingSemiA t (epTok $2)+                                                  return (sLL $1 $> (fst $ unLoc $1+                                                                 , snocOL hs t' `appOL` unLoc $3)) }+           | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)+                                             then return (sLZ $1 $> ((fst $ unLoc $1) ++ [mzEpTok $2]+                                                                                   ,snd $ unLoc $1))+                                             else case (snd $ unLoc $1) of+                                               SnocOL hs t -> do+                                                  t' <- addTrailingSemiA t (epTok $2)+                                                  return (sLZ $1 $> (fst $ unLoc $1+                                                                 , snocOL hs t')) }+           | decl_inst                  { sL1 $1 ([],unLoc $1) }+           | {- empty -}                { noLoc ([],nilOL) }++decllist_inst+        :: { Located ((EpToken "{", EpToken "}", [EpToken ";"])+                     , OrdList (LHsDecl GhcPs)) }      -- Reversed+        : '{'         decls_inst '}'    { sLL $1 $> ((epTok $1,epTok $3,fst $ unLoc $2),snd $ unLoc $2) }+        |     vocurly decls_inst close  { L (gl $2) ((noAnn,noAnn,fst $ unLoc $2),snd $ unLoc $2) }++-- Instance body+--+where_inst :: { Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken ";"]))+                        , OrdList (LHsDecl GhcPs)) }   -- Reversed+                                -- No implicit parameters+                                -- May have type declarations+        : 'where' decllist_inst         { sLL $1 $> ((epTok $1,(fst $ unLoc $2))+                                             ,snd $ unLoc $2) }+        | {- empty -}                   { noLoc (noAnn,nilOL) }++-- Declarations in binding groups other than classes and instances+--+decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }+        : decls ';' decl    {% if isNilOL (thdOf3 $ unLoc $1)+                                 then return (sLL $2 $> (glR $3, (sndOf3 $ unLoc $1) ++ (msemiA $2)+                                                        , unitOL $3))+                                 else case (thdOf3 $ unLoc $1) of+                                   SnocOL hs t -> do+                                      t' <- addTrailingSemiA t (epTok $2)+                                      let { this = unitOL $3;+                                            rest = snocOL hs t';+                                            these = rest `appOL` this }+                                      return (rest `seq` this `seq` these `seq`+                                                 (sLL $1 $> (glEE (fstOf3 $ unLoc $1) $3, sndOf3 $ unLoc $1, these))) }+        | decls ';'          {% if isNilOL (thdOf3 $ unLoc $1)+                                  then return (sLZ $1 $> (glR $2, (sndOf3 $ unLoc $1) ++ (msemiA $2)+                                                          ,thdOf3 $ unLoc $1))+                                  else case (thdOf3 $ unLoc $1) of+                                    SnocOL hs t -> do+                                       t' <- addTrailingSemiA t (epTok $2)+                                       return (sLZ $1 $> (glEEz $1 $2, sndOf3 $ unLoc $1, snocOL hs t')) }+        | decl                          { sL1 $1 (glR $1,  [], unitOL $1) }+        | {- empty -}                   { noLoc (noAnn, [],nilOL) }++decllist :: { Located (AnnList (),Located (OrdList (LHsDecl GhcPs))) }+        : '{'            decls '}'     { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) noAnn []+                                                   ,sL1 $2 $ thdOf3 $ unLoc $2) }+        |     vocurly    decls close   { sL1 $2    (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) noAnn []+                                                   ,sL1 $2 $ thdOf3 $ unLoc $2) }++-- Binding groups other than those of class and instance declarations+--+binds   ::  { Located (HsLocalBinds GhcPs) }+                                         -- May have implicit parameters+                                                -- No type declarations+        : decllist          {% do { let { (AnnList anc p s _ t, decls) = unLoc $1 }+                                  ; val_binds <- cvBindGroup (unLoc $ decls)+                                  ; !cs <- getCommentsFor (gl $1)+                                  ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s noAnn t) cs) val_binds)} }++        | '{'            dbinds '}'     {% acs (comb3 $1 $2 $3) (\loc cs -> (L loc+                                             $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (ListBraces (epTok $1) (epTok $3)) [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }++        |     vocurly    dbinds close   {% acs (gl $2) (\loc cs -> (L loc+                                             $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) ListNone [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }+++wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) }+                                                -- May have implicit parameters+                                                -- No type declarations+        : 'where' binds                 {% do { r <- acs (comb2 $1 $>) (\loc cs ->+                                                (L loc (annBinds (epTok $1) cs (unLoc $2))))+                                              ; return $ Just r} }+        | {- empty -}                   { Nothing }++-----------------------------------------------------------------------------+-- Transformation Rules++rules   :: { [LRuleDecl GhcPs] } -- Reversed+        :  rules ';' rule              {% case $1 of+                                            [] -> return ($3:$1)+                                            (h:t) -> do+                                              h' <- addTrailingSemiA h (epTok $2)+                                              return ($3:h':t) }+        |  rules ';'                   {% case $1 of+                                            [] -> return $1+                                            (h:t) -> do+                                              h' <- addTrailingSemiA h (epTok $2)+                                              return (h':t) }+        |  rule                        { [$1] }+        |  {- empty -}                 { [] }++rule    :: { LRuleDecl GhcPs }+        : STRING rule_activation rule_foralls infixexp '=' exp+         {%runPV (unECP $4) >>= \ $4 ->+           runPV (unECP $6) >>= \ $6 ->+           amsA' (sLL $1 $> $ HsRule+                                   { rd_ext =(((fstOf3 $3) (epTok $5) (fst $2)), getSTRINGs $1)+                                   , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1)+                                   , rd_act = (snd $2) `orElse` AlwaysActive+                                   , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3+                                   , rd_lhs = $4, rd_rhs = $6 }) }++-- Rules can be specified to be NeverActive, unlike inline/specialize pragmas+rule_activation :: { (ActivationAnn, Maybe Activation) }+        -- See Note [%shift: rule_activation -> {- empty -}]+        : {- empty -} %shift                    { (noAnn, Nothing) }+        | rule_explicit_activation              { (fst $1,Just (snd $1)) }++-- This production is used to parse the tilde syntax in pragmas such as+--   * {-# INLINE[~2] ... #-}+--   * {-# SPECIALISE [~ 001] ... #-}+--   * {-# RULES ... [~0] ... g #-}+-- Note that it can be written either+--   without a space [~1]  (the PREFIX_TILDE case), or+--   with    a space [~ 1] (the VARSYM case).+-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+rule_activation_marker :: { (Maybe (EpToken "~")) }+      : PREFIX_TILDE { (Just (epTok $1)) }+      | VARSYM  {% if (getVARSYM $1 == fsLit "~")+                   then return (Just (epTok $1))+                   else do { addError $ mkPlainErrorMsgEnvelope (getLoc $1) $+                               PsErrInvalidRuleActivationMarker+                           ; return Nothing } }++rule_explicit_activation :: { ( ActivationAnn+                              , Activation) }  -- In brackets+        : '[' INTEGER ']'       { ( ActivationAnn (epTok $1) (epTok $3) Nothing (Just (glR $2))+                                  , ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }+        | '[' rule_activation_marker INTEGER ']'+                                { ( ActivationAnn (epTok $1) (epTok $4) $2 (Just (glR $3))+                                  , ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }+        | '[' rule_activation_marker ']'+                                { ( ActivationAnn (epTok $1) (epTok $3) $2 Nothing+                                  , NeverActive) }++rule_foralls :: { (EpToken "=" -> ActivationAnn -> HsRuleAnn, Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs]) }+        : 'forall' rule_vars '.' 'forall' rule_vars '.'    {% let tyvs = mkRuleTyVarBndrs $2+                                                              in hintExplicitForall $1+                                                              >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs $2)+                                                              >> return (\an_eq an_act -> HsRuleAnn+                                                                          (Just (epUniTok $1,epTok $3))+                                                                          (Just (epUniTok $4,epTok $6))+                                                                          an_eq an_act,+                                                                         Just (mkRuleTyVarBndrs $2), mkRuleBndrs $5) }+        | 'forall' rule_vars '.'                           { (\an_eq an_act -> HsRuleAnn Nothing (Just (epUniTok $1,epTok $3)) an_eq an_act,+                                                              Nothing, mkRuleBndrs $2) }+        -- See Note [%shift: rule_foralls -> {- empty -}]+        | {- empty -}            %shift                    { (\an_eq an_act -> HsRuleAnn Nothing Nothing an_eq an_act, Nothing, []) }++rule_vars :: { [LRuleTyTmVar] }+        : rule_var rule_vars                    { $1 : $2 }+        | {- empty -}                           { [] }++rule_var :: { LRuleTyTmVar }+        : varid                         { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) }+        | '(' varid '::' ctype ')'      {% amsA' (sLL $1 $> (RuleTyTmVar (AnnTyVarBndr [glR $1] [glR $5] noAnn (epUniTok $3)) $2 (Just $4))) }++{- Note [Parsing explicit foralls in Rules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We really want the above definition of rule_foralls to be:++  rule_foralls : 'forall' tv_bndrs '.' 'forall' rule_vars '.'+               | 'forall' rule_vars '.'+               | {- empty -}++where rule_vars (term variables) can be named "family" or "role",+but tv_vars (type variables) cannot be. However, such a definition results+in a reduce/reduce conflict. For example, when parsing:+> {-# RULE "name" forall a ... #-}+before the '...' it is impossible to determine whether we should be in the+first or second case of the above.++This is resolved by using rule_vars (which is more general) for both, and+ensuring that type-level quantified variables do not have the names "forall",+"family", or "role" in the function 'checkRuleTyVarBndrNames' in+GHC.Parser.PostProcess.+Thus, whenever the definition of tyvarid (used for tv_bndrs) is changed relative+to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.+-}++-----------------------------------------------------------------------------+-- Warnings and deprecations (c.f. rules)++maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }+        : '{-# DEPRECATED' strings '#-}'+                            {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))+                                (AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn) }+        | '{-# WARNING' warning_category strings '#-}'+                            {% fmap Just $ amsr (sLL $1 $> $ WarningTxt $2 (getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))+                                (AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)}+        |  {- empty -}      { Nothing }++warning_category :: { Maybe (LocatedE InWarningCategory) }+        : 'in' STRING                  { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)+                                                                    (reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) }+        | {- empty -}                  { Nothing }++warnings :: { OrdList (LWarnDecl GhcPs) }+        : warnings ';' warning         {% if isNilOL $1+                                           then return ($1 `appOL` $3)+                                           else case $1 of+                                             SnocOL hs t -> do+                                              t' <- addTrailingSemiA t (epTok $2)+                                              return (snocOL hs t' `appOL` $3) }+        | warnings ';'                 {% if isNilOL $1+                                           then return $1+                                           else case $1 of+                                             SnocOL hs t -> do+                                              t' <- addTrailingSemiA t (epTok $2)+                                              return (snocOL hs t') }+        | warning                      { $1 }+        | {- empty -}                  { nilOL }++-- SUP: TEMPORARY HACK, not checking for `module Foo'+warning :: { OrdList (LWarnDecl GhcPs) }+        : warning_category namespace_spec namelist strings+                {% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)+                     (Warning (unLoc $2, fst $ unLoc $4) (unLoc $3)+                              (WarningTxt $1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $4))) }++namespace_spec :: { Located NamespaceSpecifier }+  : 'type'      { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }+  | 'data'      { sL1 $1 $ DataNamespaceSpecifier (epTok $1) }+  | {- empty -} { sL0    $ NoNamespaceSpecifier }++deprecations :: { OrdList (LWarnDecl GhcPs) }+        : deprecations ';' deprecation+                                       {% if isNilOL $1+                                           then return ($1 `appOL` $3)+                                           else case $1 of+                                             SnocOL hs t -> do+                                              t' <- addTrailingSemiA t (epTok $2)+                                              return (snocOL hs t' `appOL` $3) }+        | deprecations ';'             {% if isNilOL $1+                                           then return $1+                                           else case $1 of+                                             SnocOL hs t -> do+                                              t' <- addTrailingSemiA t (epTok $2)+                                              return (snocOL hs t') }+        | deprecation                  { $1 }+        | {- empty -}                  { nilOL }++-- SUP: TEMPORARY HACK, not checking for `module Foo'+deprecation :: { OrdList (LWarnDecl GhcPs) }+        : namespace_spec namelist strings+             {% fmap unitOL $ amsA' (sL (comb3 $1 $2 $>) $ (Warning (unLoc $1, fst $ unLoc $3) (unLoc $2)+                                          (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }++strings :: { Located ((EpToken "[", EpToken "]"),[Located StringLiteral]) }+    : STRING             { sL1 $1 (noAnn,[L (gl $1) (getStringLiteral $1)]) }+    | '[' stringlist ']' { sLL $1 $> $ ((epTok $1,epTok $3),fromOL (unLoc $2)) }++stringlist :: { Located (OrdList (Located StringLiteral)) }+    : stringlist ',' STRING {% if isNilOL (unLoc $1)+                                then return (sLL $1 $> (unLoc $1 `snocOL`+                                                  (L (gl $3) (getStringLiteral $3))))+                                else case (unLoc $1) of+                                   SnocOL hs t -> do+                                     let { t' = addTrailingCommaS t (glR $2) }+                                     return (sLL $1 $> (snocOL hs t' `snocOL`+                                                  (L (gl $3) (getStringLiteral $3))))++}+    | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }+    | {- empty -}           { noLoc nilOL }++-----------------------------------------------------------------------------+-- Annotations+annotation :: { LHsDecl GhcPs }+    : '{-# ANN' name_var aexp '#-}'      {% runPV (unECP $3) >>= \ $3 ->+                                            amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation+                                            (AnnPragma (glR $1) (epTok $4) noAnn noAnn noAnn noAnn noAnn,+                                            (getANN_PRAGs $1))+                                            (ValueAnnProvenance $2) $3)) }++    | '{-# ANN' 'type' otycon aexp '#-}' {% runPV (unECP $4) >>= \ $4 ->+                                            amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation+                                            (AnnPragma (glR $1) (epTok $5) noAnn noAnn noAnn (epTok $2) noAnn,+                                            (getANN_PRAGs $1))+                                            (TypeAnnProvenance $3) $4)) }++    | '{-# ANN' 'module' aexp '#-}'      {% runPV (unECP $3) >>= \ $3 ->+                                            amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation+                                                (AnnPragma (glR $1) (epTok $4) noAnn noAnn noAnn noAnn (epTok $2),+                                                (getANN_PRAGs $1))+                                                 ModuleAnnProvenance $3)) }++-----------------------------------------------------------------------------+-- Foreign import and export declarations++fdecl :: { Located (EpToken "foreign" -> HsDecl GhcPs) }+fdecl : 'import' callconv safety fspec+               {% mkImport $2 $3 (snd $ unLoc $4) (epTok $1, fst $ unLoc $4) >>= \i ->+                 return (sLL $1 $> i)  }+      | 'import' callconv        fspec+               {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3) (epTok $1, fst $ unLoc $3);+                    return (sLL $1 $> d) }}+      | 'export' callconv fspec+               {% mkExport $2 (snd $ unLoc $3) (epTok $1, fst $ unLoc $3) >>= \i ->+                  return (sLL $1 $> i ) }++callconv :: { Located CCallConv }+          : 'stdcall'                   { sLL $1 $> StdCallConv }+          | 'ccall'                     { sLL $1 $> CCallConv   }+          | 'capi'                      { sLL $1 $> CApiConv    }+          | 'prim'                      { sLL $1 $> PrimCallConv}+          | 'javascript'                { sLL $1 $> JavaScriptCallConv }++safety :: { Located Safety }+        : 'unsafe'                      { sLL $1 $> PlayRisky }+        | 'safe'                        { sLL $1 $> PlaySafe }+        | 'interruptible'               { sLL $1 $> PlayInterruptible }++fspec :: { Located (TokDcolon+                    ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) }+       : STRING var '::' sigtype        { sLL $1 $> (epUniTok $3+                                             ,(L (getLoc $1)+                                                    (getStringLiteral $1), $2, $4)) }+       |        var '::' sigtype        { sLL $1 $> (epUniTok $2+                                             ,(noLoc (StringLiteral NoSourceText nilFS Nothing), $1, $3)) }+         -- if the entity string is missing, it defaults to the empty string;+         -- the meaning of an empty entity string depends on the calling+         -- convention++-----------------------------------------------------------------------------+-- Type signatures++opt_sig :: { Maybe (EpUniToken "::" "∷", LHsType GhcPs) }+        : {- empty -}                   { Nothing }+        | '::' ctype                    { Just (epUniTok $1, $2) }++opt_tyconsig :: { (Maybe (EpUniToken "::" "∷"), Maybe (LocatedN RdrName)) }+             : {- empty -}              { (Nothing, Nothing) }+             | '::' gtycon              { (Just (epUniTok $1), Just $2) }++-- Like ktype, but for types that obey the forall-or-nothing rule.+-- See Note [forall-or-nothing rule] in GHC.Hs.Type.+sigktype :: { LHsSigType GhcPs }+        : sigtype              { $1 }+        | ctype '::' kind      {% amsA' (sLL $1 $> $ mkHsImplicitSigType $+                                         sLLa $1 $> $ HsKindSig (epUniTok $2) $1 $3) }++-- Like ctype, but for types that obey the forall-or-nothing rule.+-- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the+-- logic in ctype here, we simply reuse the ctype production and perform+-- surgery on the LHsType it returns to turn it into an LHsSigType.+sigtype :: { LHsSigType GhcPs }+        : ctype                            { hsTypeToHsSigType $1 }++sig_vars :: { Located [LocatedN RdrName] }    -- Returned in reversed order+         : sig_vars ',' var           {% case unLoc $1 of+                                           [] -> return (sLL $1 $> ($3 : unLoc $1))+                                           (h:t) -> do+                                             h' <- addTrailingCommaN h (gl $2)+                                             return (sLL $1 $> ($3 : h' : t)) }+         | var                        { sL1 $1 [$1] }++sigtypes1 :: { OrdList (LHsSigType GhcPs) }+   : sigtype                 { unitOL $1 }+   | sigtype ',' sigtypes1   {% do { st <- addTrailingCommaA $1 (epTok $2)+                                   ; return $ unitOL st `appOL` $3 } }+-----------------------------------------------------------------------------+-- Types++unpackedness :: { Located UnpackednessPragma }+        : '{-# UNPACK' '#-}'   { sLL $1 $> (UnpackednessPragma (glR $1, epTok $2) (getUNPACK_PRAGs $1) SrcUnpack) }+        | '{-# NOUNPACK' '#-}' { sLL $1 $> (UnpackednessPragma (glR $1, epTok $2) (getNOUNPACK_PRAGs $1) SrcNoUnpack) }++forall_telescope :: { Located (HsForAllTelescope GhcPs) }+        : 'forall' tv_bndrs '.'  {% do { hintExplicitForall $1+                                       ; acs (comb2 $1 $>) (\loc cs -> (L loc $+                                           mkHsForAllInvisTele (EpAnn (glEE $1 $>) (epUniTok $1,epTok $3) cs) $2 )) }}+        | 'forall' tv_bndrs '->' {% do { hintExplicitForall $1+                                       ; req_tvbs <- fromSpecTyVarBndrs $2+                                       ; acs (comb2 $1 $>) (\loc cs -> (L loc $+                                           mkHsForAllVisTele (EpAnn (glEE $1 $>) (epUniTok $1,epUniTok $3) cs) req_tvbs )) }}++-- A ktype is a ctype, possibly with a kind annotation+ktype :: { LHsType GhcPs }+        : ctype                { $1 }+        | ctype '::' kind      {% amsA' (sLL $1 $> $ HsKindSig (epUniTok $2) $1 $3) }++-- A ctype is a for-all type+ctype   :: { LHsType GhcPs }+        : forall_telescope ctype      { sLLa $1 $> $+                                              HsForAllTy { hst_tele = unLoc $1+                                                         , hst_xforall = noExtField+                                                         , hst_body = $2 } }+        | context '=>' ctype          {% acsA (comb2 $1 $>) (\loc cs -> (L loc $+                                            HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs+                                                     , hst_xqual = NoExtField+                                                     , hst_body = $3 })) }++        | ipvar '::' ctype            {% amsA' (sLL $1 $> (HsIParamTy (epUniTok $2) (reLoc $1) $3)) }+        | type                        { $1 }++----------------------+-- Notes for 'context'+-- We parse a context as a btype so that we don't get reduce/reduce+-- errors in ctype.  The basic problem is that+--      (Eq a, Ord a)+-- looks so much like a tuple type.  We can't tell until we find the =>++context :: { LHsContext GhcPs }+        :  btype                        {% checkContext $1 }++expcontext :: {forall b. DisambECP b => PV (LocatedC [LocatedA b])}+        : infixexp                      { unECP $1 >>= \ $1 ->+                                          checkContextPV $1 }++{- Note [GADT decl discards annotations]+~~~~~~~~~~~~~~~~~~~~~+The type production for++    btype `->` ctype++add the AnnRarrow annotation twice, in different places.++This is because if the type is processed as usual, it belongs on the annotations+for the type as a whole.++But if the type is passed to mkGadtDecl, it discards the top level SrcSpan, and+the top-level annotation will be disconnected. Hence for this specific case it+is connected to the first type too.+-}++type :: { LHsType GhcPs }+        -- See Note [%shift: type -> btype]+        : btype %shift                 { $1 }+        | btype '->' ctype             {% amsA' (sLL $1 $>+                                            $ HsFunTy noExtField (HsUnrestrictedArrow (epUniTok $2)) $1 $3) }++        | btype mult '->' ctype        {% hintLinear (getLoc $2)+                                       >> let arr = (unLoc $2) (epUniTok $3)+                                          in amsA' (sLL $1 $> $ HsFunTy noExtField arr $1 $4) }++        | btype '->.' ctype            {% hintLinear (getLoc $2) >>+                                          amsA' (sLL $1 $> $ HsFunTy noExtField (HsLinearArrow (EpLolly (epTok $2))) $1 $3) }++mult :: { Located (EpUniToken "->" "\8594" -> HsArrow GhcPs) }+        : PREFIX_PERCENT atype          { sLL $1 $> (mkMultTy (epTok $1) $2) }++expmult :: { forall b. DisambECP b => PV (Located (EpUniToken "->" "\8594" -> HsArrowOf (LocatedA b) GhcPs)) }+expmult : PREFIX_PERCENT aexp           { unECP $2 >>= \ $2 ->+                                          fmap (sLL $1 $>) (mkHsMultPV (epTok $1) $2) }++btype :: { LHsType GhcPs }+        : infixtype                     {% runPV $1 }++infixtype :: { forall b. DisambTD b => PV (LocatedA b) }+        -- See Note [%shift: infixtype -> ftype]+        : ftype %shift                  { $1 }+        | ftype tyop infixtype          { $1 >>= \ $1 ->+                                          $3 >>= \ $3 ->+                                          do { let (op, prom) = $2+                                             ; when (looksLikeMult $1 op $3) $ hintLinear (getLocA op)+                                             ; mkHsOpTyPV prom $1 op $3 } }+        | unpackedness infixtype        { $2 >>= \ $2 ->+                                          mkUnpackednessPV $1 $2 }++ftype :: { forall b. DisambTD b => PV (LocatedA b) }+        : atype                         { mkHsAppTyHeadPV $1 }+        | tyop                          { failOpFewArgs (fst $1) }+        | ftype tyarg                   { $1 >>= \ $1 ->+                                          mkHsAppTyPV $1 $2 }+        | ftype PREFIX_AT atype         { $1 >>= \ $1 ->+                                          mkHsAppKindTyPV $1 (epTok $2) $3 }++tyarg :: { LHsType GhcPs }+        : atype                         { $1 }+        | unpackedness atype            {% addUnpackednessP $1 $2 }++tyop :: { (LocatedN RdrName, PromotionFlag) }+        : qtyconop                      { ($1, NotPromoted) }+        | tyvarop                       { ($1, NotPromoted) }+        | SIMPLEQUOTE qconop            {% do { op <- amsr (sLL $1 $> (unLoc $2))+                                                           (NameAnnQuote (epTok $1) (gl $2) [])+                                              ; return (op, IsPromoted) } }+        | SIMPLEQUOTE varop             {% do { op <- amsr (sLL $1 $> (unLoc $2))+                                                           (NameAnnQuote (epTok $1) (gl $2) [])+                                              ; return (op, IsPromoted) } }++atype :: { LHsType GhcPs }+        : ntgtycon                       {% amsA' (sL1 $1 (HsTyVar noAnn NotPromoted $1)) }      -- Not including unit tuples+        -- See Note [%shift: atype -> tyvar]+        | tyvar %shift                   {% amsA' (sL1 $1 (HsTyVar noAnn NotPromoted $1)) }      -- (See Note [Unit tuples])+        | '_'   %shift                   { sL1a $1 $ mkAnonWildCardTy (epTok $1) }+        | '*'                            {% do { warnStarIsType (getLoc $1)+                                               ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } }++        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        | PREFIX_TILDE atype             {% amsA' (sLL $1 $> (mkBangTy (glR $1) SrcLazy $2)) }+        | PREFIX_BANG  atype             {% amsA' (sLL $1 $> (mkBangTy (glR $1) SrcStrict $2)) }++        | '{' fielddecls '}'             {% do { decls <- amsA' (sLL $1 $> $ HsRecTy (AnnList (listAsAnchorM $2) (ListBraces (epTok $1) (epTok $3)) [] noAnn []) $2)+                                               ; checkRecordSyntax decls }}+                                                        -- Constructor sigs only++        -- List and tuple syntax whose interpretation depends on the extension ListTuplePuns.+        | '(' ')'                        {% amsA' . sLL $1 $> =<< (mkTupleSyntaxTy (epTok $1) [] (epTok $>)) }+        | '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $2 (epTok $3)+                                               ; amsA' . sLL $1 $> =<< (mkTupleSyntaxTy (epTok $1) (h : $4) (epTok $>)) }}+        | '(#' '#)'                   {% do { requireLTPuns PEP_TupleSyntaxType $1 $>+                                            ; amsA' (sLL $1 $> $ HsTupleTy (AnnParensHash (epTok $1) (epTok $2)) HsUnboxedTuple []) } }+        | '(#' comma_types1 '#)'      {% do { requireLTPuns PEP_TupleSyntaxType $1 $>+                                            ; amsA' (sLL $1 $> $ HsTupleTy (AnnParensHash (epTok $1) (epTok $3)) HsUnboxedTuple $2) } }+        | '(#' bar_types2 '#)'        {% do { requireLTPuns PEP_SumSyntaxType $1 $>+                                      ; amsA' (sLL $1 $> $ HsSumTy (AnnParensHash (epTok $1) (epTok $3)) $2) } }+        | '[' ktype ']'               {% amsA' . sLL $1 $> =<< (mkListSyntaxTy1 (epTok $1) $2 (epTok $3)) }+        | '(' ktype ')'               {% amsA' (sLL $1 $> $ HsParTy (epTok $1, epTok $3) $2) }+                                      -- see Note [Promotion] for the followings+        | SIMPLEQUOTE '(' ')'         {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>+                                            ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) IsPromoted []) }}+        | SIMPLEQUOTE gen_qcon {% amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted $2) }+        | SIMPLEQUOTE sysdcon_nolist {% do { requireLTPuns PEP_QuoteDisambiguation $1 (reLoc $>)+                                           ; amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted (L (getLoc $2) $ nameRdrName (dataConName (unLoc $2)))) }}+        | SIMPLEQUOTE  '(' ktype ',' comma_types1 ')'+                             {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>+                                   ; h <- addTrailingCommaA $3 (epTok $4)+                                   ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $6) IsPromoted (h : $5)) }}+        | '[' ']'               {% withCombinedComments $1 $> (mkListSyntaxTy0 (epTok $1) (epTok $2)) }+        | SIMPLEQUOTE  '[' comma_types0 ']'     {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>+                                                      ; amsA' (sLL $1 $> $ HsExplicitListTy (epTok $1, epTok $2, epTok $4) IsPromoted $3) }}+        | SIMPLEQUOTE var                       {% amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted $2) }++        | quasiquote                  { mapLocA (HsSpliceTy noExtField) $1 }+        | splice_untyped              { mapLocA (HsSpliceTy noExtField) $1 }++        -- Two or more [ty, ty, ty] must be a promoted list type, just as+        -- if you had written '[ty, ty, ty]+        -- (One means a list type, zero means the list type constructor,+        -- so you have to quote those.)+        | '[' ktype ',' comma_types1 ']'  {% do { h <- addTrailingCommaA $2 (epTok $3)+                                                ; amsA' (sLL $1 $> $ HsExplicitListTy (NoEpTok,epTok $1,epTok $5) NotPromoted (h:$4)) }}+        | INTEGER              { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1)+                                                           (il_value (getINTEGER $1)) }+        | CHAR                 { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1)+                                                                        (getCHAR $1) }+        | STRING               { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1)+                                                                     (getSTRING  $1) }+        | STRING_MULTI         { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGMULTIs $1)+                                                                     (getSTRINGMULTI  $1) }+        -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer.+        -- We let it pass the parser because the renamer can generate a better error message.+        | QVARID                      {% let qname = mkQual tvName (getQVARID $1)+                                         in  amsA' (sL1 $1 (HsTyVar noAnn NotPromoted (sL1n $1 $ qname)))}++-- An inst_type is what occurs in the head of an instance decl+--      e.g.  (Foo a, Gaz b) => Wibble a b+-- It's kept as a single type for convenience.+inst_type :: { LHsSigType GhcPs }+        : sigtype                       { $1 }++deriv_types :: { [LHsSigType GhcPs] }+        : sigktype                      { [$1] }++        | sigktype ',' deriv_types      {% do { h <- addTrailingCommaA $1 (epTok $2)+                                           ; return (h : $3) } }++comma_types0  :: { [LHsType GhcPs] }  -- Zero or more:  ty,ty,ty+        : comma_types1                  { $1 }+        | {- empty -}                   { [] }++comma_types1    :: { [LHsType GhcPs] }  -- One or more:  ty,ty,ty+        : ktype                        { [$1] }+        | ktype  ',' comma_types1      {% do { h <- addTrailingCommaA $1 (epTok $2)+                                             ; return (h : $3) }}++bar_types2    :: { [LHsType GhcPs] }  -- Two or more:  ty|ty|ty+        : ktype  '|' ktype             {% do { h <- addTrailingVbarA $1 (epTok $2)+                                             ; return [h,$3] }}+        | ktype  '|' bar_types2        {% do { h <- addTrailingVbarA $1 (epTok $2)+                                             ; return (h : $3) }}++tv_bndrs :: { [LHsTyVarBndr Specificity GhcPs] }+         : tv_bndr tv_bndrs             { $1 : $2 }+         | {- empty -}                  { [] }++tv_bndr :: { LHsTyVarBndr Specificity GhcPs }+        : tv_bndr_no_braces             { $1 }+        | '{' tyvar '}'                 {% amsA' (sLL $1 $>+                                                (HsTvb { tvb_ext  = AnnTyVarBndr [glR $1] [glR $3] noAnn noAnn+                                                       , tvb_flag = InferredSpec+                                                       , tvb_var  = HsBndrVar noExtField $2+                                                       , tvb_kind = HsBndrNoKind noExtField })) }+        | '{' tyvar '::' kind '}'       {% amsA' (sLL $1 $>+                                                (HsTvb { tvb_ext  = AnnTyVarBndr [glR $1] [glR $5] noAnn (epUniTok $3)+                                                       , tvb_flag = InferredSpec+                                                       , tvb_var  = HsBndrVar noExtField $2+                                                       , tvb_kind = HsBndrKind noExtField $4 })) }++tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs }+        : tyvar_wc                      {% amsA' (sL1 $1+                                                (HsTvb { tvb_ext  = noAnn+                                                       , tvb_flag = SpecifiedSpec+                                                       , tvb_var  = unLoc $1+                                                       , tvb_kind = HsBndrNoKind noExtField })) }+        | '(' tyvar_wc '::' kind ')'    {% amsA' (sLL $1 $>+                                                (HsTvb { tvb_ext  = AnnTyVarBndr [glR $1] [glR $5] noAnn (epUniTok $3)+                                                       , tvb_flag = SpecifiedSpec+                                                       , tvb_var  = unLoc $2+                                                       , tvb_kind = HsBndrKind noExtField $4 })) }++tyvar_wc :: { Located (HsBndrVar GhcPs) }+        : tyvar                         { sL1 $1 (HsBndrVar noExtField $1) }+        | '_'                           { sL1 $1 (HsBndrWildCard (epTok $1)) }++fds :: { Located (EpToken "|",[LHsFunDep GhcPs]) }+        : {- empty -}                   { noLoc (NoEpTok,[]) }+        | '|' fds1                      { (sLL $1 $> (epTok $1 ,reverse (unLoc $2))) }++fds1 :: { Located [LHsFunDep GhcPs] }+        : fds1 ',' fd   {%+                           do { let (h:t) = unLoc $1 -- Safe from fds1 rules+                              ; h' <- addTrailingCommaA h (epTok $2)+                              ; return (sLL $1 $> ($3 : h' : t)) }}+        | fd            { sL1 $1 [$1] }++fd :: { LHsFunDep GhcPs }+        : varids0 '->' varids0  {% amsA' (L (comb3 $1 $2 $3)+                                       (FunDep (epUniTok $2)+                                               (reverse (unLoc $1))+                                               (reverse (unLoc $3)))) }++varids0 :: { Located [LocatedN RdrName] }+        : {- empty -}                   { noLoc [] }+        | varids0 tyvar                 { sLL $1 $> ($2 : (unLoc $1)) }++-----------------------------------------------------------------------------+-- Kinds++kind :: { LHsKind GhcPs }+        : ctype                  { $1 }++{- Note [Promotion]+   ~~~~~~~~~~~~~~~~++- Syntax of promoted qualified names+We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified+names. Moreover ticks are only allowed in types, not in kinds, for a+few reasons:+  1. we don't need quotes since we cannot define names in kinds+  2. if one day we merge types and kinds, tick would mean look in DataName+  3. we don't have a kind namespace anyway++- Name resolution+When the user write Zero instead of 'Zero in types, we parse it a+HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We+deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not+bounded in the type level, then we look for it in the term level (we+change its namespace to DataName, see Note [Demotion] in GHC.Types.Names.OccName).+And both become a HsTyVar ("Zero", DataName) after the renamer.++- ListTuplePuns+When this extension is disabled, ticked constructors for lists and tuples are+not accepted, while the unticked variants are unconditionally parsed as data+constructors.++-}+++-----------------------------------------------------------------------------+-- Datatype declarations++gadt_constrlist :: { Located ((EpToken "where", EpToken "{", EpToken "}")+                          ,[LConDecl GhcPs]) } -- Returned in order++        : 'where' '{'        gadt_constrs '}'    {% checkEmptyGADTs $+                                                      L (comb2 $1 $4)+                                                        ((epTok $1+                                                         ,epTok $2+                                                         ,epTok $4)+                                                        , unLoc $3) }+        | 'where' vocurly    gadt_constrs close  {% checkEmptyGADTs $+                                                      L (comb2 $1 $3)+                                                        ((epTok $1, NoEpTok, NoEpTok)+                                                        , unLoc $3) }+        | {- empty -}                            { noLoc (noAnn,[]) }++gadt_constrs :: { Located [LConDecl GhcPs] }+        : gadt_constr ';' gadt_constrs+                  {% do { h <- addTrailingSemiA $1 (epTok $2)+                        ; return (L (comb2 $1 $3) (h : unLoc $3)) }}+        | gadt_constr                   { L (glA $1) [$1] }+        | {- empty -}                   { noLoc [] }++-- We allow the following forms:+--      C :: Eq a => a -> T a+--      C :: forall a. Eq a => !a -> T a+--      D { x,y :: a } :: T a+--      forall a. Eq a => D { x,y :: a } :: T a++gadt_constr :: { LConDecl GhcPs }+    -- see Note [Difference in parsing GADT and data constructors]+    -- Returns a list because of:   C,D :: ty+    -- TODO:AZ capture the optSemi. Why leading?+        : optSemi con_list '::' sigtype+                {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (epUniTok $3) $4 }++{- Note [Difference in parsing GADT and data constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GADT constructors have simpler syntax than usual data constructors:+in GADTs, types cannot occur to the left of '::', so they cannot be mixed+with constructor names (see Note [Parsing data constructors is hard]).++Due to simplified syntax, GADT constructor names (left-hand side of '::')+use simpler grammar production than usual data constructor names. As a+consequence, GADT constructor names are restricted (names like '(*)' are+allowed in usual data constructors, but not in GADTs).+-}++constrs :: { Located (EpToken "=",[LConDecl GhcPs]) }+        : '=' constrs1    { sLL $1 $2 (epTok $1,unLoc $2)}++constrs1 :: { Located [LConDecl GhcPs] }+        : constrs1 '|' constr+            {% do { let (h:t) = unLoc $1+                  ; h' <- addTrailingVbarA h (epTok $2)+                  ; return (sLL $1 $> ($3 : h' : t)) }}+        | constr                         { sL1 $1 [$1] }++constr :: { LConDecl GhcPs }+        : forall context '=>' constr_stuff+                {% amsA' (let (con,details) = unLoc $4 in+                  (L (comb4 $1 $2 $3 $4) (mkConDeclH98+                                                       (epUniTok $3,(fst $ unLoc $1))+                                                       con+                                                       (snd $ unLoc $1)+                                                       (Just $2)+                                                       details))) }+        | forall constr_stuff+                {% amsA' (let (con,details) = unLoc $2 in+                  (L (comb2 $1 $2) (mkConDeclH98 (noAnn, fst $ unLoc $1)+                                                      con+                                                      (snd $ unLoc $1)+                                                      Nothing   -- No context+                                                      details))) }++forall :: { Located ((TokForall, EpToken "."), Maybe [LHsTyVarBndr Specificity GhcPs]) }+        : 'forall' tv_bndrs '.'       { sLL $1 $> ((epUniTok $1,epTok $3), Just $2) }+        | {- empty -}                 { noLoc (noAnn, Nothing) }++constr_stuff :: { Located (LocatedN RdrName, HsConDeclH98Details GhcPs) }+        : infixtype       {% do { b <- runPV $1+                                ; return (sL1 b (dataConBuilderCon b, dataConBuilderDetails b)) }}+        | '(#' usum_constr '#)' {% let (t, tag, arity) = $2 in pure (sLL $1 $3 $ mkUnboxedSumCon t tag arity)}++usum_constr :: { (LHsType GhcPs, Int, Int) } -- constructor for the data decls SumN#+         : ktype bars { ($1, 1, (snd $2 + 1)) }+         | bars ktype bars0 { ($2, snd $1 + 1, snd $1 + snd $3 + 1) }++fielddecls :: { [LConDeclField GhcPs] }+        : {- empty -}     { [] }+        | fielddecls1     { $1 }++fielddecls1 :: { [LConDeclField GhcPs] }+        : fielddecl ',' fielddecls1+            {% do { h <- addTrailingCommaA $1 (epTok $2)+                  ; return (h : $3) }}+        | fielddecl   { [$1] }++fielddecl :: { LConDeclField GhcPs }+                                              -- A list because of   f,g :: Int+        : sig_vars '::' ctype+            {% amsA' (L (comb2 $1 $3)+                      (ConDeclField (epUniTok $2)+                                    (reverse (map (\ln@(L l n)+                                               -> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc $1))) $3 Nothing))}++-- Reversed!+maybe_derivings :: { Located (HsDeriving GhcPs) }+        : {- empty -}             { noLoc [] }+        | derivings               { $1 }++-- A list of one or more deriving clauses at the end of a datatype+derivings :: { Located (HsDeriving GhcPs) }+        : derivings deriving      { sLL $1 $> ($2 : unLoc $1) } -- AZ: order?+        | deriving                { sL1 $> [$1] }++-- The outer Located is just to allow the caller to+-- know the rightmost extremity of the 'deriving' clause+deriving :: { LHsDerivingClause GhcPs }+        : 'deriving' deriv_clause_types+              {% let { full_loc = comb2 $1 $> }+                 in amsA' (L full_loc $ HsDerivingClause (epTok $1) Nothing $2) }++        | 'deriving' deriv_strategy_no_via deriv_clause_types+              {% let { full_loc = comb2 $1 $> }+                 in amsA' (L full_loc $ HsDerivingClause (epTok $1) (Just $2) $3) }++        | 'deriving' deriv_clause_types deriv_strategy_via+              {% let { full_loc = comb2 $1 $> }+                 in amsA' (L full_loc $ HsDerivingClause (epTok $1) (Just $3) $2) }++deriv_clause_types :: { LDerivClauseTys GhcPs }+        : qtycon              { let { tc = sL1a $1 $ mkHsImplicitSigType $+                                           sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in+                                sL1a $1 (DctSingle noExtField tc) }+        | '(' ')'             {% amsr (sLL $1 $> (DctMulti noExtField []))+                                      (AnnContext Nothing [epTok $1] [epTok $2]) }+        | '(' deriv_types ')' {% amsr (sLL $1 $> (DctMulti noExtField $2))+                                      (AnnContext Nothing [epTok $1] [epTok $3])}++-----------------------------------------------------------------------------+-- Value definitions++{- Note [Declaration/signature overlap]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There's an awkward overlap with a type signature.  Consider+        f :: Int -> Int = ...rhs...+   Then we can't tell whether it's a type signature or a value+   definition with a result signature until we see the '='.+   So we have to inline enough to postpone reductions until we know.+-}++{-+  ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var+  instead of qvar, we get another shift/reduce-conflict. Consider the+  following programs:++     { (^^) :: Int->Int ; }          Type signature; only var allowed++     { (^^) :: Int->Int = ... ; }    Value defn with result signature;+                                     qvar allowed (because of instance decls)++  We can't tell whether to reduce var to qvar until after we've read the signatures.+-}++decl_no_th :: { LHsDecl GhcPs }+        : sigdecl               { $1 }++        | infixexp     opt_sig rhs  {% runPV (unECP $1) >>= \ $1 ->+                                       do { let { l = comb2 $1 $> }+                                          ; r <- checkValDef l $1 (HsNoMultAnn noExtField, $2) $3;+                                        -- Depending upon what the pattern looks like we might get either+                                        -- a FunBind or PatBind back from checkValDef. See Note+                                        -- [FunBind vs PatBind]+                                          ; !cs <- getCommentsFor l+                                          ; return $! (sL (commentsA l cs) $ ValD noExtField r) } }+        | PREFIX_PERCENT atype infixexp     opt_sig rhs  {% runPV (unECP $3) >>= \ $3 ->+                                       do { let { l = comb2 $1 $> }+                                          ; r <- checkValDef l $3 (mkMultAnn (epTok $1) $2, $4) $5;+                                        -- parses bindings of the form %p x or+                                        -- %p x :: sig+                                        --+                                        -- Depending upon what the pattern looks like we might get either+                                        -- a FunBind or PatBind back from checkValDef. See Note+                                        -- [FunBind vs PatBind]+                                          ; !cs <- getCommentsFor l+                                          ; return $! (sL (commentsA l cs) $ ValD noExtField r) } }+        | pattern_synonym_decl  { $1 }++decl    :: { LHsDecl GhcPs }+        : decl_no_th            { $1 }++        -- Why do we only allow naked declaration splices in top-level+        -- declarations and not here? Short answer: because readFail009+        -- fails terribly with a panic in cvBindsAndSigs otherwise.+        | splice_exp            { mkSpliceDecl $1 }++rhs     :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) }+        : '=' exp wherebinds    {% runPV (unECP $2) >>= \ $2 ->+                                  do { let L l (bs, csw) = adaptWhereBinds $3+                                     ; let loc = (comb3 $1 $2 (L l bs))+                                     ; let locg = (comb2 $1 $2)+                                     ; acs loc (\loc cs ->+                                       sL loc (GRHSs csw (unguardedRHS (EpAnn (spanAsAnchor locg) (GrhsAnn Nothing (Left $ epTok $1)) cs) locg $2)+                                                      bs)) } }+        | gdrhs wherebinds      {% do { let {L l (bs, csw) = adaptWhereBinds $2}+                                      ; acs (comb2 $1 (L l bs)) (\loc cs -> L loc+                                                (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }}++gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }+        : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }+        | gdrh                  { sL1 $1 [$1] }++gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }+        : '|' guardquals '=' exp  {% runPV (unECP $4) >>= \ $4 ->+                                     acsA (comb2 $1 $>) (\loc cs -> L loc $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ epTok $1) (Left $ epTok $3)) cs) (unLoc $2) $4) }++sigdecl :: { LHsDecl GhcPs }+        :+        -- See Note [Declaration/signature overlap] for why we need infixexp here+          infixexp     '::' sigtype+                        {% do { $1 <- runPV (unECP $1)+                              ; v <- checkValSigLhs $1+                              ; amsA' (sLL $1 $> $ SigD noExtField $+                                  TypeSig (AnnSig (epUniTok $2) Nothing Nothing) [v] (mkHsWildCardBndrs $3))} }++        | var ',' sig_vars '::' sigtype+           {% do { v <- addTrailingCommaN $1 (gl $2)+                 ; let sig = TypeSig (AnnSig (epUniTok $4) Nothing Nothing) (v : reverse (unLoc $3))+                                      (mkHsWildCardBndrs $5)+                 ; amsA' (sLL $1 $> $ SigD noExtField sig ) }}++        | infix prec namespace_spec ops+             {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $4+                                                      ; pure (glR l2) })+                                       $2+                   ; let (fixText, fixPrec) = case $2 of+                                                -- If an explicit precedence isn't supplied,+                                                -- it defaults to maxPrecedence+                                                Nothing -> (NoSourceText, maxPrecedence)+                                                Just l2 -> (fst $ unLoc l2, snd $ unLoc l2)+                   ; amsA' (sLL $1 $> $ SigD noExtField+                            (FixSig ((glR $1, mbPrecAnn), fixText) (FixitySig (unLoc $3) (fromOL $ unLoc $4)+                                    (Fixity fixPrec (unLoc $1)))))+                   }}++        | pattern_synonym_sig   { L (getLoc $1) . SigD noExtField . unLoc $ $1 }++        | '{-# COMPLETE' qcon_list opt_tyconsig  '#-}'+                {% let (dcolon, tc) = $3+                   in amsA' (sLL $1 $>+                         (SigD noExtField (CompleteMatchSig ((glR $1,dcolon,epTok $4), (getCOMPLETE_PRAGs $1)) $2 tc))) }++        -- This rule is for both INLINE and INLINABLE pragmas+        | '{-# INLINE' activation qvarcon '#-}'+                {% amsA' (sLL $1 $> $ SigD noExtField (InlineSig (glR $1, epTok $4, fst $2) $3+                            (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)+                                            (snd $2)))) }+        | '{-# OPAQUE' qvar '#-}'+                {% amsA' (sLL $1 $> $ SigD noExtField (InlineSig (glR $1, epTok $3, noAnn) $2+                            (mkOpaquePragma (getOPAQUE_PRAGs $1)))) }+        | '{-# SCC' qvar '#-}'+          {% amsA' (sLL $1 $> (SigD noExtField (SCCFunSig ((glR $1, epTok $3), (getSCC_PRAGs $1)) $2 Nothing))) }++        | '{-# SCC' qvar STRING '#-}'+          {% do { scc <- getSCC $3+                ; let str_lit = StringLiteral (getSTRINGs $3) scc Nothing+                ; amsA' (sLL $1 $> (SigD noExtField (SCCFunSig ((glR $1, epTok $4), (getSCC_PRAGs $1)) $2 (Just ( sL1a $3 str_lit))))) }}++        | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'+             {% amsA' (+                 let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)+                                             (NoUserInlinePrag, FunLike) (snd $2)+                  in sLL $1 $> $ SigD noExtField (SpecSig (AnnSpecSig (glR $1) (epTok $6) (epUniTok $4) (fst $2)) $3 (fromOL $5) inl_prag)) }++        | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'+             {% amsA' (sLL $1 $> $ SigD noExtField (SpecSig (AnnSpecSig (glR $1) (epTok $6) (epUniTok $4) (fst $2)) $3 (fromOL $5)+                               (mkInlinePragma (getSPEC_INLINE_PRAGs $1)+                                               (getSPEC_INLINE $1) (snd $2)))) }++        | '{-# SPECIALISE' 'instance' inst_type '#-}'+                {% amsA' (sLL $1 $> $ SigD noExtField (SpecInstSig ((glR $1,epTok $2,epTok $4), (getSPEC_PRAGs $1)) $3)) }++        -- A minimal complete definition+        | '{-# MINIMAL' name_boolformula_opt '#-}'+            {% amsA' (sLL $1 $> $ SigD noExtField (MinimalSig ((glR $1,epTok $3), (getMINIMAL_PRAGs $1)) $2)) }++activation :: { (ActivationAnn,Maybe Activation) }+        -- See Note [%shift: activation -> {- empty -}]+        : {- empty -} %shift                    { (noAnn ,Nothing) }+        | explicit_activation                   { (fst $1,Just (snd $1)) }++explicit_activation :: { (ActivationAnn, Activation) }  -- In brackets+        : '[' INTEGER ']'       { (ActivationAnn (epTok $1) (epTok  $3) Nothing (Just (glR $2))+                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }+        | '[' rule_activation_marker INTEGER ']'+                                { (ActivationAnn (epTok $1) (epTok $4) $2 (Just (glR $3))+                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }++-----------------------------------------------------------------------------+-- Expressions++quasiquote :: { Located (HsUntypedSplice GhcPs) }+        : TH_QUASIQUOTE   { let { loc = getLoc $1+                                ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1+                                ; quoterId = mkUnqual varName quoter }+                            in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) }+        | TH_QQUASIQUOTE  { let { loc = getLoc $1+                                ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1+                                ; quoterId = mkQual varName (qual, quoter) }+                            in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) }++exp  :: { ECP } : exp_gen(infixexp)  { $1 }+exp2 :: { ECP } : exp_gen(infixexp2) { $1 }++exp_gen(IEXP) :: { ECP }+        : IEXP '::' ctype+                                { ECP $+                                   unECP $1 >>= \ $1 ->+                                   rejectPragmaPV $1 >>+                                   mkHsTySigPV (noAnnSrcSpan $ comb2 $1 $>) $1 $3+                                          (epUniTok $2) }+        | IEXP '-<' exp_gen(IEXP)+                                {% runPV (unECP $1) >>= \ $1 ->+                                   runPV (unECP $3) >>= \ $3 ->+                                   fmap ecpFromCmd $+                                   amsA' (sLL $1 $> $ HsCmdArrApp (isUnicodeSyntax $2, glR $2) $1 $3+                                                        HsFirstOrderApp True) }+        | IEXP '>-' exp_gen(IEXP)+                                {% runPV (unECP $1) >>= \ $1 ->+                                   runPV (unECP $3) >>= \ $3 ->+                                   fmap ecpFromCmd $+                                   amsA' (sLL $1 $> $ HsCmdArrApp (isUnicodeSyntax $2, glR $2) $3 $1+                                                      HsFirstOrderApp False) }+        | IEXP '-<<' exp_gen(IEXP)+                                {% runPV (unECP $1) >>= \ $1 ->+                                   runPV (unECP $3) >>= \ $3 ->+                                   fmap ecpFromCmd $+                                   amsA' (sLL $1 $> $ HsCmdArrApp (isUnicodeSyntax $2, glR $2) $1 $3+                                                      HsHigherOrderApp True) }+        | IEXP '>>-' exp_gen(IEXP)+                                {% runPV (unECP $1) >>= \ $1 ->+                                   runPV (unECP $3) >>= \ $3 ->+                                   fmap ecpFromCmd $+                                   amsA' (sLL $1 $> $ HsCmdArrApp (isUnicodeSyntax $2, glR $2) $3 $1+                                                      HsHigherOrderApp False) }+        -- See Note [%shift: exp -> infixexp]+        | IEXP %shift              { $1 }+        | exp_prag(exp_gen(IEXP))  { $1 } -- See Note [Pragmas and operator fixity]++        -- Embed types into expressions and patterns for required type arguments+        | 'type' atype             { ECP $ mkHsEmbTyPV (comb2 $1 $>) (epTok $1) $2 }++infixexp2 :: { ECP }+        : infixexp %shift       { $1 }++        -- View patterns and function arrows+        | infixexp '->' infixexp2+                                { ECP $+                                  withArrowParsingMode' $ \mode ->+                                  unECP $1 >>= \ $1 ->+                                  unECP $3 >>= \ $3 ->+                                  let arr = HsUnrestrictedArrow (epUniTok $2)+                                  in mkHsArrowPV (comb2 $1 $>) mode $1 arr $3 }+        | infixexp expmult '->'  infixexp2+                                { ECP $+                                  unECP $1         >>= \ $1 ->+                                  $2               >>= \ $2 ->+                                  unECP $4         >>= \ $4 ->+                                  hintLinear (getLoc $2) >>+                                  let arr = (unLoc $2) (epUniTok $3)+                                  in mkHsArrowPV (comb2 $1 $>) ArrowIsFunType $1 arr $4 }+        | infixexp      '->.' infixexp2+                                { ECP $+                                  hintLinear (getLoc $2) >>+                                  unECP $1 >>= \ $1 ->+                                  unECP $3 >>= \ $3 ->+                                  let arr = HsLinearArrow (EpLolly (epTok $2))+                                  in mkHsArrowPV (comb2 $1 $>) ArrowIsFunType $1 arr $3 }+        | expcontext    '=>'  infixexp2+                                { ECP $+                                        $1 >>= \ $1 ->+                                  unECP $3 >>= \ $3 ->+                                  mkQualPV (comb2 $1 $>) (addTrailingDarrowC $1 $2 emptyComments) $3}++        | forall_telescope infixexp2+                                { ECP $+                                  unECP $2 >>= \ $2 ->+                                  mkHsForallPV (comb2 $1 $>) (unLoc $1) $2 }++infixexp :: { ECP }+        : exp10 { $1 }+        | infixexp qop exp10p    -- See Note [Pragmas and operator fixity]+                               { ECP $+                                 superInfixOp $+                                 $2 >>= \ $2 ->+                                 unECP $1 >>= \ $1 ->+                                 unECP $3 >>= \ $3 ->+                                 rejectPragmaPV $1 >>+                                 (mkHsOpAppPV (comb2 $1 $3) $1 $2 $3) }+                 -- AnnVal annotation for NPlusKPat, which discards the operator++exp10p :: { ECP }+  : exp10            { $1 }+  | exp_prag(exp10p) { $1 } -- See Note [Pragmas and operator fixity]++exp_prag(e) :: { ECP }+  : prag_e e  -- See Note [Pragmas and operator fixity]+      {% runPV (unECP $2) >>= \ $2 ->+         fmap ecpFromExp $+         amsA' $ (sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) }++exp10 :: { ECP }+        -- See Note [%shift: exp10 -> '-' fexp]+        : '-' fexp %shift               { ECP $+                                           unECP $2 >>= \ $2 ->+                                           mkHsNegAppPV (comb2 $1 $>) $2+                                                 (epTok $1) }+        -- See Note [%shift: exp10 -> fexp]+        | fexp %shift                  { $1 }++optSemi :: { (Maybe (EpToken ";"),Bool) }+        : ';'         { (msemim $1,True) }+        | {- empty -} { (Nothing,False) }++{- Note [Pragmas and operator fixity]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+'prag_e' is an expression pragma, such as {-# SCC ... #-}.++It must be used with care, or else #15730 happens. Consider this infix+expression:++         1 / 2 / 2++There are two ways to parse it:++    1.   (1 / 2) / 2   =  0.25+    2.   1 / (2 / 2)   =  1.0++Due to the fixity of the (/) operator (assuming it comes from Prelude),+option 1 is the correct parse. However, in the past GHC's parser used to get+confused by the SCC annotation when it occurred in the middle of an infix+expression:++         1 / {-# SCC ann #-} 2 / 2    -- used to get parsed as option 2++There are several ways to address this issue, see GHC Proposal #176 for a+detailed exposition:++  https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst++The accepted fix is to disallow pragmas that occur within infix expressions.+Infix expressions are assembled out of 'exp10', so 'exp10' must not accept+pragmas. Instead, we accept them in exactly two places:++* at the start of an expression or a parenthesized subexpression:++    f = {-# SCC ann #-} 1 / 2 / 2          -- at the start of the expression+    g = 5 + ({-# SCC ann #-} 1 / 2 / 2)    -- at the start of a parenthesized subexpression++* immediately after the last operator:++    f = 1 / 2 / {-# SCC ann #-} 2++In both cases, the parse does not depend on operator fixity. The second case+may sound unnecessary, but it's actually needed to support a common idiom:++    f $ {-# SCC ann $-} ...++-}+prag_e :: { Located (HsPragE GhcPs) }+      : '{-# SCC' STRING '#-}'      {% do { scc <- getSCC $2+                                          ; return (sLL $1 $>+                                             (HsPragSCC+                                                (AnnPragma (glR $1) (epTok $3) noAnn (glR $2) noAnn noAnn noAnn,+                                                (getSCC_PRAGs $1))+                                                (StringLiteral (getSTRINGs $2) scc Nothing)))} }+      | '{-# SCC' VARID  '#-}'      { sLL $1 $>+                                             (HsPragSCC+                                               (AnnPragma (glR $1) (epTok $3) noAnn (glR $2) noAnn noAnn noAnn,+                                               (getSCC_PRAGs $1))+                                               (StringLiteral NoSourceText (getVARID $2) Nothing)) }++fexp    :: { ECP }+        : fexp aexp                  { ECP $+                                          superFunArg $+                                          unECP $1 >>= \ $1 ->+                                          unECP $2 >>= \ $2 ->+                                          spanWithComments (comb2 $1 $>) >>= \l ->+                                          mkHsAppPV l $1 $2 }++        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        | fexp PREFIX_AT atype       { ECP $+                                        unECP $1 >>= \ $1 ->+                                        mkHsAppTypePV (noAnnSrcSpan $ comb2 $1 $>) $1 (epTok $2) $3 }++        | 'static' aexp              {% runPV (unECP $2) >>= \ $2 ->+                                        fmap ecpFromExp $+                                        amsA' (sLL $1 $> $ HsStatic (epTok $1) $2) }++        | aexp                       { $1 }++aexp    :: { ECP }+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        : qvar TIGHT_INFIX_AT aexp+                                { ECP $+                                   unECP $3 >>= \ $3 ->+                                     mkHsAsPatPV (comb2 $1 $>) $1 (epTok $2) $3 }+++        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        | PREFIX_TILDE aexp     { ECP $+                                   unECP $2 >>= \ $2 ->+                                   mkHsLazyPatPV (comb2 $1 $>) $2 (epTok $1) }+        | PREFIX_BANG aexp      { ECP $+                                   unECP $2 >>= \ $2 ->+                                   mkHsBangPatPV (comb2 $1 $>) $2 (epTok $1) }+        | PREFIX_MINUS aexp     { ECP $+                                   unECP $2 >>= \ $2 ->+                                   mkHsNegAppPV (comb2 $1 $>) $2 (epTok $1) }+        | 'let' binds 'in' exp          {  ECP $+                                           unECP $4 >>= \ $4 ->+                                           mkHsLetPV (comb2 $1 $>) (epTok $1) (unLoc $2) (epTok $3) $4 }+        | '\\' argpats '->' exp { ECP $+                      unECP $4 >>= \ $4 ->+                      mkHsLamPV (comb2 $1 $>) LamSingle+                            (sLLld $1 $>+                            [sLLa $1 $>+                                         $ Match { m_ext = noExtField+                                                 , m_ctxt = LamAlt LamSingle+                                                 , m_pats = L (listLocation $2) $2+                                                 , m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (Right $ epUniTok $3)) emptyComments) }])+                            (EpAnnLam (epTok $1) Nothing) }+        | '\\' 'lcase' altslist(pats1)+            {  ECP $ $3 >>= \ $3 ->+                 mkHsLamPV (comb3 $1 $2 $>) LamCase $3 (EpAnnLam (epTok $1) (Just (glR $2))) }+        | '\\' 'lcases' altslist(argpats)+            {  ECP $ $3 >>= \ $3 ->+                 mkHsLamPV (comb3 $1 $2 $>) LamCases $3 (EpAnnLam (epTok $1) (Just (glR $2))) }+        | 'if' exp optSemi 'then' exp optSemi 'else' exp+                         {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->+                            return $ ECP $+                              unECP $5 >>= \ $5 ->+                              unECP $8 >>= \ $8 ->+                              mkHsIfPV (comb2 $1 $>) $2 (snd $3) $5 (snd $6) $8+                                    (AnnsIf+                                      { aiIf = epTok $1+                                      , aiThen = epTok $4+                                      , aiElse = epTok $7+                                      , aiThenSemi = fst $3+                                      , aiElseSemi = fst $6})}++        | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>= \_ ->+                                           fmap ecpFromExp $+                                           do { let (L _ ((o,c),_)) = $2+                                              ; amsA' (sLL $1 $> $ HsMultiIf (epTok $1, o, c)+                                                     (reverse $ snd $ unLoc $2)) }}+        | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->+                                             return $ ECP $+                                               $4 >>= \ $4 ->+                                               mkHsCasePV (comb3 $1 $3 $4) $2 $4+                                                    (EpAnnHsCase (epTok $1) (epTok $3)) }+        -- QualifiedDo.+        | DO  stmtlist               {% do+                                      hintQualifiedDo $1+                                      return $ ECP $+                                        $2 >>= \ $2 ->+                                        mkHsDoPV (comb2 $1 $2)+                                                 (fmap mkModuleNameFS (getDO $1))+                                                 $2+                                                 (glR $1)+                                                 (glR $2) }+        | MDO stmtlist             {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 ->+                                       fmap ecpFromExp $+                                       amsA' (L (comb2 $1 $2)+                                              (mkMDo (MDoExpr $ fmap mkModuleNameFS (getMDO $1))+                                                     $2+                                                     (glR $1)+                                                     (glR $2))) }+        | 'proc' aexp '->' exp+                       {% (checkPattern <=< runPV) (unECP $2) >>= \ p ->+                           runPV (unECP $4) >>= \ $4@cmd ->+                           fmap ecpFromExp $+                           amsA' (sLL $1 $> $HsProc (epTok $1, epUniTok $3) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) }++        | aexp1                 { $1 }++aexp1   :: { ECP }+        : aexp1 '{' fbinds '}' { ECP $+                                   getBit OverloadedRecordUpdateBit >>= \ overloaded ->+                                   unECP $1 >>= \ $1 ->+                                   $3 >>= \ $3 ->+                                   mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 $3+                                        (Just (epTok $2), Just (epTok $4))+                               }++        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        | aexp1 TIGHT_INFIX_PROJ field+            {% runPV (unECP $1) >>= \ $1 ->+               fmap ecpFromExp $ amsA' (+                 let fl = sLLa $2 $> (DotFieldOcc (AnnFieldLabel (Just $ epTok $2)) $3) in+               sLL $1 $> $ mkRdrGetField $1 fl)  }++++        | aexp2                { $1 }++aexp2   :: { ECP }+        : qvar                          { ECP $ mkHsVarPV $! $1 }+        | qcon                          { ECP $ mkHsVarPV $! $1 }+        -- See Note [%shift: aexp2 -> ipvar]+        | ipvar %shift                  {% fmap ecpFromExp+                                           (ams1 $1 (HsIPVar NoExtField $! unLoc $1)) }+        | overloaded_label              {% fmap ecpFromExp+                                           (ams1 $1 (HsOverLabel (fst $! unLoc $1) (snd $! unLoc $1))) }+        | literal                       { ECP $ mkHsLitPV $! $1 }+-- This will enable overloaded strings permanently.  Normally the renamer turns HsString+-- into HsOverLit when -XOverloadedStrings is on.+--      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)+--                                       (getSTRING $1) noExtField) }+        | INTEGER   { ECP $ mkHsOverLitPV (sL1a $1 $ mkHsIntegral   (getINTEGER  $1)) }+        | RATIONAL  { ECP $ mkHsOverLitPV (sL1a $1 $ mkHsFractional (getRATIONAL $1)) }++        -- N.B.: sections get parsed by these next two productions.+        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't+        -- correct Haskell (you'd have to write '((+ 3), (4 -))')+        -- but the less cluttered version fell out of having texps.+        | '(' texp ')'                  { ECP $+                                           unECP $2 >>= \ $2 ->+                                           mkHsParPV (comb2 $1 $>) (epTok $1) $2 (epTok $3) }+        | '(' tup_exprs ')'             { ECP $+                                           $2 >>= \ $2 ->+                                           mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2+                                                (glR $1,glR $3)}++        | '(' orpats(exp2) ')'          {% do+                                              { pat <- hintOrPats (sL1a $2 (OrPat NoExtField (unLoc $2)))+                                              ; fmap ecpFromPat+                                                (amsA' (sLL $1 $> (ParPat (epTok $1, epTok $>) pat))) }}++        -- This case is only possible when 'OverloadedRecordDotBit' is enabled.+        | '(' projection ')'            { ECP $+                                            amsA' (sLL $1 $> $ mkRdrProjection (NE.reverse (unLoc $2)) (AnnProjection (epTok $1) (epTok $3)) )+                                            >>= ecpFromExp'+                                        }++        | '(#' texp '#)'                { ECP $+                                           unECP $2 >>= \ $2 ->+                                           mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed (Tuple [Right $2])+                                                 (glR $1,glR $3) }+        | '(#' tup_exprs '#)'           { ECP $+                                           $2 >>= \ $2 ->+                                           mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed $2+                                                (glR $1,glR $3) }++        | '[' list ']'      { ECP $ $2 (comb2 $1 $>) (glR $1,glR $3) }+        | '_'               { ECP $ mkHsWildCardPV (getLoc $1) }++        -- Template Haskell Extension+        | splice_untyped { ECP $ mkHsSplicePV $1 }+        | splice_typed   { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLoc $1) }++        | SIMPLEQUOTE  qvar     {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket noExtField (VarBr (glR $1) True  $2)) }+        | SIMPLEQUOTE  qcon     {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket noExtField (VarBr (glR $1) True  $2)) }+        | TH_TY_QUOTE tyvar     {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket noExtField (VarBr (glR $1) False $2)) }+        | TH_TY_QUOTE gtycon    {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket noExtField (VarBr (glR $1) False $2)) }+        -- See Note [%shift: aexp2 -> TH_TY_QUOTE]+        | TH_TY_QUOTE %shift    {% reportEmptyDoubleQuotes (getLoc $1) }+        | '[|' exp '|]'       {% runPV (unECP $2) >>= \ $2 ->+                                 fmap ecpFromExp $+                                 amsA' (sLL $1 $> $ HsUntypedBracket noExtField (ExpBr (if (hasE $1) then (BracketHasE (epTok $1),   epUniTok $3)+                                                                                                     else (BracketNoE (epUniTok $1), epUniTok $3)) $2)) }+        | '[||' exp '||]'     {% runPV (unECP $2) >>= \ $2 ->+                                 fmap ecpFromExp $+                                 amsA' (sLL $1 $> $ HsTypedBracket (if (hasE $1) then (BracketHasE (epTok $1),epTok $3) else (BracketNoE (epTok $1),epTok $3)) $2) }+        | '[t|' ktype '|]'    {% fmap ecpFromExp $+                                 amsA' (sLL $1 $> $ HsUntypedBracket noExtField (TypBr (epTok $1,epUniTok $3) $2)) }+        | '[p|' infixexp '|]' {% (checkPattern <=< runPV) (unECP $2) >>= \p ->+                                      fmap ecpFromExp $+                                      amsA' (sLL $1 $> $ HsUntypedBracket noExtField (PatBr (epTok $1,epUniTok $3) p)) }+        | '[d|' cvtopbody '|]' {% fmap ecpFromExp $+                                  amsA' (sLL $1 $> $ HsUntypedBracket noExtField (DecBrL (epTok $1,epUniTok $3, fst $2) (snd $2))) }+        | quasiquote          { ECP $ mkHsSplicePV $1 }++        -- arrow notation extension+        | '(|' aexp cmdargs '|)'  {% runPV (unECP $2) >>= \ $2 ->+                                      fmap ecpFromCmd $+                                      amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) [] noAnn []) $2 Prefix+                                                           (reverse $3)) }++projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) }+projection+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer+        : projection TIGHT_INFIX_PROJ field+                             { sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (AnnFieldLabel (Just $ epTok $2)) $3) `NE.cons` unLoc $1) }+        | PREFIX_PROJ field  { sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (AnnFieldLabel (Just $ epTok $1)) $2) :| [])}++splice_exp :: { LHsExpr GhcPs }+        : splice_untyped { fmap (HsUntypedSplice noExtField) (reLoc $1) }+        | splice_typed   { fmap (uncurry HsTypedSplice) (reLoc $1) }++splice_untyped :: { Located (HsUntypedSplice GhcPs) }+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        : PREFIX_DOLLAR aexp2   {% runPV (unECP $2) >>= \ $2 ->+                                   return (sLL $1 $> $ HsUntypedSpliceExpr (epTok $1) $2) }++splice_typed :: { Located (EpToken "$$", LHsExpr GhcPs) }+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        : PREFIX_DOLLAR_DOLLAR aexp2+                                {% runPV (unECP $2) >>= \ $2 ->+                                   return (sLL $1 $> $ (epTok $1, $2)) }++cmdargs :: { [LHsCmdTop GhcPs] }+        : cmdargs acmd                  { $2 : $1 }+        | {- empty -}                   { [] }++acmd    :: { LHsCmdTop GhcPs }+        : aexp                  {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) ->+                                   runPV (checkCmdBlockArguments cmd) >>= \ _ ->+                                   return (sL1a cmd $ HsCmdTop noExtField cmd) }++cvtopbody :: { ((EpToken "{", EpToken "}"),[LHsDecl GhcPs]) }+        :  '{'            cvtopdecls0 '}'      { ((epTok $1 ,epTok $3),$2) }+        |      vocurly    cvtopdecls0 close    { ((NoEpTok, NoEpTok),$2) }++cvtopdecls0 :: { [LHsDecl GhcPs] }+        : topdecls_semi         { cvTopDecls $1 }+        | topdecls              { cvTopDecls $1 }++-----------------------------------------------------------------------------+-- Tuple expressions++-- "texp" is short for tuple expressions:+-- things that can appear unparenthesized as long as they're+-- inside parens or delimited by commas+texp :: { ECP }+        : exp2               { $1 }++        -- Note [Parsing sections]+        -- ~~~~~~~~~~~~~~~~~~~~~~~+        -- We include left and right sections here, which isn't+        -- technically right according to the Haskell standard.+        -- For example (3 +, True) isn't legal.+        -- However, we want to parse bang patterns like+        --      (!x, !y)+        -- and it's convenient to do so here as a section+        -- Then when converting expr to pattern we unravel it again+        -- Meanwhile, the renamer checks that real sections appear+        -- inside parens.+        | infixexp qop+                             {% runPV (unECP $1) >>= \ $1 ->+                                runPV (rejectPragmaPV $1) >>+                                runPV $2 >>= \ $2 ->+                                return $ ecpFromExp $+                                sLLa $1 $> $ SectionL noExtField $1 (n2l $2) }+        | qopm infixexp      { ECP $+                                superInfixOp $+                                unECP $2 >>= \ $2 ->+                                $1 >>= \ $1 ->+                                mkHsSectionR_PV (comb2 $1 $>) (n2l $1) $2 }++orpats(EXP) :: { Located (NonEmpty (LPat GhcPs)) }+        -- See Note [%shift: orpats -> exp]+        : EXP %shift            {% do+                                    { pat <- (checkPattern <=< runPV) (unECP $1)+                                    ; return (sL1 pat (NE.singleton pat)) }}+        | EXP ';' orpats(EXP)   {% do+                                    { pat <- (checkPattern <=< runPV) (unECP $1)+                                    ; pat <- addTrailingSemiA pat (epTok $2)+                                    ; return (sLL pat $> (pat NE.<| unLoc $3)) }}++-- Always at least one comma or bar.+-- Though this can parse just commas (without any expressions), it won't+-- in practice, because (,,,) is parsed as a name. See Note [ExplicitTuple]+-- in GHC.Hs.Expr.+tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }+           : texp commas_tup_tail+                           { unECP $1 >>= \ $1 ->+                             $2 >>= \ $2 ->+                             do { t <- amsA $1 [AddCommaAnn (EpTok $ srcSpan2e $ fst $2)]+                                ; return (Tuple (Right t : snd $2)) } }+           | commas tup_tail+                 { $2 >>= \ $2 ->+                   do { let {cos = map (\ll -> (Left (EpAnn (spanAsAnchor ll) True emptyComments))) (fst $1) }+                      ; return (Tuple (cos ++ $2)) } }++           | texp bars   { unECP $1 >>= \ $1 -> return $+                            (Sum 1  (snd $2 + 1) $1 [] (fst $2)) }++           | bars texp bars0+                { unECP $2 >>= \ $2 -> return $+                  (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2 (fst $1) (fst $3)) }++-- Always starts with commas; always follows an expr+commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)]) }+commas_tup_tail : commas tup_tail+        { $2 >>= \ $2 ->+          do { let {cos = map (\l -> (Left (EpAnn (spanAsAnchor l) True emptyComments))) (tail $ fst $1) }+             ; return ((head $ fst $1, cos ++ $2)) } }++-- Always follows a comma+tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] }+          : texp commas_tup_tail { unECP $1 >>= \ $1 ->+                                   $2 >>= \ $2 ->+                                   do { t <- amsA $1 [AddCommaAnn (EpTok $ srcSpan2e $ fst $2)]+                                      ; return (Right t : snd $2) } }+          | texp                 { unECP $1 >>= \ $1 ->+                                   return [Right $1] }+          -- See Note [%shift: tup_tail -> {- empty -}]+          | {- empty -} %shift   { return [Left noAnn] }++-----------------------------------------------------------------------------+-- List expressions++-- The rules below are little bit contorted to keep lexps left-recursive while+-- avoiding another shift/reduce-conflict.+-- Never empty.+list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b) }+        : texp    { \loc (ao,ac) -> unECP $1 >>= \ $1 ->+                            mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) }+        | lexps   { \loc (ao,ac) -> $1 >>= \ $1 ->+                            mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) }+        | texp '..'  { \loc (ao,ac) -> unECP $1 >>= \ $1 ->+                                  amsA' (L loc $ ArithSeq  (AnnArithSeq (EpTok ao) Nothing (epTok $2) (EpTok ac)) Nothing (From $1))+                                      >>= ecpFromExp' }+        | texp ',' exp2 '..' { \loc (ao,ac) ->+                                   unECP $1 >>= \ $1 ->+                                   unECP $3 >>= \ $3 ->+                                   amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) (Just (epTok $2)) (epTok $4) (EpTok ac)) Nothing (FromThen $1 $3))+                                       >>= ecpFromExp' }+        | texp '..' exp2  { \loc (ao,ac) ->+                                   unECP $1 >>= \ $1 ->+                                   unECP $3 >>= \ $3 ->+                                   amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok $2) (EpTok ac)) Nothing (FromTo $1 $3))+                                       >>= ecpFromExp' }+        | texp ',' exp2 '..' exp2 { \loc (ao,ac) ->+                                   unECP $1 >>= \ $1 ->+                                   unECP $3 >>= \ $3 ->+                                   unECP $5 >>= \ $5 ->+                                   amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) (Just (epTok $2)) (epTok $4) (EpTok ac)) Nothing (FromThenTo $1 $3 $5))+                                       >>= ecpFromExp' }+        | texp '|' flattenedpquals+             { \loc (ao,ac) ->+                checkMonadComp >>= \ ctxt ->+                unECP $1 >>= \ $1 -> do { t <- addTrailingVbarA $1 (epTok $2)+                ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []))+                    >>= ecpFromExp' } }++lexps :: { forall b. DisambECP b => PV [LocatedA b] }+        : lexps ',' texp           { $1 >>= \ $1 ->+                                     unECP $3 >>= \ $3 ->+                                     case $1 of+                                       (h:t) -> do+                                         h' <- addTrailingCommaA h (epTok $2)+                                         return (((:) $! $3) $! (h':t)) }+        | texp ',' texp             { unECP $1 >>= \ $1 ->+                                      unECP $3 >>= \ $3 ->+                                      do { h <- addTrailingCommaA $1 (epTok $2)+                                         ; return [$3,h] }}++-----------------------------------------------------------------------------+-- List Comprehensions++flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }+    : pquals   { case (unLoc $1) of+                    [qs] -> sL1 $1 qs+                    -- We just had one thing in our "parallel" list so+                    -- we simply return that thing directly++                    qss -> sL1 $1 [sL1a $1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr |+                                            qs <- qss]+                                            noExpr noSyntaxExpr]+                    -- We actually found some actual parallel lists so+                    -- we wrap them into as a ParStmt+                }++pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }+    : squals '|' pquals+                     {% case unLoc $1 of+                          (h:t) -> do+                            h' <- addTrailingVbarA h (epTok $2)+                            return (sLL $1 $> (reverse (h':t) : unLoc $3)) }+    | squals         { L (getLoc $1) [reverse (unLoc $1)] }++squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, because the last+                                        -- one can "grab" the earlier ones+    : squals ',' transformqual+             {% case unLoc $1 of+                  (h:t) -> do+                    h' <- addTrailingCommaA h (epTok $2)+                    return (sLL $1 $> [sLLa $1 $> ((unLoc $3) (reverse (h':t)))]) }+    | squals ',' qual+             {% runPV $3 >>= \ $3 ->+                case unLoc $1 of+                  (h:t) -> do+                    h' <- addTrailingCommaA h (epTok $2)+                    return (sLL $1 $> ($3 : (h':t))) }+    | transformqual        { sLL $1 $> [L (getLocAnn $1) ((unLoc $1) [])] }+    | qual                               {% runPV $1 >>= \ $1 ->+                                            return $ sL1 $1 [$1] }+--  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }+--  | '{|' pquals '|}'                       { sL1 $1 [$2] }++-- It is possible to enable bracketing (associating) qualifier lists+-- by uncommenting the lines with {| |} above. Due to a lack of+-- consensus on the syntax, this feature is not being used until we+-- get user demand.++transformqual :: { Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }+                        -- Function is applied to a list of stmts *in order*+    : 'then' exp              {% runPV (unECP $2) >>= \ $2 ->+                                 return (+                                 sLL $1 $> (\ss -> (mkTransformStmt (AnnTransStmt (epTok $1) noAnn noAnn noAnn) ss $2))) }+    | 'then' exp 'by' exp     {% runPV (unECP $2) >>= \ $2 ->+                                 runPV (unECP $4) >>= \ $4 ->+                                 return (sLL $1 $> (\ss -> (mkTransformByStmt (AnnTransStmt (epTok $1) noAnn (Just (epTok $3)) noAnn) ss $2 $4))) }+    | 'then' 'group' 'using' exp+            {% runPV (unECP $4) >>= \ $4 ->+               return (sLL $1 $> (\ss -> (mkGroupUsingStmt (AnnTransStmt (epTok $1) (Just (epTok $2)) noAnn (Just (epTok $3))) ss $4))) }++    | 'then' 'group' 'by' exp 'using' exp+            {% runPV (unECP $4) >>= \ $4 ->+               runPV (unECP $6) >>= \ $6 ->+               return (sLL $1 $> (\ss -> (mkGroupByUsingStmt (AnnTransStmt (epTok $1) (Just (epTok $2)) (Just (epTok $3)) (Just (epTok $5))) ss $4 $6))) }++-- Note that 'group' is a special_id, which means that you can enable+-- TransformListComp while still using Data.List.group. However, this+-- introduces a shift/reduce conflict. Happy chooses to resolve the conflict+-- in by choosing the "group by" variant, which is what we want.++-----------------------------------------------------------------------------+-- Guards++guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }+    : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }++guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }+    : guardquals1 ',' qual  {% runPV $3 >>= \ $3 ->+                               case unLoc $1 of+                                 (h:t) -> do+                                   h' <- addTrailingCommaA h (epTok $2)+                                   return (sLL $1 $> ($3 : (h':t))) }+    | qual                  {% runPV $1 >>= \ $1 ->+                               return $ sL1 $1 [$1] }++-----------------------------------------------------------------------------+-- Case alternatives++altslist(PATS) :: { forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)]) }+        : '{'        alts(PATS) '}'    { $2 >>= \ $2 -> amsr+                                           (sLL $1 $> (reverse (snd $ unLoc $2)))+                                           (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2) noAnn []) }+        | vocurly    alts(PATS)  close { $2 >>= \ $2 -> amsr+                                           (L (getLoc $2) (reverse (snd $ unLoc $2)))+                                           (AnnList (Just $ glR $2) ListNone (fst $ unLoc $2) noAnn []) }+        | '{'              '}'   { amsr (sLL $1 $> []) (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) [] noAnn []) }+        | vocurly          close { return $ noLocA [] }++alts(PATS) :: { forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)])) }+        : alts1(PATS)              { $1 >>= \ $1 -> return $+                                     sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }+        | ';' alts(PATS)           { $2 >>= \ $2 -> return $+                                     sLL $1 $> (((mzEpTok $1) : (fst $ unLoc $2) )+                                               ,snd $ unLoc $2) }++alts1(PATS) :: { forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)])) }+        : alts1(PATS) ';' alt(PATS) { $1 >>= \ $1 ->+                                        $3 >>= \ $3 ->+                                          case snd $ unLoc $1 of+                                            [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ [mzEpTok $2]+                                                                            ,[$3]))+                                            (h:t) -> do+                                              h' <- addTrailingSemiA h (epTok $2)+                                              return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) }+        | alts1(PATS) ';'           {  $1 >>= \ $1 ->+                                         case snd $ unLoc $1 of+                                           [] -> return (sLZ $1 $> ((fst $ unLoc $1) ++ [mzEpTok $2]+                                                                           ,[]))+                                           (h:t) -> do+                                             h' <- addTrailingSemiA h (epTok $2)+                                             return (sLZ $1 $> (fst $ unLoc $1, h' : t)) }+        | alt(PATS)                 { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }++alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }+        : PATS alt_rhs { $2 >>= \ $2 ->+                         amsA' (sLLAsl $1 $>+                                         (Match { m_ext = noExtField+                                                , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing+                                                , m_pats = L (listLocation $1) $1+                                                , m_grhss = unLoc $2 }))}++alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) }+        : ralt wherebinds           { $1 >>= \alt ->+                                      do { let {L l (bs, csw) = adaptWhereBinds $2}+                                         ; acs (comb2 alt (L l bs)) (\loc cs -> L loc (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) }}++ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) }+        : '->' exp            { unECP $2 >>= \ $2 ->+                                acs (comb2 $1 $>) (\loc cs -> L loc (unguardedRHS (EpAnn (spanAsAnchor $ comb2 $1 $2) (GrhsAnn Nothing (Right $ epUniTok $1)) cs) (comb2 $1 $2) $2)) }+        | gdpats              { $1 >>= \gdpats ->+                                return $ sL1 gdpats (reverse (unLoc gdpats)) }++gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) }+        : gdpats gdpat { $1 >>= \gdpats ->+                         $2 >>= \gdpat ->+                         return $ sLL gdpats gdpat (gdpat : unLoc gdpats) }+        | gdpat        { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] }++-- layout for MultiWayIf doesn't begin with an open brace, because it's hard to+-- generate the open brace in addition to the vertical bar in the lexer, and+-- we don't need it.+ifgdpats :: { Located ((EpToken "{", EpToken "}"), [LGRHS GhcPs (LHsExpr GhcPs)]) }+         : '{' gdpats '}'                 {% runPV $2 >>= \ $2 ->+                                             return $ sLL $1 $> ((epTok $1,epTok $3),unLoc $2)  }+         |     gdpats close               {% runPV $1 >>= \ $1 ->+                                             return $ sL1 $1 ((NoEpTok, NoEpTok),unLoc $1) }++gdpat   :: { forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b)) }+        : '|' guardquals '->' exp+                                   { unECP $4 >>= \ $4 ->+                                     acsA (comb2 $1 $>) (\loc cs -> sL loc $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ epTok $1) (Right $ epUniTok $3)) cs) (unLoc $2) $4) }++-- 'pat' recognises a pattern, including one with a bang at the top+--      e.g.  "!x" or "!(x,y)" or "C a b" etc+-- Bangs inside are parsed as infix operator applications, so that+-- we parse them right when bang-patterns are off++pat_syn_pat :: { LPat GhcPs }+pat_syn_pat :  exp          {% (checkPattern <=< runPV) (unECP $1) }++pat     :: { LPat GhcPs }+pat     :  orpats(exp)      {% case unLoc $1 of+                                pat :| [] -> return pat+                                pats      -> hintOrPats (sL1a $1 (OrPat NoExtField pats)) }+++-- 'pats1' does the same thing as 'pat', but returns it as a singleton+-- list so that it can be used with a parameterized production rule+--+-- It is used only for parsing patterns in `\case` and `case of`+pats1   :: { [LPat GhcPs] }+pats1   : pat { [ $1 ] }++bindpat :: { LPat GhcPs }+bindpat :  exp            {% -- See Note [Parser-Validator Details] in GHC.Parser.PostProcess+                             checkPattern_details incompleteDoBlock+                                              (unECP $1) }++argpat   :: { LPat GhcPs }+argpat    : apat                  { $1 }+          | PREFIX_AT atype       { sLLa $1 $> (InvisPat (epTok $1, SpecifiedSpec) (mkHsTyPat $2)) }++argpats :: { [LPat GhcPs] }+          : argpat argpats            { $1 : $2 }+          | {- empty -}               { [] }+++apat   :: { LPat GhcPs }+apat    : aexp                  {% (checkPattern <=< runPV) (unECP $1) }++-----------------------------------------------------------------------------+-- Statement sequences++stmtlist :: { forall b. DisambECP b => PV (LocatedLW [LocatedA (Stmt GhcPs (LocatedA b))]) }+        : '{'           stmts '}'       { $2 >>= \ $2 ->+                                          amsr (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) noAnn []) }+        |     vocurly   stmts close     { $2 >>= \ $2 -> amsr+                                          (L (stmtsLoc $2) (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) ListNone (fromOL $ fst $ unLoc $2) noAnn []) }++--      do { ;; s ; s ; ; s ;; }+-- The last Stmt should be an expression, but that's hard to enforce+-- here, because we need too much lookahead if we see do { e ; }+-- So we use BodyStmts throughout, and switch the last one over+-- in ParseUtils.checkDo instead++stmts :: { forall b. DisambECP b => PV (Located (OrdList (EpToken ";"),[LStmt GhcPs (LocatedA b)])) }+        : stmts ';' stmt  { $1 >>= \ $1 ->+                            $3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) ->+                            case (snd $ unLoc $1) of+                              [] -> return (sLL $1 $> ( (fst $ unLoc $1) `snocOL` (epTok $2)+                                                      , $3 : (snd $ unLoc $1)))+                              (h:t) -> do+                               { h' <- addTrailingSemiA h (epTok $2)+                               ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(h':t)) }}++        | stmts ';'     {  $1 >>= \ $1 ->+                           case (snd $ unLoc $1) of+                             [] -> return (sLZ $1 $> ((fst $ unLoc $1) `snocOL` (epTok $2),snd $ unLoc $1))+                             (h:t) -> do+                               { h' <- addTrailingSemiA h (epTok $2)+                               ; return $ sLZ $1 $> (fst $ unLoc $1,h':t) }}+        | stmt                   { $1 >>= \ $1 ->+                                   return $ sL1 $1 (nilOL,[$1]) }+        | {- empty -}            { return $ noLoc (nilOL,[]) }+++-- For typing stmts at the GHCi prompt, where+-- the input may consist of just comments.+maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }+        : stmt                          {% fmap Just (runPV $1) }+        | {- nothing -}                 { Nothing }++-- For GHC API.+e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }+        : stmt                          {% runPV $1 }++stmt  :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }+        : qual                          { $1 }+        | 'rec' stmtlist                {  $2 >>= \ $2 ->+                                           amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) $2) $2) }++qual  :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }+    : bindpat '<-' exp                   { unECP $3 >>= \ $3 ->+                                           amsA' (sLL $1 $> $ mkPsBindStmt (epUniTok $2) $1 $3) }+    | exp                                { unECP $1 >>= \ $1 ->+                                           return $ sL1a $1 $ mkBodyStmt $1 }+    | 'let' binds                        { amsA' (sLL $1 $> $ mkLetStmt (epTok $1) (unLoc $2)) }++-----------------------------------------------------------------------------+-- Record Field Update/Construction++fbinds  :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) }+        : fbinds1                       { $1 }+        | {- empty -}                   { return ([], Nothing) }++fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) }+        : fbind ',' fbinds1+                 { $1 >>= \ $1 ->+                   $3 >>= \ $3 -> do+                   h <- addTrailingCommaFBind $1 (epTok $2)+                   return (case $3 of (flds, dd) -> (h : flds, dd)) }+        | fbind                         { $1 >>= \ $1 ->+                                          return ([$1], Nothing) }+        | '..'                          { return ([],   Just (getLoc $1)) }++fbind   :: { forall b. DisambECP b => PV (Fbind b) }+        : qvar '=' texp  { unECP $3 >>= \ $3 ->+                           fmap Left $ amsA' (sLL $1 $> $ HsFieldBind (Just (epTok $2)) (sL1a $1 $ mkFieldOcc $1) $3 False) }+                        -- RHS is a 'texp', allowing view patterns (#6038)+                        -- and, incidentally, sections.  Eg+                        -- f (R { x = show -> s }) = ...++        | qvar          { placeHolderPunRhs >>= \rhs ->+                          fmap Left $ amsA' (sL1 $1 $ HsFieldBind Nothing (sL1a $1 $ mkFieldOcc $1) rhs True) }+                        -- In the punning case, use a place-holder+                        -- The renamer fills in the final value++        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        -- AZ: need to pull out the let block into a helper+        | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp+                        { do+                            let top = sL1a $1 $ DotFieldOcc noAnn $1+                                ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)+                                lf' = comb2 $2 (L lf ())+                                fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ epTok $2))  f) : t+                                final = last fields+                                l = comb2 $1 $3+                                isPun = False+                            $5 <- unECP $5+                            fmap Right $ mkHsProjUpdatePV (comb2 $1 $5) (L l fields) $5 isPun+                                            (Just (epTok $4))+                        }++        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer+        -- AZ: need to pull out the let block into a helper+        | field TIGHT_INFIX_PROJ fieldToUpdate+                        { do+                            let top =  sL1a $1 $ DotFieldOcc noAnn $1+                                ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)+                                lf' = comb2 $2 (L lf ())+                                fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ epTok $2)) f) : t+                                final = last fields+                                l = comb2 $1 $3+                                isPun = True+                            var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final))+                            fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun Nothing+                        }++fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] }+fieldToUpdate+        -- See Note [Whitespace-sensitive operator parsing] in Lexer.x+        : fieldToUpdate TIGHT_INFIX_PROJ field   { sLL $1 $> ((sLLa $2 $> (DotFieldOcc (AnnFieldLabel $ Just $ epTok $2) $3)) : unLoc $1) }+        | field       { sL1 $1 [sL1a $1 (DotFieldOcc (AnnFieldLabel Nothing) $1)] }++-----------------------------------------------------------------------------+-- Implicit Parameter Bindings++dbinds  :: { Located [LIPBind GhcPs] } -- reversed+        : dbinds ';' dbind+                      {% case unLoc $1 of+                           (h:t) -> do+                             h' <- addTrailingSemiA h (epTok $2)+                             return (let { this = $3; rest = h':t }+                                in rest `seq` this `seq` sLL $1 $> (this : rest)) }+        | dbinds ';'  {% case unLoc $1 of+                           (h:t) -> do+                             h' <- addTrailingSemiA h (epTok $2)+                             return (sLZ $1 $> (h':t)) }+        | dbind                        { let this = $1 in this `seq` (sL1 $1 [this]) }+--      | {- empty -}                  { [] }++dbind   :: { LIPBind GhcPs }+dbind   : ipvar '=' exp                {% runPV (unECP $3) >>= \ $3 ->+                                          amsA' (sLL $1 $> (IPBind (epTok $2) (reLoc $1) $3)) }++ipvar   :: { Located HsIPName }+        : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }++-----------------------------------------------------------------------------+-- Overloaded labels++overloaded_label :: { Located (SourceText, FastString) }+        : LABELVARID          { sL1 $1 (getLABELVARIDs $1, getLABELVARID $1) }++-----------------------------------------------------------------------------+-- Warnings and deprecations++name_boolformula_opt :: { LBooleanFormula (LocatedN RdrName) }+        : name_boolformula          { $1 }+        | {- empty -}               { noLocA mkTrue }++name_boolformula :: { LBooleanFormula (LocatedN RdrName) }+        : name_boolformula_and                      { $1 }+        | name_boolformula_and '|' name_boolformula+                           {% do { h <- addTrailingVbarL $1 (epTok $2)+                                 ; return (sLLa $1 $> (Or [h,$3])) } }++name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) }+        : name_boolformula_and_list+                  { sLLa (head $1) (last $1) (And ($1)) }++name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] }+        : name_boolformula_atom                               { [$1] }+        | name_boolformula_atom ',' name_boolformula_and_list+            {% do { h <- addTrailingCommaL $1 (epTok $2)+                  ; return (h : $3) } }++name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) }+        : '(' name_boolformula ')'  {% amsr (sLL $1 $> (Parens $2))+                                      (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] noAnn []) }+        | name_var                  { sL1a $1 (Var $1) }++namelist :: { Located [LocatedN RdrName] }+namelist : name_var              { sL1 $1 [$1] }+         | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2)+                                       ; return (sLL $1 $> (h : unLoc $3)) }}++name_var :: { LocatedN RdrName }+name_var : var { $1 }+         | con { $1 }++-----------------------------------------+-- Data constructors+-- There are two different productions here as lifted list constructors+-- are parsed differently.++qcon :: { LocatedN RdrName }+  : gen_qcon              { $1 }+  | syscon                { $1 }++gen_qcon :: { LocatedN RdrName }+  : qconid                { $1 }+  | '(' qconsym ')'       {% amsr (sLL $1 $> (unLoc $2))+                                  (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }++con     :: { LocatedN RdrName }+        : conid                 { $1 }+        | '(' consym ')'        {% amsr (sLL $1 $> (unLoc $2))+                                        (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }+        | syscon                { $1 }++con_list :: { Located (NonEmpty (LocatedN RdrName)) }+con_list : con                  { sL1 $1 (pure $1) }+         | con ',' con_list     {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) }++qcon_list :: { [LocatedN RdrName] }+qcon_list : qcon                  { [$1] }+          | qcon ',' qcon_list    {% do { h <- addTrailingCommaN $1 (gl $2)+                                        ; return (h : $3) }}++-- See Note [ExplicitTuple] in GHC.Hs.Expr+sysdcon_nolist :: { LocatedN DataCon }  -- Wired in data constructors+        : '(' commas ')'        {% amsr (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))+                                       (NameAnnCommas (NameParens (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }+        | '(#' '#)'             {% amsr (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly (NameParensHash (epTok $1) (epTok $2)) []) }+        | '(#' commas '#)'      {% amsr (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))+                                       (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }++syscon :: { LocatedN RdrName }+        : sysdcon               {  L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) }+        | '(' '->' ')'          {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)+                                        (NameAnnRArrow  (Just $ epTok $1) (epUniTok $2) (Just $ epTok $3) []) }++-- See Note [Empty lists] in GHC.Hs.Expr+sysdcon :: { LocatedN DataCon }+        : sysdcon_nolist                 { $1 }+        | '(' ')'               {% amsr (sLL $1 $> unitDataCon) (NameAnnOnly (NameParens (epTok $1) (epTok $2)) []) }+        | '[' ']'               {% amsr (sLL $1 $> nilDataCon)  (NameAnnOnly (NameSquare (epTok $1) (epTok $2)) []) }++conop :: { LocatedN RdrName }+        : consym                { $1 }+        | '`' conid '`'         {% amsr (sLL $1 $> (unLoc $2))+                                          (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++qconop :: { LocatedN RdrName }+        : qconsym               { $1 }+        | '`' qconid '`'        {% amsr (sLL $1 $> (unLoc $2))+                                          (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++----------------------------------------------------------------------------+-- Type constructors+++-- See Note [Unit tuples] in GHC.Hs.Type for the distinction+-- between gtycon and ntgtycon+gtycon :: { LocatedN RdrName }  -- A "general" qualified tycon, including unit tuples+        : ntgtycon                     { $1 }+        | '(' ')'                      {% amsr (sLL $1 $> $ getRdrName unitTyCon)+                                                (NameAnnOnly (NameParens (epTok $1) (epTok $2)) []) }+        | '(#' '#)'                    {% amsr (sLL $1 $> $ getRdrName unboxedUnitTyCon)+                                                (NameAnnOnly (NameParensHash (epTok $1) (epTok $2)) []) }+        | '[' ']'               {% amsr (sLL $1 $> $ listTyCon_RDR)+                                      (NameAnnOnly (NameSquare (epTok $1) (epTok $2)) []) }++ntgtycon :: { LocatedN RdrName }  -- A "general" qualified tycon, excluding unit tuples+        : oqtycon               { $1 }+        | '(' commas ')'        {% do { n <- mkTupleSyntaxTycon Boxed (snd $2 + 1)+                                      ; amsr (sLL $1 $> n) (NameAnnCommas (NameParens (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }}+        | '(#' commas '#)'      {% do { n <- mkTupleSyntaxTycon Unboxed (snd $2 + 1)+                                      ; amsr (sLL $1 $> n) (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }}+        | '(#' bars '#)'        {% do { requireLTPuns PEP_SumSyntaxType $1 $>+                                      ; amsr (sLL $1 $> $ (getRdrName (sumTyCon (snd $2 + 1))))+                                       (NameAnnBars (epTok $1, epTok $3) (fst $2) []) } }+        | '(' '->' ')'          {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)+                                       (NameAnnRArrow  (Just $ epTok $1) (epUniTok $2) (Just $ epTok $3) []) }++oqtycon :: { LocatedN RdrName }  -- An "ordinary" qualified tycon;+                                -- These can appear in export lists+        : qtycon                        { $1 }+        | '(' qtyconsym ')'             {% amsr (sLL $1 $> (unLoc $2))+                                                  (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }++oqtycon_no_varcon :: { LocatedN RdrName }  -- Type constructor which cannot be mistaken+                                          -- for variable constructor in export lists+                                          -- see Note [Type constructors in export list]+        :  qtycon            { $1 }+        | '(' QCONSYM ')'    {% let { name :: Located RdrName+                                    ; name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2) }+                                in amsr (sLL $1 $> (unLoc name)) (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }+        | '(' CONSYM ')'     {% let { name :: Located RdrName+                                    ; name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2) }+                                in amsr (sLL $1 $> (unLoc name)) (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }+        | '(' ':' ')'        {% let { name :: Located RdrName+                                    ; name = sL1 $2 $! consDataCon_RDR }+                                in amsr (sLL $1 $> (unLoc name)) (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }++{- Note [Type constructors in export list]+~~~~~~~~~~~~~~~~~~~~~+Mixing type constructors and data constructors in export lists introduces+ambiguity in grammar: e.g. (*) may be both a type constructor and a function.++-XExplicitNamespaces allows to disambiguate by explicitly prefixing type+constructors with 'type' keyword.++This ambiguity causes reduce/reduce conflicts in parser, which are always+resolved in favour of data constructors. To get rid of conflicts we demand+that ambiguous type constructors (those, which are formed by the same+productions as variable constructors) are always prefixed with 'type' keyword.+Unambiguous type constructors may occur both with or without 'type' keyword.++Note that in the parser we still parse data constructors as type+constructors. As such, they still end up in the type constructor namespace+until after renaming when we resolve the proper namespace for each exported+child.+-}++qtyconop :: { LocatedN RdrName } -- Qualified or unqualified+        -- See Note [%shift: qtyconop -> qtyconsym]+        : qtyconsym %shift              { $1 }+        | '`' qtycon '`'                {% amsr (sLL $1 $> (unLoc $2))+                                                (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++qtycon :: { LocatedN RdrName }   -- Qualified or unqualified+        : QCONID            { sL1n $1 $! mkQual tcClsName (getQCONID $1) }+        | tycon             { $1 }++tycon   :: { LocatedN RdrName }  -- Unqualified+        : CONID                   { sL1n $1 $! mkUnqual tcClsName (getCONID $1) }++qtyconsym :: { LocatedN RdrName }+        : QCONSYM            { sL1n $1 $! mkQual tcClsName (getQCONSYM $1) }+        | QVARSYM            { sL1n $1 $! mkQual tcClsName (getQVARSYM $1) }+        | tyconsym           { $1 }++tyconsym :: { LocatedN RdrName }+        : CONSYM                { sL1n $1 $! mkUnqual tcClsName (getCONSYM $1) }+        | VARSYM                { sL1n $1 $! mkUnqual tcClsName (getVARSYM $1) }+        | ':'                   { sL1n $1 $! consDataCon_RDR }+        | '-'                   { sL1n $1 $! mkUnqual tcClsName (fsLit "-") }+        | '.'                   { sL1n $1 $! mkUnqual tcClsName (fsLit ".") }++-- An "ordinary" unqualified tycon. See `oqtycon` for the qualified version.+-- These can appear in `ANN type` declarations (#19374).+otycon :: { LocatedN RdrName }+        : tycon                 { $1 }+        | '(' tyconsym ')'      {% amsr (sLL $1 $> (unLoc $2))+                                        (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }++-----------------------------------------------------------------------------+-- Operators++op      :: { LocatedN RdrName }   -- used in infix decls+        : varop                 { $1 }+        | conop                 { $1 }+        | '->'                  {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)+                                     (NameAnnRArrow  Nothing (epUniTok $1) Nothing []) }++varop   :: { LocatedN RdrName }+        : varsym                { $1 }+        | '`' varid '`'         {% amsr (sLL $1 $> (unLoc $2))+                                           (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++qop     :: { forall b. DisambInfixOp b => PV (LocatedN b) }   -- used in sections+        : qvarop                { mkHsVarOpPV $1 }+        | qconop                { mkHsConOpPV $1 }+        | hole_op               { mkHsInfixHolePV $1 }++qopm    :: { forall b. DisambInfixOp b => PV (LocatedN b) }   -- used in sections+        : qvaropm               { mkHsVarOpPV $1 }+        | qconop                { mkHsConOpPV $1 }+        | hole_op               { mkHsInfixHolePV $1 }++hole_op :: { LocatedN (HsExpr GhcPs) }   -- used in sections+hole_op : '`' '_' '`'           { sLLa $1 $> (hsHoleExpr (Just $ EpAnnUnboundVar (epTok $1, epTok $3) (epTok $2))) }++qvarop :: { LocatedN RdrName }+        : qvarsym               { $1 }+        | '`' qvarid '`'        {% amsr (sLL $1 $> (unLoc $2))+                                           (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++qvaropm :: { LocatedN RdrName }+        : qvarsym_no_minus      { $1 }+        | '`' qvarid '`'        {% amsr (sLL $1 $> (unLoc $2))+                                           (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++-----------------------------------------------------------------------------+-- Type variables++tyvar   :: { LocatedN RdrName }+tyvar   : tyvarid               { $1 }++tyvarop :: { LocatedN RdrName }+tyvarop : '`' tyvarid '`'       {% amsr (sLL $1 $> (unLoc $2))+                                           (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) }++tyvarid :: { LocatedN RdrName }+        : VARID            { sL1n $1 $! mkUnqual tvName (getVARID $1) }+        | special_id       { sL1n $1 $! mkUnqual tvName (unLoc $1) }+        | 'unsafe'         { sL1n $1 $! mkUnqual tvName (fsLit "unsafe") }+        | 'safe'           { sL1n $1 $! mkUnqual tvName (fsLit "safe") }+        | 'interruptible'  { sL1n $1 $! mkUnqual tvName (fsLit "interruptible") }+        -- If this changes relative to varid, update 'checkRuleTyVarBndrNames'+        -- in GHC.Parser.PostProcess+        -- See Note [Parsing explicit foralls in Rules]++-----------------------------------------------------------------------------+-- Variables++var     :: { LocatedN RdrName }+        : varid                 { $1 }+        | '(' varsym ')'        {% amsr (sLL $1 $> (unLoc $2))+                                   (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }++qvar    :: { LocatedN RdrName }+        : qvarid                { $1 }+        | '(' varsym ')'        {% amsr (sLL $1 $> (unLoc $2))+                                   (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }+        | '(' qvarsym1 ')'      {% amsr (sLL $1 $> (unLoc $2))+                                   (NameAnn (NameParens (epTok $1) (epTok $3)) (glR $2) []) }+-- We've inlined qvarsym here so that the decision about+-- whether it's a qvar or a var can be postponed until+-- *after* we see the close paren.++field :: { LocatedN FieldLabelString  }+      : varid { fmap (FieldLabelString . occNameFS . rdrNameOcc) $1 }++qvarid :: { LocatedN RdrName }+        : varid               { $1 }+        | QVARID              { sL1n $1 $! mkQual varName (getQVARID $1) }++-- Note that 'role' and 'family' get lexed separately regardless of+-- the use of extensions. However, because they are listed here,+-- this is OK and they can be used as normal varids.+-- See Note [Lexing type pseudo-keywords] in GHC.Parser.Lexer+varid :: { LocatedN RdrName }+        : VARID            { sL1n $1 $! mkUnqual varName (getVARID $1) }+        | special_id       { sL1n $1 $! mkUnqual varName (unLoc $1) }+        | 'unsafe'         { sL1n $1 $! mkUnqual varName (fsLit "unsafe") }+        | 'safe'           { sL1n $1 $! mkUnqual varName (fsLit "safe") }+        | 'interruptible'  { sL1n $1 $! mkUnqual varName (fsLit "interruptible")}+        | 'family'         { sL1n $1 $! mkUnqual varName (fsLit "family") }+        | 'role'           { sL1n $1 $! mkUnqual varName (fsLit "role") }+        -- If this changes relative to tyvarid, update 'checkRuleTyVarBndrNames'+        -- in GHC.Parser.PostProcess+        -- See Note [Parsing explicit foralls in Rules]++qvarsym :: { LocatedN RdrName }+        : varsym                { $1 }+        | qvarsym1              { $1 }++qvarsym_no_minus :: { LocatedN RdrName }+        : varsym_no_minus       { $1 }+        | qvarsym1              { $1 }++qvarsym1 :: { LocatedN RdrName }+qvarsym1 : QVARSYM              { sL1n $1 $ mkQual varName (getQVARSYM $1) }++varsym :: { LocatedN RdrName }+        : varsym_no_minus       { $1 }+        | '-'                   { sL1n $1 $ mkUnqual varName (fsLit "-") }++varsym_no_minus :: { LocatedN RdrName } -- varsym not including '-'+        : VARSYM               { sL1n $1 $ mkUnqual varName (getVARSYM $1) }+        | special_sym          { sL1n $1 $ mkUnqual varName (unLoc $1) }+++-- These special_ids are treated as keywords in various places,+-- but as ordinary ids elsewhere.   'special_id' collects all these+-- except 'unsafe', 'interruptible', 'forall', 'family', 'role', 'stock', and+-- 'anyclass', whose treatment differs depending on context+special_id :: { Located FastString }+special_id+        : 'as'                  { sL1 $1 (fsLit "as") }+        | 'qualified'           { sL1 $1 (fsLit "qualified") }+        | 'hiding'              { sL1 $1 (fsLit "hiding") }+        | 'export'              { sL1 $1 (fsLit "export") }+        | 'label'               { sL1 $1 (fsLit "label")  }+        | 'dynamic'             { sL1 $1 (fsLit "dynamic") }+        | 'stdcall'             { sL1 $1 (fsLit "stdcall") }+        | 'ccall'               { sL1 $1 (fsLit "ccall") }+        | 'capi'                { sL1 $1 (fsLit "capi") }+        | 'prim'                { sL1 $1 (fsLit "prim") }+        | 'javascript'          { sL1 $1 (fsLit "javascript") }+        -- See Note [%shift: special_id -> 'group']+        | 'group' %shift        { sL1 $1 (fsLit "group") }+        | 'stock'               { sL1 $1 (fsLit "stock") }+        | 'anyclass'            { sL1 $1 (fsLit "anyclass") }+        | 'via'                 { sL1 $1 (fsLit "via") }+        | 'unit'                { sL1 $1 (fsLit "unit") }+        | 'dependency'          { sL1 $1 (fsLit "dependency") }+        | 'signature'           { sL1 $1 (fsLit "signature") }++special_sym :: { Located FastString }+special_sym : '.'       { sL1 $1 (fsLit ".") }+            | '*'       { sL1 $1 (starSym (isUnicode $1)) }++-----------------------------------------------------------------------------+-- Data constructors++qconid :: { LocatedN RdrName }   -- Qualified or unqualified+        : conid              { $1 }+        | QCONID             { sL1n $1 $! mkQual dataName (getQCONID $1) }++conid   :: { LocatedN RdrName }+        : CONID                { sL1n $1 $ mkUnqual dataName (getCONID $1) }++qconsym :: { LocatedN RdrName }  -- Qualified or unqualified+        : consym               { $1 }+        | QCONSYM              { sL1n $1 $ mkQual dataName (getQCONSYM $1) }++consym :: { LocatedN RdrName }+        : CONSYM              { sL1n $1 $ mkUnqual dataName (getCONSYM $1) }++        -- ':' means only list cons+        | ':'                { sL1n $1 $ consDataCon_RDR }+++-----------------------------------------------------------------------------+-- Literals++literal :: { Located (HsLit GhcPs) }+        : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }+        | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)+                                                    $ getSTRING $1 }+        | STRING_MULTI      { sL1 $1 $ HsMultilineString (getSTRINGMULTIs $1)+                                                    $ getSTRINGMULTI $1 }+        | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)+                                                    $ getPRIMINTEGER $1 }+        | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)+                                                    $ getPRIMWORD $1 }+        | PRIMINTEGER8      { sL1 $1 $ HsInt8Prim   (getPRIMINTEGER8s $1)+                                                    $ getPRIMINTEGER8 $1 }+        | PRIMINTEGER16     { sL1 $1 $ HsInt16Prim  (getPRIMINTEGER16s $1)+                                                    $ getPRIMINTEGER16 $1 }+        | PRIMINTEGER32     { sL1 $1 $ HsInt32Prim  (getPRIMINTEGER32s $1)+                                                    $ getPRIMINTEGER32 $1 }+        | PRIMINTEGER64     { sL1 $1 $ HsInt64Prim  (getPRIMINTEGER64s $1)+                                                    $ getPRIMINTEGER64 $1 }+        | PRIMWORD8         { sL1 $1 $ HsWord8Prim  (getPRIMWORD8s $1)+                                                    $ getPRIMWORD8 $1 }+        | PRIMWORD16        { sL1 $1 $ HsWord16Prim (getPRIMWORD16s $1)+                                                    $ getPRIMWORD16 $1 }+        | PRIMWORD32        { sL1 $1 $ HsWord32Prim (getPRIMWORD32s $1)+                                                    $ getPRIMWORD32 $1 }+        | PRIMWORD64        { sL1 $1 $ HsWord64Prim (getPRIMWORD64s $1)+                                                    $ getPRIMWORD64 $1 }+        | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)+                                                    $ getPRIMCHAR $1 }+        | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)+                                                    $ getPRIMSTRING $1 }+        | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  noExtField $ getPRIMFLOAT $1 }+        | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim noExtField $ getPRIMDOUBLE $1 }++-----------------------------------------------------------------------------+-- Layout++{- Note [Layout and error]+~~~~~~~~~~~~~~~~~~~~~~~~~~+The Haskell 2010 report (Section 10.3, Note 5) dictates the use of the error+token in `close`. To recall why that is necessary, consider++  f x = case x of+    True -> False+    where y = x+1++The virtual pass L inserts vocurly, semi, vccurly to return a laid-out+token stream. It must insert a vccurly before `where` to close the layout+block introduced by `of`.+But there is no good way to do so other than L becoming aware of the grammar!+Thus, L is specified to detect the ensuing parse error (implemented via+happy's `error` token) and then insert the vccurly.+Thus in effect, L is distributed between Lexer.x and Parser.y.++There are a bunch of other, less "tricky" examples:++  let x = x {- vccurly -} in x   -- could just track bracketing of+                                 -- let..in on layout stack to fix+  (case x of+   True -> False {- vccurly -})  -- ditto for surrounding delimiters such as ()++  data T = T;{- vccurly -}       -- Need insert vccurly at EOF++Many of these are not that hard to fix, but still tedious and prone to break+when the grammar changes; but the `of`/`where` example is especially gnarly,+because it demonstrates a grammatical interaction between two lexically+unrelated tokens.+-}+close :: { () }+        : vccurly               { () } -- context popped in lexer.+        | error                 {% popContext } -- See Note [Layout and error]++-----------------------------------------------------------------------------+-- Miscellaneous (mostly renamings)++modid   :: { LocatedA ModuleName }+        : CONID                 { sL1a $1 $ mkModuleNameFS (getCONID $1) }+        | QCONID                { sL1a $1 $ let (mod,c) = getQCONID $1 in+                                  mkModuleNameFS+                                   (concatFS [mod, fsLit ".", c])+                                }++commas :: { ([SrcSpan],Int) }   -- One or more commas+        : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }+        | ','                    { ([gl $1],1) }++bars0 :: { ([EpToken "|"],Int) }     -- Zero or more bars+        : bars                   { $1 }+        |                        { ([], 0) }++bars :: { ([EpToken "|"],Int) }     -- One or more bars+        : bars '|'               { ((fst $1)++[epTok $2],snd $1 + 1) }+        | '|'                    { ([epTok $1],1) }++{+happyError :: P a+happyError = srcParseFail++getVARID          (L _ (ITvarid    x)) = x+getCONID          (L _ (ITconid    x)) = x+getVARSYM         (L _ (ITvarsym   x)) = x+getCONSYM         (L _ (ITconsym   x)) = x+getDO             (L _ (ITdo      x)) = x+getMDO            (L _ (ITmdo     x)) = x+getQVARID         (L _ (ITqvarid   x)) = x+getQCONID         (L _ (ITqconid   x)) = x+getQVARSYM        (L _ (ITqvarsym  x)) = x+getQCONSYM        (L _ (ITqconsym  x)) = x+getIPDUPVARID     (L _ (ITdupipvarid   x)) = x+getLABELVARID     (L _ (ITlabelvarid _ x)) = x+getCHAR           (L _ (ITchar   _ x)) = x+getSTRING         (L _ (ITstring _ x)) = x+getSTRINGMULTI    (L _ (ITstringMulti _ x)) = x+getINTEGER        (L _ (ITinteger x))  = x+getRATIONAL       (L _ (ITrational x)) = x+getPRIMCHAR       (L _ (ITprimchar _ x)) = x+getPRIMSTRING     (L _ (ITprimstring _ x)) = x+getPRIMINTEGER    (L _ (ITprimint  _ x)) = x+getPRIMWORD       (L _ (ITprimword _ x)) = x+getPRIMINTEGER8   (L _ (ITprimint8 _ x)) = x+getPRIMINTEGER16  (L _ (ITprimint16 _ x)) = x+getPRIMINTEGER32  (L _ (ITprimint32 _ x)) = x+getPRIMINTEGER64  (L _ (ITprimint64 _ x)) = x+getPRIMWORD8      (L _ (ITprimword8 _ x)) = x+getPRIMWORD16     (L _ (ITprimword16 _ x)) = x+getPRIMWORD32     (L _ (ITprimword32 _ x)) = x+getPRIMWORD64     (L _ (ITprimword64 _ x)) = x+getPRIMFLOAT      (L _ (ITprimfloat x)) = x+getPRIMDOUBLE     (L _ (ITprimdouble x)) = x+getINLINE         (L _ (ITinline_prag _ inl conl)) = (inl,conl)+getSPEC_INLINE    (L _ (ITspec_inline_prag src True))  = (Inline src,FunLike)+getSPEC_INLINE    (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike)+getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x+getVOCURLY        (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l++getINTEGERs       (L _ (ITinteger (IL src _ _))) = src+getCHARs          (L _ (ITchar       src _)) = src+getSTRINGs        (L _ (ITstring     src _)) = src+getSTRINGMULTIs   (L _ (ITstringMulti src _)) = src+getPRIMCHARs      (L _ (ITprimchar   src _)) = src+getPRIMSTRINGs    (L _ (ITprimstring src _)) = src+getPRIMINTEGERs   (L _ (ITprimint    src _)) = src+getPRIMWORDs      (L _ (ITprimword   src _)) = src+getPRIMINTEGER8s  (L _ (ITprimint8   src _)) = src+getPRIMINTEGER16s (L _ (ITprimint16  src _)) = src+getPRIMINTEGER32s (L _ (ITprimint32  src _)) = src+getPRIMINTEGER64s (L _ (ITprimint64  src _)) = src+getPRIMWORD8s     (L _ (ITprimword8  src _)) = src+getPRIMWORD16s    (L _ (ITprimword16 src _)) = src+getPRIMWORD32s    (L _ (ITprimword32 src _)) = src+getPRIMWORD64s    (L _ (ITprimword64 src _)) = src++getLABELVARIDs    (L _ (ITlabelvarid src _)) = src++-- See Note [Pragma source text] in "GHC.Types.SourceText" for the following+getINLINE_PRAGs       (L _ (ITinline_prag       _ inl _)) = inlineSpecSource inl+getOPAQUE_PRAGs       (L _ (ITopaque_prag       src))     = src+getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src+getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src+getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src+getRULES_PRAGs        (L _ (ITrules_prag        src)) = src+getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src+getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src+getSCC_PRAGs          (L _ (ITscc_prag          src)) = src+getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src+getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src+getANN_PRAGs          (L _ (ITann_prag          src)) = src+getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src+getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src+getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src+getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src+getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src+getCTYPEs             (L _ (ITctype             src)) = src++getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l) Nothing++isUnicode :: Located Token -> Bool+isUnicode (L _ (ITforall         iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITdarrow         iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITdcolon         iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITlarrow         iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITrarrow         iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITlarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITrarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITLarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITRarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (L _ (IToparenbar      iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITcparenbar      iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITcloseQuote     iu)) = iu == UnicodeSyntax+isUnicode (L _ (ITstar           iu)) = iu == UnicodeSyntax+isUnicode (L _ ITlolly)               = True+isUnicode _                           = False++hasE :: Located Token -> Bool+hasE (L _ (ITopenExpQuote HasE _)) = True+hasE (L _ (ITopenTExpQuote HasE))  = True+hasE _                             = False++getSCC :: Located Token -> P FastString+getSCC lt = do let s = getSTRING lt+               -- We probably actually want to be more restrictive than this+               if ' ' `elem` unpackFS s+                   then addFatalError $ mkPlainErrorMsgEnvelope (getLoc lt) $ PsErrSpaceInSCC+                   else return s++stringLiteralToHsDocWst :: Located StringLiteral -> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)+stringLiteralToHsDocWst  sl = reLoc $ lexStringLiteral parseIdentifier sl++-- Utilities for combining source spans+comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan+comb2 !a !b = combineHasLocs a b++comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan+comb3 !a !b !c = combineSrcSpans (getHasLoc a) (combineHasLocs b c)++comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan+comb4 !a !b !c !d =+    combineSrcSpans (getHasLoc a) $+    combineSrcSpans (getHasLoc b) $+    combineSrcSpans (getHasLoc c) (getHasLoc d)++comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan+comb5 !a !b !c !d !e =+    combineSrcSpans (getHasLoc a) $+    combineSrcSpans (getHasLoc b) $+    combineSrcSpans (getHasLoc c) $+    combineSrcSpans (getHasLoc d) (getHasLoc e)++-- strict constructor version:+{-# INLINE sL #-}+sL :: l -> a -> GenLocated l a+sL !loc !a = L loc a++-- See Note [Adding location info] for how these utility functions are used++-- replaced last 3 CPP macros in this file+{-# INLINE sL0 #-}+sL0 :: a -> Located a+sL0 = L noSrcSpan       -- #define L0   L noSrcSpan++{-# INLINE sL1 #-}+sL1 :: HasLoc a => a -> b -> Located b+sL1 !x = sL (getHasLoc x)   -- #define sL1   sL (getLoc $1)++{-# INLINE sL1a #-}+sL1a :: (HasLoc a, HasAnnotation t) =>  a -> b -> GenLocated t b+sL1a !x = sL (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)++{-# INLINE sL1n #-}+sL1n :: HasLoc a => a -> b -> LocatedN b+sL1n !x = L (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)++{-# INLINE sLL #-}+sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c+sLL !x !y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)++{-# INLINE sLLa #-}+sLLa :: (HasLoc a, HasLoc b, NoAnn t) => a -> b -> c -> LocatedAn t c+sLLa !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)++{-# INLINE sLLl #-}+sLLl :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedL c+sLLl !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)++{-# INLINE sLLld #-}+sLLld :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedLW c+sLLld !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)++{-# INLINE sLLAsl #-}+sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c+sLLAsl [] = sL1+sLLAsl (!x:_) = sLL x++{-# INLINE sLZ #-}+sLZ :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c+sLZ !x !y = if isZeroWidthSpan (getHasLoc y)+                 then sL (getHasLoc x)+                 else sL (comb2 x y)++{- Note [Adding location info]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~++This is done using the three functions below, sL0, sL1+and sLL.  Note that these functions were mechanically+converted from the three macros that used to exist before,+namely L0, L1 and LL.++They each add a SrcSpan to their argument.++   sL0  adds 'noSrcSpan', used for empty productions+     -- This doesn't seem to work anymore -=chak++   sL1  for a production with a single token on the lhs.  Grabs the SrcSpan+        from that token.++   sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from+        the first and last tokens.++These suffice for the majority of cases.  However, we must be+especially careful with empty productions: sLL won't work if the first+or last token on the lhs can represent an empty span.  In these cases,+we have to calculate the span using more of the tokens from the lhs, eg.++        | 'newtype' tycl_hdr '=' newconstr deriving+                { L (comb3 $1 $4 $5)+                    (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }++We provide comb3 and comb4 functions which are useful in such cases.++Be careful: there's no checking that you actually got this right, the+only symptom will be that the SrcSpans of your syntax will be+incorrect.++-}++-- Make a source location for the file.  We're a bit lazy here and just+-- make a point SrcSpan at line 1, column 0.  Strictly speaking we should+-- try to find the span of the whole file (ToDo).+fileSrcSpan :: P SrcSpan+fileSrcSpan = do+  l <- getRealSrcLoc;+  let loc = mkSrcLoc (srcLocFile l) 1 1;+  return (mkSrcSpan loc loc)++-- Hint about linear types+hintLinear :: MonadP m => SrcSpan -> m ()+hintLinear span = do+  linearEnabled <- getBit LinearTypesBit+  unless linearEnabled $ addError $ mkPlainErrorMsgEnvelope span $ PsErrLinearFunction++-- Does this look like (a %m)?+looksLikeMult :: LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> Bool+looksLikeMult ty1 l_op ty2+  | Unqual op_name <- unLoc l_op+  , occNameFS op_name == fsLit "%"+  , Strict.Just ty1_pos <- getBufSpan (getLocA ty1)+  , Strict.Just pct_pos <- getBufSpan (getLocA l_op)+  , Strict.Just ty2_pos <- getBufSpan (getLocA ty2)+  , bufSpanEnd ty1_pos /= bufSpanStart pct_pos+  , bufSpanEnd pct_pos == bufSpanStart ty2_pos+  = True+  | otherwise = False++-- Hint about or-patterns+hintOrPats :: MonadP m => LPat GhcPs -> m (LPat GhcPs)+hintOrPats pat = do+  orPatsEnabled <- getBit OrPatternsBit+  unless orPatsEnabled $ addError $ mkPlainErrorMsgEnvelope (locA (getLoc pat)) $ PsErrIllegalOrPat pat+  return pat++-- Hint about the MultiWayIf extension+hintMultiWayIf :: SrcSpan -> P ()+hintMultiWayIf span = do+  mwiEnabled <- getBit MultiWayIfBit+  unless mwiEnabled $ addError $ mkPlainErrorMsgEnvelope span PsErrMultiWayIf++-- Hint about explicit-forall+hintExplicitForall :: Located Token -> P ()+hintExplicitForall tok = do+    explicit_forall_enabled <- getBit ExplicitForallBit+    in_rule_prag <- getBit InRulePragBit+    unless (explicit_forall_enabled || in_rule_prag) $+      addError $ mkPlainErrorMsgEnvelope (getLoc tok) $+        PsErrExplicitForall (isUnicode tok)++-- Hint about qualified-do+hintQualifiedDo :: Located Token -> P ()+hintQualifiedDo tok = do+    qualifiedDo   <- getBit QualifiedDoBit+    case maybeQDoDoc of+      Just qdoDoc | not qualifiedDo ->+        addError $ mkPlainErrorMsgEnvelope (getLoc tok) $+          (PsErrIllegalQualifiedDo qdoDoc)+      _ -> return ()+  where+    maybeQDoDoc = case unLoc tok of+      ITdo (Just m) -> Just $ ftext m <> text ".do"+      ITmdo (Just m) -> Just $ ftext m <> text ".mdo"+      t -> Nothing++-- When two single quotes don't followed by tyvar or gtycon, we report the+-- error as empty character literal, or TH quote that missing proper type+-- variable or constructor. See #13450.+reportEmptyDoubleQuotes :: SrcSpan -> P a+reportEmptyDoubleQuotes span = do+    thQuotes <- getBit ThQuotesBit+    addFatalError $ mkPlainErrorMsgEnvelope span $ PsErrEmptyDoubleQuotes thQuotes++{-+%************************************************************************+%*                                                                      *+        Helper functions for generating annotations in the parser+%*                                                                      *+%************************************************************************++For the general principles of the following routines, see Note [exact print annotations]+in GHC.Parser.Annotation++-}++msemi :: Located Token -> [TrailingAnn]+msemi !l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (epTok l)]++msemiA :: Located Token -> [EpToken ";"]+msemiA !l = if isZeroWidthSpan (gl l) then [] else [epTok l]++msemim :: Located Token -> Maybe (EpToken ";")+msemim !l = if isZeroWidthSpan (gl l) then Nothing else Just (epTok l)++toUnicode :: Located Token -> IsUnicodeSyntax+toUnicode t = if isUnicode t then UnicodeSyntax else NormalSyntax++-- -------------------------------------++gl :: GenLocated l a -> l+gl = getLoc++glA :: HasLoc a => a -> SrcSpan+glA = getHasLoc++glR :: HasLoc a => a -> EpaLocation+glR !la = EpaSpan (getHasLoc la)++glEE :: (HasLoc a, HasLoc b) => a -> b -> EpaLocation+glEE !x !y = spanAsAnchor $ comb2 x y++glEEz :: (HasLoc a, HasLoc b) => a -> b -> EpaLocation+glEEz !x !y = if isZeroWidthSpan (getHasLoc y)+                then spanAsAnchor (getHasLoc x)+                else spanAsAnchor $ comb2 x y++glRM :: Located a -> Maybe EpaLocation+glRM (L !l _) = Just $ spanAsAnchor l++n2l :: LocatedN a -> LocatedA a+n2l (L !la !a) = L (l2l la) a++-- Called at the very end to pick up the EOF position, as well as any comments not allocated yet.+acsFinal :: (EpAnnComments -> Maybe (RealSrcSpan, RealSrcSpan) -> Located a) -> P (Located a)+acsFinal a = do+  let (L l _) = a emptyComments Nothing+  !cs <- getCommentsFor l+  csf <- getFinalCommentsFor l+  meof <- getEofPos+  let ce = case meof of+             Strict.Nothing  -> Nothing+             Strict.Just (pos `Strict.And` gap) -> Just (pos,gap)+  return (a (cs Semi.<> csf) ce)++acs :: (HasLoc l, MonadP m) => l -> (l -> EpAnnComments -> GenLocated l a) -> m (GenLocated l a)+acs !l a = do+  !cs <- getCommentsFor (locA l)+  return (a l cs)++acsA :: (HasLoc l, HasAnnotation t, MonadP m) => l -> (l -> EpAnnComments -> Located a) -> m (GenLocated t a)+acsA !l a = do+  !cs <- getCommentsFor (locA l)+  return $ reLoc (a l cs)++ams1 :: MonadP m => Located a -> b -> m (LocatedA b)+ams1 (L l a) b = do+  !cs <- getCommentsFor l+  return (L (EpAnn (spanAsAnchor l) noAnn cs) b)++amsA' :: (NoAnn t, MonadP m) => Located a -> m (GenLocated (EpAnn t) a)+amsA' (L l a) = do+  !cs <- getCommentsFor l+  return (L (EpAnn (spanAsAnchor l) noAnn cs) a)++amsA :: MonadP m => LocatedA a -> [TrailingAnn] -> m (LocatedA a)+amsA (L !l a) bs = do+  !cs <- getCommentsFor (locA l)+  return (L (addAnnsA l bs cs) a)++amsAl :: MonadP m => LocatedA a -> SrcSpan -> [TrailingAnn] -> m (LocatedA a)+amsAl (L l a) loc bs = do+  !cs <- getCommentsFor loc+  return (L (addAnnsA l bs cs) a)++amsr :: MonadP m => Located a -> an -> m (LocatedAn an a)+amsr (L l a) an = do+  !cs <- getCommentsFor l+  return (L (EpAnn (spanAsAnchor l) an cs) a)++-- | Parse a Haskell module with Haddock comments. This is done in two steps:+--+-- * 'parseModuleNoHaddock' to build the AST+-- * 'addHaddockToModule' to insert Haddock comments into it+--+-- This and the signature module parser are the only parser entry points that+-- deal with Haddock comments. The other entry points ('parseDeclaration',+-- 'parseExpression', etc) do not insert them into the AST.+parseModule :: P (Located (HsModule GhcPs))+parseModule = parseModuleNoHaddock >>= addHaddockToModule++-- | Parse a Haskell signature module with Haddock comments. This is done in two+-- steps:+--+-- * 'parseSignatureNoHaddock' to build the AST+-- * 'addHaddockToModule' to insert Haddock comments into it+--+-- This and the module parser are the only parser entry points that deal with+-- Haddock comments. The other entry points ('parseDeclaration',+-- 'parseExpression', etc) do not insert them into the AST.+parseSignature :: P (Located (HsModule GhcPs))+parseSignature = parseSignatureNoHaddock >>= addHaddockToModule++commentsA :: (NoAnn ann) => SrcSpan -> EpAnnComments -> EpAnn ann+commentsA loc cs = EpAnn (EpaSpan loc) noAnn cs++spanWithComments :: (NoAnn ann, MonadP m) => SrcSpan -> m (EpAnn ann)+spanWithComments l = do+  !cs <- getCommentsFor l+  return (commentsA l cs)++-- | Instead of getting the *enclosed* comments, this includes the+-- *preceding* ones.  It is used at the top level to get comments+-- between top level declarations.+commentsPA :: (NoAnn ann) => LocatedAn ann a -> P (LocatedAn ann a)+commentsPA la@(L l a) = do+  !cs <- getPriorCommentsFor (getLocA la)+  return (L (addCommentsToEpAnn l cs) a)++hsDoAnn :: EpToken "rec" -> LocatedAn t b -> AnnList (EpToken "rec")+hsDoAnn tok (L ll _)+  = AnnList (Just $ spanAsAnchor (locA ll)) ListNone [] tok []++listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation+listAsAnchorM [] = Nothing+listAsAnchorM (L l _:_) =+  case locA l of+    RealSrcSpan ll _ -> Just $ realSpanAsAnchor ll+    _                -> Nothing++epTok :: Located Token -> EpToken tok+epTok (L !l _) = EpTok (EpaSpan l)++epUniTok :: Located Token -> EpUniToken tok utok+epUniTok t@(L !l _) = EpUniTok (EpaSpan l) u+  where+    u = if isUnicode t then UnicodeSyntax else NormalSyntax++-- |Construct an EpToken from the location of the token, provided the span is not zero width+mzEpTok :: Located Token -> EpToken tok+mzEpTok !l = if isZeroWidthSpan (gl l) then NoEpTok else (epTok l)++epExplicitBraces :: Located Token -> Located Token -> EpLayout+epExplicitBraces !t1 !t2 = EpExplicitBraces (epTok t1) (epTok t2)++-- -------------------------------------++addTrailingCommaFBind :: MonadP m => Fbind b -> EpToken "," -> m (Fbind b)+addTrailingCommaFBind (Left b)  l = fmap Left  (addTrailingCommaA b l)+addTrailingCommaFBind (Right b) l = fmap Right (addTrailingCommaA b l)++addTrailingVbarA :: MonadP m => LocatedA a -> EpToken "|" -> m (LocatedA a)+addTrailingVbarA  la tok = addTrailingAnnA la tok AddVbarAnn++addTrailingSemiA :: MonadP m => LocatedA a -> EpToken ";" -> m (LocatedA a)+addTrailingSemiA  la span = addTrailingAnnA la span AddSemiAnn++addTrailingCommaA :: MonadP m => LocatedA a -> EpToken "," -> m (LocatedA a)+addTrailingCommaA la span = addTrailingAnnA la span AddCommaAnn++addTrailingAnnA :: (MonadP m, HasLoc tok) => LocatedA a -> tok -> (tok -> TrailingAnn) -> m (LocatedA a)+addTrailingAnnA (L anns a) tok ta = do+  let cs = emptyComments+  -- AZ:TODO: generalise updating comments into an annotation+  let+    anns' = if isZeroWidthSpan (getHasLoc tok)+              then anns+              else addTrailingAnnToA (ta tok) cs anns+  return (L anns' a)++-- -------------------------------------++addTrailingVbarL :: MonadP m => LocatedL a -> EpToken "|" -> m (LocatedL a)+addTrailingVbarL  la tok = addTrailingAnnL la (AddVbarAnn tok)++addTrailingCommaL :: MonadP m => LocatedL a -> EpToken "," -> m (LocatedL a)+addTrailingCommaL  la tok = addTrailingAnnL la (AddCommaAnn tok)++addTrailingAnnL :: MonadP m => LocatedL a -> TrailingAnn -> m (LocatedL a)+addTrailingAnnL (L anns a) ta = do+  !cs <- getCommentsFor (locA anns)+  let anns' = addTrailingAnnToL ta cs anns+  return (L anns' a)++-- -------------------------------------++-- Mostly use to add AnnComma, special case it to NOP if adding a zero-width annotation+addTrailingCommaN :: MonadP m => LocatedN a -> SrcSpan -> m (LocatedN a)+addTrailingCommaN (L anns a) span = do+  let cs = emptyComments+  -- AZ:TODO: generalise updating comments into an annotation+  let anns' = if isZeroWidthSpan span+                then anns+                else addTrailingCommaToN anns (srcSpan2e span)+  return (L anns' a)++addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral+addTrailingCommaS (L l sl) span+    = L (widenSpanL l [span]) (sl { sl_tc = Just (epaToNoCommentsLocation span) })++-- -------------------------------------++addTrailingDarrowC :: LocatedC a -> Located Token -> EpAnnComments -> LocatedC a+addTrailingDarrowC (L (EpAnn lr (AnnContext _ o c) csc) a) lt cs =+  let+    u = if (isUnicode lt) then UnicodeSyntax else NormalSyntax+  in L (EpAnn lr (AnnContext (Just (epUniTok lt)) o c) (cs Semi.<> csc)) a++-- -------------------------------------++isUnicodeSyntax :: Located Token -> IsUnicodeSyntax+isUnicodeSyntax lt = if isUnicode lt then UnicodeSyntax else NormalSyntax  -- We need a location for the where binds, when computing the SrcSpan -- for the AST element using them.  Where there is a span, we return
compiler/GHC/Parser/Annotation.hs view
@@ -8,23 +8,21 @@  module GHC.Parser.Annotation (   -- * Core Exact Print Annotation types-  AnnKeywordId(..),   EpToken(..), EpUniToken(..),   getEpTokenSrcSpan,+  getEpTokenLocs, getEpTokenLoc, getEpUniTokenLoc,+  TokDcolon, TokDarrow, TokRarrow, TokForall,   EpLayout(..),   EpaComment(..), EpaCommentTok(..),   IsUnicodeSyntax(..),-  unicodeAnn,   HasE(..),    -- * In-tree Exact Print Annotations-  AddEpAnn(..),   EpaLocation, EpaLocation'(..), epaLocationRealSrcSpan,   TokenLocation(..),   DeltaPos(..), deltaPos, getDeltaLine, -  EpAnn(..), Anchor,-  anchor,+  EpAnn(..),   spanAsAnchor, realSpanAsAnchor,   noSpanAnchor,   NoAnn(..),@@ -38,13 +36,15 @@    -- ** Annotations in 'GenLocated'   LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP,+  LocatedLC, LocatedLS, LocatedLW, LocatedLI,   SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN,+  SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS, SrcSpanAnnLI,   LocatedE,    -- ** Annotation data types used in 'GenLocated' -  AnnListItem(..), AnnList(..),-  AnnParen(..), ParenType(..), parenTypeKws,+  AnnListItem(..), AnnList(..), AnnListBrackets(..),+  AnnParen(..),   AnnPragma(..),   AnnContext(..),   NameAnn(..), NameAdornment(..),@@ -52,7 +52,7 @@   AnnSortKey(..), DeclTag(..), BindTag(..),    -- ** Trailing annotations in lists-  TrailingAnn(..), trailingAnnToAddEpAnn,+  TrailingAnn(..), ta_location,   addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN,   noTrailingN, @@ -66,12 +66,12 @@    -- ** Building up annotations   reAnnL, reAnnC,-  addAnns, addAnnsA, widenSpan, widenAnchor, widenAnchorS, widenLocatedAn,+  addAnnsA, widenSpanL, widenSpanT, widenAnchorT, widenAnchorS,+  widenLocatedAnL,+  listLocation,    -- ** Querying annotations   getLocAnn,-  epAnnAnns,-  annParen2AddEpAnn,   epAnnComments,    -- ** Working with locations of annotations@@ -105,13 +105,14 @@ import Data.List (sortBy, foldl1') import Data.Semigroup import GHC.Data.FastString-import GHC.TypeLits (Symbol, KnownSymbol)+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Hs.DocString import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Utils.Panic import qualified GHC.Data.Strict as Strict+import GHC.Types.SourceText (SourceText (NoSourceText))  {- Note [exact print annotations]@@ -200,132 +201,6 @@  -- -------------------------------------------------------------------- --- | Exact print annotations exist so that tools can perform source to--- source conversions of Haskell code. They are used to keep track of--- the various syntactic keywords that are not otherwise captured in the--- AST.------ The wiki page describing this feature is--- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations--- https://gitlab.haskell.org/ghc/ghc/-/wikis/implementing-trees-that-grow/in-tree-api-annotations------ Note: in general the names of these are taken from the--- corresponding token, unless otherwise noted--- See Note [exact print annotations] above for details of the usage-data AnnKeywordId-    = AnnAnyclass-    | AnnAs-    | AnnBang  -- ^ '!'-    | AnnBackquote -- ^ '`'-    | AnnBy-    | AnnCase -- ^ case or lambda case-    | AnnCases -- ^ lambda cases-    | AnnClass-    | AnnClose -- ^  '\#)' or '\#-}'  etc-    | AnnCloseB -- ^ '|)'-    | AnnCloseBU -- ^ '|)', unicode variant-    | AnnCloseC -- ^ '}'-    | AnnCloseQ  -- ^ '|]'-    | AnnCloseQU -- ^ '|]', unicode variant-    | AnnCloseP -- ^ ')'-    | AnnClosePH -- ^ '\#)'-    | AnnCloseS -- ^ ']'-    | AnnColon-    | AnnComma -- ^ as a list separator-    | AnnCommaTuple -- ^ in a RdrName for a tuple-    | AnnDarrow -- ^ '=>'-    | AnnDarrowU -- ^ '=>', unicode variant-    | AnnData-    | AnnDcolon -- ^ '::'-    | AnnDcolonU -- ^ '::', unicode variant-    | AnnDefault-    | AnnDeriving-    | AnnDo-    | AnnDot    -- ^ '.'-    | AnnDotdot -- ^ '..'-    | AnnElse-    | AnnEqual-    | AnnExport-    | AnnFamily-    | AnnForall-    | AnnForallU -- ^ Unicode variant-    | AnnForeign-    | AnnFunId -- ^ for function name in matches where there are-               -- multiple equations for the function.-    | AnnGroup-    | AnnHeader -- ^ for CType-    | AnnHiding-    | AnnIf-    | AnnImport-    | AnnIn-    | AnnInfix -- ^ 'infix' or 'infixl' or 'infixr'-    | AnnInstance-    | AnnLam-    | AnnLarrow     -- ^ '<-'-    | AnnLarrowU    -- ^ '<-', unicode variant-    | AnnLet-    | AnnLollyU     -- ^ The '⊸' unicode arrow-    | AnnMdo-    | AnnMinus -- ^ '-'-    | AnnModule-    | AnnNewtype-    | AnnName -- ^ where a name loses its location in the AST, this carries it-    | AnnOf-    | AnnOpen    -- ^ '{-\# DEPRECATED' etc. Opening of pragmas where-                 -- the capitalisation of the string can be changed by-                 -- the user. The actual text used is stored in a-                 -- 'SourceText' on the relevant pragma item.-    | AnnOpenB   -- ^ '(|'-    | AnnOpenBU  -- ^ '(|', unicode variant-    | AnnOpenC   -- ^ '{'-    | AnnOpenE   -- ^ '[e|' or '[e||'-    | AnnOpenEQ  -- ^ '[|'-    | AnnOpenEQU -- ^ '[|', unicode variant-    | AnnOpenP   -- ^ '('-    | AnnOpenS   -- ^ '['-    | AnnOpenPH  -- ^ '(\#'-    | AnnDollar          -- ^ prefix '$'   -- TemplateHaskell-    | AnnDollarDollar    -- ^ prefix '$$'  -- TemplateHaskell-    | AnnPackageName-    | AnnPattern-    | AnnPercent    -- ^ '%'  -- for HsExplicitMult-    | AnnPercentOne -- ^ '%1' -- for HsLinearArrow-    | AnnProc-    | AnnQualified-    | AnnRarrow -- ^ '->'-    | AnnRarrowU -- ^ '->', unicode variant-    | AnnRec-    | AnnRole-    | AnnSafe-    | AnnSemi -- ^ ';'-    | AnnSimpleQuote -- ^ '''-    | AnnSignature-    | AnnStatic -- ^ 'static'-    | AnnStock-    | AnnThen-    | AnnThTyQuote -- ^ double '''-    | AnnTilde -- ^ '~'-    | AnnType-    | AnnUnit -- ^ '()' for types-    | AnnUsing-    | AnnVal  -- ^ e.g. INTEGER-    | AnnValStr  -- ^ String value, will need quotes when output-    | AnnVbar -- ^ '|'-    | AnnVia -- ^ 'via'-    | AnnWhere-    | Annlarrowtail -- ^ '-<'-    | AnnlarrowtailU -- ^ '-<', unicode variant-    | Annrarrowtail -- ^ '->'-    | AnnrarrowtailU -- ^ '->', unicode variant-    | AnnLarrowtail -- ^ '-<<'-    | AnnLarrowtailU -- ^ '-<<', unicode variant-    | AnnRarrowtail -- ^ '>>-'-    | AnnRarrowtailU -- ^ '>>-', unicode variant-    deriving (Eq, Ord, Data, Show)--instance Outputable AnnKeywordId where-  ppr x = text (show x)- -- | Certain tokens can have alternate representations when unicode syntax is -- enabled. This flag is attached to those tokens in the lexer so that the -- original source representation can be reproduced in the corresponding@@ -333,24 +208,6 @@ data IsUnicodeSyntax = UnicodeSyntax | NormalSyntax     deriving (Eq, Ord, Data, Show) --- | Convert a normal annotation into its unicode equivalent one-unicodeAnn :: AnnKeywordId -> AnnKeywordId-unicodeAnn AnnForall     = AnnForallU-unicodeAnn AnnDcolon     = AnnDcolonU-unicodeAnn AnnLarrow     = AnnLarrowU-unicodeAnn AnnRarrow     = AnnRarrowU-unicodeAnn AnnDarrow     = AnnDarrowU-unicodeAnn Annlarrowtail = AnnlarrowtailU-unicodeAnn Annrarrowtail = AnnrarrowtailU-unicodeAnn AnnLarrowtail = AnnLarrowtailU-unicodeAnn AnnRarrowtail = AnnRarrowtailU-unicodeAnn AnnOpenB      = AnnOpenBU-unicodeAnn AnnCloseB     = AnnCloseBU-unicodeAnn AnnOpenEQ     = AnnOpenEQU-unicodeAnn AnnCloseQ     = AnnCloseQU-unicodeAnn ann           = ann-- -- | Some template haskell tokens have two variants, one with an `e` the other -- not: --@@ -371,6 +228,9 @@   = NoEpTok   | EpTok !EpaLocation +instance KnownSymbol tok => Outputable (EpToken tok) where+  ppr _ = text (symbolVal (Proxy @tok))+ -- | With @UnicodeSyntax@, there might be multiple ways to write the same -- token. For example an arrow could be either @->@ or @→@. This choice must be -- recorded in order to exactprint such tokens, so instead of @EpToken "->"@ we@@ -380,14 +240,40 @@   | EpUniTok !EpaLocation !IsUnicodeSyntax  deriving instance Eq (EpToken tok)+deriving instance Eq (EpUniToken tok utok) deriving instance KnownSymbol tok => Data (EpToken tok) deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (EpUniToken tok utok) +instance (KnownSymbol tok, KnownSymbol utok) => Outputable (EpUniToken tok utok) where+  ppr NoEpUniTok                 = text $ symbolVal (Proxy @tok)+  ppr (EpUniTok _ NormalSyntax)  = text $ symbolVal (Proxy @tok)+  ppr (EpUniTok _ UnicodeSyntax) = text $ symbolVal (Proxy @utok)+ getEpTokenSrcSpan :: EpToken tok -> SrcSpan getEpTokenSrcSpan NoEpTok = noSrcSpan getEpTokenSrcSpan (EpTok EpaDelta{}) = noSrcSpan getEpTokenSrcSpan (EpTok (EpaSpan span)) = span +getEpTokenLocs :: [EpToken tok] -> [EpaLocation]+getEpTokenLocs ls = concatMap go ls+  where+    go NoEpTok   = []+    go (EpTok l) = [l]++getEpTokenLoc :: EpToken tok -> EpaLocation+getEpTokenLoc NoEpTok   = noAnn+getEpTokenLoc (EpTok l) = l++getEpUniTokenLoc :: EpUniToken tok toku -> EpaLocation+getEpUniTokenLoc NoEpUniTok     = noAnn+getEpUniTokenLoc (EpUniTok l _) = l++-- TODO:AZ: check we have all of the unicode tokens+type TokDcolon = EpUniToken "::" "∷"+type TokDarrow = EpUniToken "=>"  "⇒"+type TokRarrow = EpUniToken "->" "→"+type TokForall = EpUniToken "forall" "∀"+ -- | Layout information for declarations. data EpLayout = @@ -443,27 +329,16 @@  -- --------------------------------------------------------------------- --- | Captures an annotation, storing the @'AnnKeywordId'@ and its--- location.  The parser only ever inserts @'EpaLocation'@ fields with a--- RealSrcSpan being the original location of the annotation in the--- source file.--- The @'EpaLocation'@ can also store a delta position if the AST has been--- modified and needs to be pretty printed again.--- The usual way an 'AddEpAnn' is created is using the 'mj' ("make--- jump") function, and then it can be inserted into the appropriate--- annotation.-data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)- type EpaLocation = EpaLocation' [LEpaComment]  epaToNoCommentsLocation :: EpaLocation -> NoCommentsLocation epaToNoCommentsLocation (EpaSpan ss) = EpaSpan ss-epaToNoCommentsLocation (EpaDelta dp []) = EpaDelta dp NoComments-epaToNoCommentsLocation (EpaDelta _ _ ) = panic "epaToNoCommentsLocation"+epaToNoCommentsLocation (EpaDelta ss dp []) = EpaDelta ss dp NoComments+epaToNoCommentsLocation (EpaDelta _ _ _ ) = panic "epaToNoCommentsLocation"  noCommentsToEpaLocation :: NoCommentsLocation -> EpaLocation noCommentsToEpaLocation (EpaSpan ss) = EpaSpan ss-noCommentsToEpaLocation (EpaDelta dp NoComments) = EpaDelta dp []+noCommentsToEpaLocation (EpaDelta ss dp NoComments) = EpaDelta ss dp []  -- | Tokens embedded in the AST have an EpaLocation, unless they come from -- generated code (e.g. by TH).@@ -476,19 +351,16 @@ -- | Used in the parser only, extract the 'RealSrcSpan' from an -- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the -- partial function is safe.-epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan+epaLocationRealSrcSpan :: EpaLocation' a -> RealSrcSpan epaLocationRealSrcSpan (EpaSpan (RealSrcSpan r _)) = r epaLocationRealSrcSpan _ = panic "epaLocationRealSrcSpan" -instance Outputable AddEpAnn where-  ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss- -- ---------------------------------------------------------------------  -- | The exact print annotations (EPAs) are kept in the HsSyn AST for---   the GhcPs phase. We do not always have EPAs though, only for code---   that has been parsed as they do not exist for generated---   code. This type captures that they may be missing.+--   the GhcPs phase. They are usually inserted into the AST by the parser,+--   and in case of generated code (e.g. by TemplateHaskell) they are usually+--   initialized using 'NoAnn' type class. -- -- A goal of the annotations is that an AST can be edited, including -- moving subtrees from one place to another, duplicating them, and so@@ -502,24 +374,24 @@ -- -- The 'ann' type parameter allows this general structure to be -- specialised to the specific set of locations of original exact--- print annotation elements.  So for 'HsLet' we have+-- print annotation elements.  For example -----    type instance XLet GhcPs = EpAnn AnnsLet---    data AnnsLet---      = AnnsLet {---          alLet :: EpaLocation,---          alIn :: EpaLocation---          } deriving Data+-- @+-- type SrcSpannAnnA = EpAnn AnnListItem+-- @ --+-- is a commonly used type alias that specializes the 'ann' type parameter to+-- 'AnnListItem'.+-- -- The spacing between the items under the scope of a given EpAnn is -- normally derived from the original 'Anchor'.  But if a sub-element -- is not in its original position, the required spacing can be--- directly captured in the 'anchor_op' field of the 'entry' Anchor.+-- captured using an appropriate 'EpaDelta' value for the 'entry' Anchor. -- This allows us to freely move elements around, and stitch together -- new AST fragments out of old ones, and have them still printed out -- in a precise way. data EpAnn ann-  = EpAnn { entry   :: !Anchor+  = EpAnn { entry   :: !EpaLocation            -- ^ Base location for the start of the syntactic element            -- holding the annotations.            , anns     :: !ann -- ^ Annotations added by the Parser@@ -530,31 +402,19 @@         deriving (Data, Eq, Functor) -- See Note [XRec and Anno in the AST] --- | An 'Anchor' records the base location for the start of the--- syntactic element holding the annotations, and is used as the point--- of reference for calculating delta positions for contained--- annotations.--- It is also normally used as the reference point for the spacing of--- the element relative to its container. If the AST element is moved,--- that relationship is tracked in the 'anchor_op' instead.-type Anchor = EpaLocation -- Transitional -anchor :: (EpaLocation' a) -> RealSrcSpan-anchor (EpaSpan (RealSrcSpan r _)) = r-anchor _ = panic "anchor"- spanAsAnchor :: SrcSpan -> (EpaLocation' a) spanAsAnchor ss  = EpaSpan ss  realSpanAsAnchor :: RealSrcSpan -> (EpaLocation' a) realSpanAsAnchor s = EpaSpan (RealSrcSpan s Strict.Nothing) -noSpanAnchor :: (NoAnn a) => (EpaLocation' a)-noSpanAnchor =  EpaDelta (SameLine 0) noAnn+noSpanAnchor :: (NoAnn a) => EpaLocation' a+noSpanAnchor =  EpaDelta noSrcSpan (SameLine 0) noAnn  -- --------------------------------------------------------------------- --- | When we are parsing we add comments that belong a particular AST+-- | When we are parsing we add comments that belong to a particular AST -- element, and print them together with the element, interleaving -- them into the output stream.  But when editing the AST to move -- fragments around it is useful to be able to first separate the@@ -581,13 +441,21 @@ type LocatedN = GenLocated SrcSpanAnnN  type LocatedL = GenLocated SrcSpanAnnL+type LocatedLC = GenLocated SrcSpanAnnLC+type LocatedLS = GenLocated SrcSpanAnnLS+type LocatedLW = GenLocated SrcSpanAnnLW+type LocatedLI = GenLocated SrcSpanAnnLI type LocatedP = GenLocated SrcSpanAnnP type LocatedC = GenLocated SrcSpanAnnC  type SrcSpanAnnA = EpAnn AnnListItem type SrcSpanAnnN = EpAnn NameAnn -type SrcSpanAnnL = EpAnn AnnList+type SrcSpanAnnL = EpAnn (AnnList ())+type SrcSpanAnnLC = EpAnn (AnnList [EpToken ","])+type SrcSpanAnnLS = EpAnn (AnnList ())+type SrcSpanAnnLW = EpAnn (AnnList (EpToken "where"))+type SrcSpanAnnLI = EpAnn (AnnList (EpToken "hiding", [EpToken ","])) type SrcSpanAnnP = EpAnn AnnPragma type SrcSpanAnnC = EpAnn AnnContext @@ -603,9 +471,9 @@  The exact print annotations are captured directly inside the AST, using TTG extension points. However certain annotations need to be captured-on the Located versions too.  While there is a general form for these,-captured in the type SrcSpanAnn', there are also specific usages in-different contexts.+on the Located versions too.  There is a general form for these,+captured in the type 'EpAnn ann' with the specific usage captured in+the 'ann' parameter in different contexts.  Some of the particular use cases are @@ -616,7 +484,7 @@  See the section above this note for the rest. -The Anno type family maps the specific SrcSpanAnn' variant for a given+The Anno type family maps to the specific EpAnn variant for a given item.  So@@ -636,19 +504,24 @@ -- | Captures the location of punctuation occurring between items, -- normally in a list.  It is captured as a trailing annotation. data TrailingAnn-  = AddSemiAnn    { ta_location :: EpaLocation }  -- ^ Trailing ';'-  | AddCommaAnn   { ta_location :: EpaLocation }  -- ^ Trailing ','-  | AddVbarAnn    { ta_location :: EpaLocation }  -- ^ Trailing '|'-  | AddDarrowAnn  { ta_location :: EpaLocation }  -- ^ Trailing '=>'-  | AddDarrowUAnn { ta_location :: EpaLocation }  -- ^ Trailing  "⇒"+  = AddSemiAnn    (EpToken ";") -- ^ Trailing ';'+  | AddCommaAnn   (EpToken ",") -- ^ Trailing ','+  | AddVbarAnn    (EpToken "|") -- ^ Trailing '|'+  | AddDarrowAnn  TokDarrow     -- ^ Trailing '=>' / '⇒'   deriving (Data, Eq) +ta_location :: TrailingAnn -> EpaLocation+ta_location (AddSemiAnn    tok) = getEpTokenLoc tok+ta_location (AddCommaAnn   tok) = getEpTokenLoc tok+ta_location (AddVbarAnn    tok) = getEpTokenLoc tok+ta_location (AddDarrowAnn  tok) = getEpUniTokenLoc tok++ instance Outputable TrailingAnn where-  ppr (AddSemiAnn ss)    = text "AddSemiAnn"    <+> ppr ss-  ppr (AddCommaAnn ss)   = text "AddCommaAnn"   <+> ppr ss-  ppr (AddVbarAnn ss)    = text "AddVbarAnn"    <+> ppr ss-  ppr (AddDarrowAnn ss)  = text "AddDarrowAnn"  <+> ppr ss-  ppr (AddDarrowUAnn ss) = text "AddDarrowUAnn" <+> ppr ss+  ppr (AddSemiAnn tok)    = text "AddSemiAnn"    <+> ppr tok+  ppr (AddCommaAnn tok)   = text "AddCommaAnn"   <+> ppr tok+  ppr (AddVbarAnn tok)    = text "AddVbarAnn"    <+> ppr tok+  ppr (AddDarrowAnn tok)  = text "AddDarrowAnn"  <+> ppr tok  -- | Annotation for items appearing in a list. They can have one or -- more trailing punctuations items, such as commas or semicolons.@@ -665,17 +538,25 @@ -- | Annotation for the "container" of a list. This captures -- surrounding items such as braces if present, and introductory -- keywords such as 'where'.-data AnnList+data AnnList a   = AnnList {-      al_anchor    :: Maybe Anchor, -- ^ start point of a list having layout-      al_open      :: Maybe AddEpAnn,-      al_close     :: Maybe AddEpAnn,-      al_rest      :: [AddEpAnn], -- ^ context, such as 'where' keyword-      al_trailing  :: [TrailingAnn] -- ^ items appearing after the-                                    -- list, such as '=>' for a-                                    -- context+      al_anchor    :: !(Maybe EpaLocation), -- ^ start point of a list having layout+      al_brackets  :: !AnnListBrackets,+      al_semis     :: [EpToken ";"], -- decls+      al_rest      :: !a,+      al_trailing  :: ![TrailingAnn] -- ^ items appearing after the+                                     -- list, such as '=>' for a+                                     -- context       } deriving (Data,Eq) +data AnnListBrackets+  = ListParens (EpToken "(")         (EpToken ")")+  | ListBraces (EpToken "{")         (EpToken "}")+  | ListSquare (EpToken "[")         (EpToken "]")+  | ListBanana (EpUniToken "(|" "⦇") (EpUniToken "|)"  "⦈")+  | ListNone+  deriving (Data,Eq)+ -- --------------------------------------------------------------------- -- Annotations for parenthesised elements, such as tuples, lists -- ---------------------------------------------------------------------@@ -683,35 +564,20 @@ -- | exact print annotation for an item having surrounding "brackets", such as -- tuples or lists data AnnParen-  = AnnParen {-      ap_adornment :: ParenType,-      ap_open      :: EpaLocation,-      ap_close     :: EpaLocation-      } deriving (Data)---- | Detail of the "brackets" used in an 'AnnParen' exact print annotation.-data ParenType-  = AnnParens       -- ^ '(', ')'-  | AnnParensHash   -- ^ '(#', '#)'-  | AnnParensSquare -- ^ '[', ']'-  deriving (Eq, Ord, Data, Show)---- | Maps the 'ParenType' to the related opening and closing--- AnnKeywordId. Used when actually printing the item.-parenTypeKws :: ParenType -> (AnnKeywordId, AnnKeywordId)-parenTypeKws AnnParens       = (AnnOpenP, AnnCloseP)-parenTypeKws AnnParensHash   = (AnnOpenPH, AnnClosePH)-parenTypeKws AnnParensSquare = (AnnOpenS, AnnCloseS)+  = AnnParens       (EpToken "(")  (EpToken ")")  -- ^ '(', ')'+  | AnnParensHash   (EpToken "(#") (EpToken "#)") -- ^ '(#', '#)'+  | AnnParensSquare (EpToken "[")  (EpToken "]")  -- ^ '[', ']'+  deriving Data  -- ---------------------------------------------------------------------  -- | Exact print annotation for the 'Context' data type. data AnnContext   = AnnContext {-      ac_darrow    :: Maybe (IsUnicodeSyntax, EpaLocation),-                      -- ^ location and encoding of the '=>', if present.-      ac_open      :: [EpaLocation], -- ^ zero or more opening parentheses.-      ac_close     :: [EpaLocation]  -- ^ zero or more closing parentheses.+      ac_darrow    :: Maybe TokDarrow,+                      -- ^ location of the '=>', if present.+      ac_open      :: [EpToken "("], -- ^ zero or more opening parentheses.+      ac_close     :: [EpToken ")"]  -- ^ zero or more closing parentheses.       } deriving (Data)  @@ -726,51 +592,42 @@   -- | Used for a name with an adornment, so '`foo`', '(bar)'   = NameAnn {       nann_adornment :: NameAdornment,-      nann_open      :: EpaLocation,       nann_name      :: EpaLocation,-      nann_close     :: EpaLocation,       nann_trailing  :: [TrailingAnn]       }-  -- | Used for @(,,,)@, or @(#,,,#)#+  -- | Used for @(,,,)@, or @(#,,,#)@   | NameAnnCommas {       nann_adornment :: NameAdornment,-      nann_open      :: EpaLocation,-      nann_commas    :: [EpaLocation],-      nann_close     :: EpaLocation,+      nann_commas    :: [EpToken ","],       nann_trailing  :: [TrailingAnn]       }   -- | Used for @(# | | #)@   | NameAnnBars {-      nann_adornment :: NameAdornment,-      nann_open      :: EpaLocation,-      nann_bars      :: [EpaLocation],-      nann_close     :: EpaLocation,+      nann_parensh   :: (EpToken "(#", EpToken "#)"),+      nann_bars      :: [EpToken "|"],       nann_trailing  :: [TrailingAnn]       }   -- | Used for @()@, @(##)@, @[]@   | NameAnnOnly {       nann_adornment :: NameAdornment,-      nann_open      :: EpaLocation,-      nann_close     :: EpaLocation,       nann_trailing  :: [TrailingAnn]       }   -- | Used for @->@, as an identifier   | NameAnnRArrow {-      nann_unicode   :: Bool,-      nann_mopen     :: Maybe EpaLocation,-      nann_name      :: EpaLocation,-      nann_mclose    :: Maybe EpaLocation,+      nann_mopen     :: Maybe (EpToken "("),+      nann_arrow     :: TokRarrow,+      nann_mclose    :: Maybe (EpToken ")"),       nann_trailing  :: [TrailingAnn]       }   -- | Used for an item with a leading @'@. The annotation for   -- unquoted item is stored in 'nann_quoted'.   | NameAnnQuote {-      nann_quote     :: EpaLocation,+      nann_quote     :: EpToken "'",       nann_quoted    :: SrcSpanAnnN,       nann_trailing  :: [TrailingAnn]       }   -- | Used when adding a 'TrailingAnn' to an existing 'LocatedN'-  -- which has no Api Annotation (via the 'EpAnnNotUsed' constructor.+  -- which has no Api Annotation.   | NameAnnTrailing {       nann_trailing  :: [TrailingAnn]       }@@ -780,21 +637,27 @@ -- such as parens or backquotes. This data type identifies what -- particular pair are being used. data NameAdornment-  = NameParens -- ^ '(' ')'-  | NameParensHash -- ^ '(#' '#)'-  | NameBackquotes -- ^ '`'-  | NameSquare -- ^ '[' ']'-  deriving (Eq, Ord, Data)+  = NameParens     (EpToken "(")  (EpToken ")")+  | NameParensHash (EpToken "(#") (EpToken "#)")+  | NameBackquotes (EpToken "`")  (EpToken "`")+  | NameSquare     (EpToken "[")  (EpToken "]")+  | NameNoAdornment+  deriving (Eq, Data) + -- ---------------------------------------------------------------------  -- | exact print annotation used for capturing the locations of -- annotations in pragmas. data AnnPragma   = AnnPragma {-      apr_open      :: AddEpAnn,-      apr_close     :: AddEpAnn,-      apr_rest      :: [AddEpAnn]+      apr_open      :: EpaLocation,+      apr_close     :: EpToken "#-}",+      apr_squares   :: (EpToken "[", EpToken "]"),+      apr_loc1      :: EpaLocation,+      apr_loc2      :: EpaLocation,+      apr_type      :: EpToken "type",+      apr_module    :: EpToken "module"       } deriving (Data,Eq)  -- ---------------------------------------------------------------------@@ -894,7 +757,7 @@    binds: fa = 1 , fb = 'c'   sigs:  fa :: Int, fb :: Char-  tags: SigTag, BindTag, SigTag, BindTag+  tags: SigDTag, BindTag, SigDTag, BindTag  so we draw first from the signatures, then the binds, and same again. @@ -902,7 +765,7 @@    binds: fb = 'c', fa = 1   sigs:  fa :: Int, fb :: Char-  tags: SigTag, SigTag, BindTag, BindTag+  tags: SigDTag, SigDTag, BindTag, BindTag  so we draw two signatures, then two binds. @@ -913,18 +776,10 @@  -- --------------------------------------------------------------------- --- | Convert a 'TrailingAnn' to an 'AddEpAnn'-trailingAnnToAddEpAnn :: TrailingAnn -> AddEpAnn-trailingAnnToAddEpAnn (AddSemiAnn ss)    = AddEpAnn AnnSemi ss-trailingAnnToAddEpAnn (AddCommaAnn ss)   = AddEpAnn AnnComma ss-trailingAnnToAddEpAnn (AddVbarAnn ss)    = AddEpAnn AnnVbar ss-trailingAnnToAddEpAnn (AddDarrowUAnn ss) = AddEpAnn AnnDarrowU ss-trailingAnnToAddEpAnn (AddDarrowAnn ss)  = AddEpAnn AnnDarrow ss- -- | Helper function used in the parser to add a 'TrailingAnn' items -- to an existing annotation. addTrailingAnnToL :: TrailingAnn -> EpAnnComments-                  -> EpAnn AnnList -> EpAnn AnnList+                  -> EpAnn (AnnList a) -> EpAnn (AnnList a) addTrailingAnnToL t cs n = n { anns = addTrailing (anns n)                                , comments = comments n <> cs }   where@@ -948,7 +803,7 @@   where     -- See Note [list append in addTrailing*]     addTrailing :: NameAnn -> EpaLocation -> NameAnn-    addTrailing n l = n { nann_trailing = nann_trailing n ++ [AddCommaAnn l]}+    addTrailing n l = n { nann_trailing = nann_trailing n ++ [AddCommaAnn (EpTok l)]}  noTrailingN :: SrcSpanAnnN -> SrcSpanAnnN noTrailingN s = s { anns = (anns s) { nann_trailing = [] } }@@ -1043,8 +898,15 @@  instance HasLoc EpaLocation where   getHasLoc (EpaSpan l) = l-  getHasLoc (EpaDelta _ _) = noSrcSpan+  getHasLoc (EpaDelta l _ _) = l +instance HasLoc (EpToken tok) where+  getHasLoc = getEpTokenSrcSpan++instance HasLoc (EpUniToken tok utok) where+  getHasLoc NoEpUniTok = noSrcSpan+  getHasLoc (EpUniTok l _) = getHasLoc l+ getHasLocList :: HasLoc a => [a] -> SrcSpan getHasLocList [] = noSrcSpan getHasLocList xs = foldl1' combineSrcSpans $ map getHasLoc xs@@ -1070,10 +932,6 @@ getLocAnn :: Located a  -> SrcSpanAnnA getLocAnn (L l _) = noAnnSrcSpan l -addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]-addAnns (EpAnn l as1 cs) as2 cs2-  = EpAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2)- -- AZ:TODO use widenSpan here too addAnnsA :: SrcSpanAnnA -> [TrailingAnn] -> EpAnnComments -> SrcSpanAnnA addAnnsA (EpAnn l as1 cs) as2 cs2@@ -1081,72 +939,43 @@  -- | The annotations need to all come after the anchor.  Make sure -- this is the case.-widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan-widenSpan s as = foldl combineSrcSpans s (go as)-  where-    go [] = []-    go (AddEpAnn _ (EpaSpan (RealSrcSpan s mb)):rest) = RealSrcSpan s mb : go rest-    go (AddEpAnn _ (EpaSpan _):rest) = go rest-    go (AddEpAnn _ (EpaDelta _ _):rest) = go rest---- | The annotations need to all come after the anchor.  Make sure--- this is the case.-widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan-widenRealSpan s as = foldl combineRealSrcSpans s (go as)+widenSpanL :: SrcSpan -> [EpaLocation] -> SrcSpan+widenSpanL s as = foldl combineSrcSpans s (go as)   where     go [] = []-    go (AddEpAnn _ (EpaSpan (RealSrcSpan s _)):rest) = s : go rest-    go (AddEpAnn _ _:rest) = go rest--realSpanFromAnns :: [AddEpAnn] -> Strict.Maybe RealSrcSpan-realSpanFromAnns as = go Strict.Nothing as-  where-    combine Strict.Nothing r  = Strict.Just r-    combine (Strict.Just l) r = Strict.Just $ combineRealSrcSpans l r+    go ((EpaSpan (RealSrcSpan s mb):rest)) = RealSrcSpan s mb : go rest+    go ((EpaSpan _):rest) = go rest+    go ((EpaDelta _ _ _):rest) = go rest -    go acc [] = acc-    go acc (AddEpAnn _ (EpaSpan (RealSrcSpan s _b)):rest) = go (combine acc s) rest-    go acc (AddEpAnn _ _             :rest) = go acc rest+widenSpanT :: SrcSpan -> EpToken tok -> SrcSpan+widenSpanT l (EpTok loc) = widenSpanL l [loc]+widenSpanT l NoEpTok = l -bufSpanFromAnns :: [AddEpAnn] -> Strict.Maybe BufSpan-bufSpanFromAnns as =  go Strict.Nothing as+listLocation :: [LocatedAn an a] -> EpaLocation+listLocation as = EpaSpan (go noSrcSpan as)   where-    combine Strict.Nothing r  = Strict.Just r-    combine (Strict.Just l) r = Strict.Just $ combineBufSpans l r+    combine l r = combineSrcSpans l r      go acc [] = acc-    go acc (AddEpAnn _ (EpaSpan (RealSrcSpan _ (Strict.Just mb))):rest) = go (combine acc mb) rest-    go acc (AddEpAnn _ _:rest) = go acc rest+    go acc (L (EpAnn (EpaSpan s) _ _) _:rest) = go (combine acc s) rest+    go acc (_:rest) = go acc rest -widenAnchor :: Anchor -> [AddEpAnn] -> Anchor-widenAnchor (EpaSpan (RealSrcSpan s mb)) as-  = EpaSpan (RealSrcSpan (widenRealSpan s as) (liftA2 combineBufSpans mb  (bufSpanFromAnns as)))-widenAnchor (EpaSpan us) _ = EpaSpan us-widenAnchor a@(EpaDelta _ _) as = case (realSpanFromAnns as) of-                                    Strict.Nothing -> a-                                    Strict.Just r -> EpaSpan (RealSrcSpan r Strict.Nothing)+widenAnchorT :: EpaLocation -> EpToken tok -> EpaLocation+widenAnchorT (EpaSpan ss) (EpTok l) = widenAnchorS l ss+widenAnchorT ss _ = ss -widenAnchorS :: Anchor -> SrcSpan -> Anchor+widenAnchorS :: EpaLocation -> SrcSpan -> EpaLocation widenAnchorS (EpaSpan (RealSrcSpan s mbe)) (RealSrcSpan r mbr)   = EpaSpan (RealSrcSpan (combineRealSrcSpans s r) (liftA2 combineBufSpans mbe mbr)) widenAnchorS (EpaSpan us) _ = EpaSpan us-widenAnchorS (EpaDelta _ _) (RealSrcSpan r mb) = EpaSpan (RealSrcSpan r mb)+widenAnchorS EpaDelta{} (RealSrcSpan r mb) = EpaSpan (RealSrcSpan r mb) widenAnchorS anc _ = anc -widenLocatedAn :: EpAnn an -> [AddEpAnn] -> EpAnn an-widenLocatedAn (EpAnn (EpaSpan l) a cs) as = EpAnn (spanAsAnchor l') a cs-  where-    l' = widenSpan l as-widenLocatedAn (EpAnn anc a cs) _as = EpAnn anc a cs--epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn]-epAnnAnns (EpAnn _ anns _) = anns--annParen2AddEpAnn :: AnnParen -> [AddEpAnn]-annParen2AddEpAnn (AnnParen pt o c)-  = [AddEpAnn ai o, AddEpAnn ac c]+widenLocatedAnL :: EpAnn an -> [EpaLocation] -> EpAnn an+widenLocatedAnL (EpAnn (EpaSpan l) a cs) as = EpAnn (spanAsAnchor l') a cs   where-    (ai,ac) = parenTypeKws pt+    l' = widenSpanL l as+widenLocatedAnL (EpAnn anc a cs) _as = EpAnn anc a cs  epAnnComments :: EpAnn an -> EpAnnComments epAnnComments (EpAnn _ _ cs) = cs@@ -1283,7 +1112,7 @@   EpaSpan s1       <> EpaSpan s2        = EpaSpan (combineSrcSpans s1 s2)   EpaSpan s1       <> _                 = EpaSpan s1   _                <> EpaSpan s2        = EpaSpan s2-  EpaDelta dp1 cs1 <> EpaDelta _dp2 cs2 = EpaDelta dp1 (cs1<>cs2)+  EpaDelta s1 dp1 cs1 <> EpaDelta s2 _dp2 cs2 = EpaDelta (combineSrcSpans s1 s2) dp1 (cs1<>cs2)  instance Semigroup EpAnnComments where   EpaComments cs1 <> EpaComments cs2 = EpaComments (cs1 ++ cs2)@@ -1307,13 +1136,7 @@ -- ---------------------------------------------------------------------  instance NoAnn EpaLocation where-  noAnn = EpaDelta (SameLine 0) []--instance NoAnn AnnKeywordId where-  noAnn = Annlarrowtail  {- gotta pick one -}--instance NoAnn AddEpAnn where-  noAnn = AddEpAnn noAnn noAnn+  noAnn = EpaDelta noSrcSpan (SameLine 0) []  instance NoAnn [a] where   noAnn = []@@ -1321,12 +1144,24 @@ instance NoAnn (Maybe a) where   noAnn = Nothing +instance NoAnn a => NoAnn (Either a b) where+  noAnn = Left noAnn+ instance (NoAnn a, NoAnn b) => NoAnn (a, b) where   noAnn = (noAnn, noAnn) +instance (NoAnn a, NoAnn b, NoAnn c) => NoAnn (a, b, c) where+  noAnn = (noAnn, noAnn, noAnn)++instance (NoAnn a, NoAnn b, NoAnn c, NoAnn d) => NoAnn (a, b, c, d) where+  noAnn = (noAnn, noAnn, noAnn, noAnn)+ instance NoAnn Bool where   noAnn = False +instance NoAnn () where+  noAnn = ()+ instance (NoAnn ann) => NoAnn (EpAnn ann) where   noAnn = EpAnn noSpanAnchor noAnn emptyComments @@ -1339,17 +1174,17 @@ instance NoAnn AnnContext where   noAnn = AnnContext Nothing [] [] -instance NoAnn AnnList where-  noAnn = AnnList Nothing Nothing Nothing [] []+instance NoAnn a => NoAnn (AnnList a) where+  noAnn = AnnList Nothing ListNone noAnn noAnn []  instance NoAnn NameAnn where   noAnn = NameAnnTrailing []  instance NoAnn AnnPragma where-  noAnn = AnnPragma noAnn noAnn []+  noAnn = AnnPragma noAnn noAnn noAnn noAnn noAnn noAnn noAnn  instance NoAnn AnnParen where-  noAnn = AnnParen AnnParens noAnn noAnn+  noAnn = AnnParens noAnn noAnn  instance NoAnn (EpToken s) where   noAnn = NoEpTok@@ -1357,6 +1192,9 @@ instance NoAnn (EpUniToken s t) where   noAnn = NoEpUniTok +instance NoAnn SourceText where+  noAnn = NoSourceText+ -- ---------------------------------------------------------------------  instance (Outputable a) => Outputable (EpAnn a) where@@ -1404,37 +1242,49 @@      => Outputable (GenLocated EpaLocation e) where   ppr = pprLocated -instance Outputable ParenType where-  ppr t = text (show t)+instance Outputable AnnParen where+  ppr (AnnParens       o c) = text "AnnParens" <+> ppr o <+> ppr c+  ppr (AnnParensHash   o c) = text "AnnParensHash" <+> ppr o <+> ppr c+  ppr (AnnParensSquare o c) = text "AnnParensSquare" <+> ppr o <+> ppr c  instance Outputable AnnListItem where   ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts  instance Outputable NameAdornment where-  ppr NameParens     = text "NameParens"-  ppr NameParensHash = text "NameParensHash"-  ppr NameBackquotes = text "NameBackquotes"-  ppr NameSquare     = text "NameSquare"+  ppr (NameParens     o c) = text "NameParens" <+> ppr o <+> ppr c+  ppr (NameParensHash o c) = text "NameParensHash" <+> ppr o <+> ppr c+  ppr (NameBackquotes o c) = text "NameBackquotes" <+> ppr o <+> ppr c+  ppr (NameSquare     o c) = text "NameSquare" <+> ppr o <+> ppr c+  ppr NameNoAdornment      = text "NameNoAdornment"  instance Outputable NameAnn where-  ppr (NameAnn a o n c t)-    = text "NameAnn" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t-  ppr (NameAnnCommas a o n c t)-    = text "NameAnnCommas" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t-  ppr (NameAnnBars a o n b t)-    = text "NameAnnBars" <+> ppr a <+> ppr o <+> ppr n <+> ppr b <+> ppr t-  ppr (NameAnnOnly a o c t)-    = text "NameAnnOnly" <+> ppr a <+> ppr o <+> ppr c <+> ppr t-  ppr (NameAnnRArrow u o n c t)-    = text "NameAnnRArrow" <+> ppr u <+> ppr o <+> ppr n <+> ppr c <+> ppr t+  ppr (NameAnn a n t)+    = text "NameAnn" <+> ppr a <+> ppr n <+> ppr t+  ppr (NameAnnCommas a n t)+    = text "NameAnnCommas" <+> ppr a <+> ppr n <+> ppr t+  ppr (NameAnnBars a n t)+    = text "NameAnnBars" <+> ppr a <+> ppr n <+> ppr t+  ppr (NameAnnOnly a t)+    = text "NameAnnOnly" <+> ppr a <+> ppr t+  ppr (NameAnnRArrow o n c t)+    = text "NameAnnRArrow" <+> ppr o <+> ppr n <+> ppr c <+> ppr t   ppr (NameAnnQuote q n t)     = text "NameAnnQuote" <+> ppr q <+> ppr n <+> ppr t   ppr (NameAnnTrailing t)     = text "NameAnnTrailing" <+> ppr t -instance Outputable AnnList where-  ppr (AnnList a o c r t)-    = text "AnnList" <+> ppr a <+> ppr o <+> ppr c <+> ppr r <+> ppr t+instance (Outputable a) => Outputable (AnnList a) where+  ppr (AnnList anc p s a t)+    = text "AnnList" <+> ppr anc <+> ppr p <+> ppr s <+> ppr a <+> ppr t +instance Outputable AnnListBrackets where+  ppr (ListParens o c) = text "ListParens" <+> ppr o <+> ppr c+  ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c+  ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c+  ppr (ListBanana o c) = text "ListBanana" <+> ppr o <+> ppr c+  ppr ListNone         = text "ListNone"+ instance Outputable AnnPragma where-  ppr (AnnPragma o c r) = text "AnnPragma" <+> ppr o <+> ppr c <+> ppr r+  ppr (AnnPragma o c s l ca t m)+    = text "AnnPragma" <+> ppr o <+> ppr c <+> ppr s <+> ppr l+                       <+> ppr ca <+> ppr ca <+> ppr t <+> ppr m
compiler/GHC/Parser/CharClass.hs view
@@ -36,7 +36,7 @@  {-# INLINABLE is_ctype #-} is_ctype :: Word8 -> Char -> Bool-is_ctype mask c = (charType c .&. mask) /= 0+is_ctype mask c = c <= '\127' && (charType c .&. mask) /= 0  is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit,     is_alphanum :: Char -> Bool
compiler/GHC/Parser/Errors/Ppr.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic PsMessage @@ -30,11 +31,14 @@ import GHC.Data.FastString import GHC.Data.Maybe (catMaybes) import GHC.Hs.Expr (prependQualified, HsExpr(..), HsLamVariant(..), lamCaseKeyword)-import GHC.Hs.Type (pprLHsContext)+import GHC.Hs.Type (pprLHsContext, pprHsArrow, pprHsForAll) import GHC.Builtin.Names (allNameStringList) import GHC.Builtin.Types (filterCTuple) import qualified GHC.LanguageExtensions as LangExt import Data.List.NonEmpty (NonEmpty((:|)))+import GHC.Hs.Pat (Pat(..), LPat)+import GHC.Hs.Extension+import GHC.Parser.Annotation (noAnn)   instance Diagnostic PsMessage where@@ -120,7 +124,32 @@       -> mkSimpleDecorated $             text "Found" <+> quotes (text "qualified")              <+> text "in prepositive position"+    PsWarnViewPatternSignatures old new+      -> mkDecorated $+          [ text "Found an unparenthesized pattern signature on the RHS of a view pattern."+          , vcat [ text "This code might stop working in a future GHC release"+                 , text "due to a planned change to the precedence of view patterns,"+                 , text "unless the view function is an endofunction." ]+          , nest 2 $+            vcat [ text "Current parse:" <+> quotes (ppr (add_parens_sig old))+                 , text "Future parse:" <+> quotes (ppr (add_parens_view new)) ]+          ]+      where+        add_parens_sig :: LPat GhcPs -> LPat GhcPs+        add_parens_sig = go+          where go (L l (ViewPat x e p)) = L l (ViewPat x e (go p))+                go (L l (SigPat x p sig)) = par_pat (L l (SigPat x p sig))+                go p = p +        add_parens_view :: LPat GhcPs -> LPat GhcPs+        add_parens_view = go+          where go (L l (ViewPat x e p)) = par_pat (L l (ViewPat x e p))+                go (L l (SigPat x p sig)) = L l (SigPat x (go p) sig)+                go p = p++        par_pat :: LPat GhcPs -> LPat GhcPs+        par_pat p = L noAnn (ParPat noAnn p)+     PsErrLexer err kind       -> mkSimpleDecorated $ hcat            [ case err of@@ -128,8 +157,6 @@               LexUnknownPragma       -> text "unknown pragma"               LexErrorInPragma       -> text "lexical error in pragma"               LexNumEscapeRange      -> text "numeric escape sequence out of range"-              LexStringCharLit       -> text "lexical error in string/character literal"-              LexStringCharLitEOF    -> text "unexpected end-of-file in string/character literal"               LexUnterminatedComment -> text "unterminated `{-'"               LexUnterminatedOptions -> text "unterminated OPTIONS pragma"               LexUnterminatedQQ      -> text "unterminated quasiquotation"@@ -201,7 +228,7 @@              NumUnderscore_Integral -> "Illegal underscores in integer literals"              NumUnderscore_Float    -> "Illegal underscores in floating literals"     PsErrIllegalBangPattern e-      -> mkSimpleDecorated $ text "Illegal bang-pattern" $$ ppr e+      -> mkSimpleDecorated $ text "Illegal bang-pattern or strict binding" $$ ppr e     PsErrOverloadedRecordDotInvalid       -> mkSimpleDecorated $            text "Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)"@@ -343,10 +370,10 @@            [ text "Arrow command found where an expression was expected:"            , nest 2 (ppr c)            ]-    PsErrViewPatInExpr a b+    PsErrOrPatInExpr p       -> mkSimpleDecorated $-           sep [ text "View pattern in expression context:"-               , nest 4 (ppr a <+> text "->" <+> ppr b)+           sep [ text "Or pattern in expression context:"+               , nest 4 (ppr p)                ]     PsErrCaseCmdInFunAppCmd a       -> mkSimpleDecorated $ pp_unexpected_fun_app (text "case command") a@@ -530,7 +557,20 @@         [ text "Unboxed sum data constructors are not supported in types."         , text "Use" <+> quotes (text "Sum<n># a b c ...") <+> text "to refer to the type constructor."         ]+    PsErrTypeSyntaxInPat ctx+      -> mkSimpleDecorated $ vcat+        [ text "Illegal" <+> text what <+> "in pattern:" <+> quotes ctx'+        , text "Type syntax in patterns isn't supported at the time"]+        where+          (what, ctx') = case ctx of+            PETS_FunctionArrow arg arr res -> ("function arrow", ppr arg <+> pprHsArrow arr <+> ppr res)+            PETS_Multiplicity tok p        -> ("multiplicity annotation", ppr tok <> ppr p)+            PETS_ForallTelescope tele body -> ("forall telescope", pprHsForAll tele Nothing <+> ppr body)+            PETS_ConstraintContext ctx     -> ("constraint context", ppr ctx) +    PsErrIllegalOrPat pat+      -> mkSimpleDecorated $ vcat [text "Illegal or-pattern:" <+> ppr (unLoc pat)]+   diagnosticReason  = \case     PsUnknownMessage m                            -> diagnosticReason m     PsHeaderMessage  m                            -> psHeaderMessageReason m@@ -546,6 +586,7 @@     PsWarnUnrecognisedPragma{}                    -> WarningWithFlag Opt_WarnUnrecognisedPragmas     PsWarnMisplacedPragma{}                       -> WarningWithFlag Opt_WarnMisplacedPragmas     PsWarnImportPreQualified                      -> WarningWithFlag Opt_WarnPrepositiveQualifiedModule+    PsWarnViewPatternSignatures{}                 -> WarningWithFlag Opt_WarnViewPatternSignatures     PsErrLexer{}                                  -> ErrorWithoutFlag     PsErrCmmLexer                                 -> ErrorWithoutFlag     PsErrCmmParser{}                              -> ErrorWithoutFlag@@ -607,7 +648,7 @@     PsErrArrowExprInPat{}                         -> ErrorWithoutFlag     PsErrArrowCmdInPat{}                          -> ErrorWithoutFlag     PsErrArrowCmdInExpr{}                         -> ErrorWithoutFlag-    PsErrViewPatInExpr{}                          -> ErrorWithoutFlag+    PsErrOrPatInExpr{}                            -> ErrorWithoutFlag     PsErrCaseCmdInFunAppCmd{}                     -> ErrorWithoutFlag     PsErrLambdaCmdInFunAppCmd{}                   -> ErrorWithoutFlag     PsErrIfCmdInFunAppCmd{}                       -> ErrorWithoutFlag@@ -646,6 +687,8 @@     PsErrMultipleConForNewtype {}                 -> ErrorWithoutFlag     PsErrUnicodeCharLooksLike{}                   -> ErrorWithoutFlag     PsErrInvalidPun {}                            -> ErrorWithoutFlag+    PsErrIllegalOrPat{}                           -> ErrorWithoutFlag+    PsErrTypeSyntaxInPat{}                        -> ErrorWithoutFlag    diagnosticHints = \case     PsUnknownMessage m                            -> diagnosticHints m@@ -668,6 +711,7 @@     PsWarnMisplacedPragma{}                       -> [SuggestPlacePragmaInHeader]     PsWarnImportPreQualified                      -> [ SuggestQualifiedAfterModuleName                                                      , suggestExtension LangExt.ImportQualifiedPost]+    PsWarnViewPatternSignatures{}                 -> [SuggestParenthesizePatternRHS]     PsErrLexer{}                                  -> noHints     PsErrCmmLexer                                 -> noHints     PsErrCmmParser{}                              -> noHints@@ -699,10 +743,8 @@     PsErrOverloadedRecordDotInvalid{}             -> noHints     PsErrIllegalPatSynExport                      -> [suggestExtension LangExt.PatternSynonyms]     PsErrOverloadedRecordUpdateNoQualifiedFields  -> noHints-    PsErrExplicitForall is_unicode                ->-      let info = text "or a similar language extension to enable explicit-forall syntax:" <+>-                 forallSym is_unicode <+> text "<tvs>. <type>"-      in [ suggestExtensionWithInfo info LangExt.RankNTypes ]+    PsErrExplicitForall is_unicode                -> [useExtensionInOrderTo info LangExt.ExplicitForAll]+      where info = "to enable syntax:" <+> forallSym is_unicode <+> angleBrackets "tvs" <> dot <+> angleBrackets "type"     PsErrIllegalQualifiedDo{}                     -> [suggestExtension LangExt.QualifiedDo]     PsErrQualifiedDoInCmd{}                       -> noHints     PsErrRecordSyntaxInPatSynDecl{}               -> noHints@@ -743,7 +785,7 @@     PsErrArrowExprInPat{}                         -> noHints     PsErrArrowCmdInPat{}                          -> noHints     PsErrArrowCmdInExpr{}                         -> noHints-    PsErrViewPatInExpr{}                          -> noHints+    PsErrOrPatInExpr{}                            -> noHints     PsErrLambdaCmdInFunAppCmd{}                   -> suggestParensAndBlockArgs     PsErrCaseCmdInFunAppCmd{}                     -> suggestParensAndBlockArgs     PsErrIfCmdInFunAppCmd{}                       -> suggestParensAndBlockArgs@@ -757,9 +799,7 @@     PsErrIfInFunAppExpr{}                         -> suggestParensAndBlockArgs     PsErrProcInFunAppExpr{}                       -> suggestParensAndBlockArgs     PsErrMalformedTyOrClDecl{}                    -> noHints-    PsErrIllegalWhereInDataDecl                   ->-      [ suggestExtensionWithInfo (text "or a similar language extension to enable syntax: data T where")-                                 LangExt.GADTs ]+    PsErrIllegalWhereInDataDecl                   -> [useExtensionInOrderTo "to enable syntax: data T where" LangExt.GADTSyntax]     PsErrIllegalDataTypeContext{}                 -> [suggestExtension LangExt.DatatypeContexts]     PsErrPrimStringInvalidChar                    -> noHints     PsErrSuffixAT                                 -> noHints@@ -816,6 +856,8 @@     PsErrMultipleConForNewtype {}                 -> noHints     PsErrUnicodeCharLooksLike{}                   -> noHints     PsErrInvalidPun {}                            -> [suggestExtension LangExt.ListTuplePuns]+    PsErrIllegalOrPat{}                           -> [suggestExtension LangExt.OrPatterns]+    PsErrTypeSyntaxInPat{}                        -> noHints    diagnosticCode = constructorCode
compiler/GHC/Parser/Errors/Types.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}  module GHC.Parser.Errors.Types where @@ -141,6 +142,23 @@     | PsWarnOperatorWhitespace !FastString !OperatorWhitespaceOccurrence +   {- | PsWarnViewPatternSignatures is a warning triggered by view patterns whose+        RHS is an unparenthesised pattern signature. It warns on code that is+        highly likely to break when the precedence of view patterns relative to+        pattern signatures is changed per GHC Proposal #281. The suggested fix+        is to add parentheses.++        Example:+          f1 (isJust -> True :: Bool) = ()++        Suggested fix:+          f1 (isJust -> (True :: Bool)) = ()++        Test cases:+          T24159_viewpat+   -}+   | PsWarnViewPatternSignatures !(LPat GhcPs) !(LPat GhcPs)+    -- | LambdaCase syntax used without the extension enabled    | PsErrLambdaCase @@ -267,8 +285,8 @@    -- | Arrow command-syntax in expression    | PsErrArrowCmdInExpr !(HsCmd GhcPs) -   -- | View-pattern in expression-   | PsErrViewPatInExpr !(LHsExpr GhcPs) !(LHsExpr GhcPs)+   -- | Or-pattern in expression+   | PsErrOrPatInExpr !(LPat GhcPs)     -- | Type-application without space before '@'    | PsErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs)@@ -461,6 +479,18 @@     | PsErrInvalidPun !PsErrPunDetails +   -- | Or pattern used without -XOrPatterns+   | PsErrIllegalOrPat (LPat GhcPs)++   -- | Temporary error until GHC gains support for type syntax in patterns.+   --   Test cases: T24159_pat_parse_error_1+   --               T24159_pat_parse_error_2+   --               T24159_pat_parse_error_3+   --               T24159_pat_parse_error_4+   --               T24159_pat_parse_error_5+   --               T24159_pat_parse_error_6+   | PsErrTypeSyntaxInPat !PsErrTypeSyntaxDetails+    deriving Generic  -- | Extra details about a parse error, which helps@@ -521,6 +551,19 @@   | PEP_TupleSyntaxType   | PEP_SumSyntaxType +data PsErrTypeSyntaxDetails+  = PETS_FunctionArrow+      !(LocatedA (PatBuilder GhcPs))+      !(HsArrowOf (LocatedA (PatBuilder GhcPs)) GhcPs)+      !(LocatedA (PatBuilder GhcPs))+  | PETS_Multiplicity+      !(EpToken "%")+      !(LocatedA (PatBuilder GhcPs))+  | PETS_ForallTelescope+      !(HsForAllTelescope GhcPs)+      !(LocatedA (PatBuilder GhcPs))+  | PETS_ConstraintContext !(LocatedA (PatBuilder GhcPs))+ noParseContext :: ParseContext noParseContext = ParseContext Nothing NoIncompleteDoBlock @@ -548,8 +591,6 @@    | LexUnknownPragma       -- ^ Unknown pragma    | LexErrorInPragma       -- ^ Lexical error in pragma    | LexNumEscapeRange      -- ^ Numeric escape sequence out of range-   | LexStringCharLit       -- ^ Lexical error in string/character literal-   | LexStringCharLitEOF    -- ^ Unexpected end-of-file in string/character literal    | LexUnterminatedComment -- ^ Unterminated `{-'    | LexUnterminatedOptions -- ^ Unterminated OPTIONS pragma    | LexUnterminatedQQ      -- ^ Unterminated quasiquotation
compiler/GHC/Parser/Header.hs view
@@ -136,10 +136,11 @@        is_prelude_import (L _ decl) =         unLoc (ideclName decl) == pRELUDE_NAME-        -- allow explicit "base" package qualifier (#19082, #17045)+        -- See #17045, package qualified imports are never counted as+        -- explicit prelude imports         && case ideclPkgQual decl of             NoRawPkgQual -> True-            RawPkgQual b -> sl_fs b == unitIdFS baseUnitId+            RawPkgQual {} -> False         loc' = noAnnSrcSpan loc
compiler/GHC/Parser/Lexer.x view
@@ -48,6 +48,7 @@ {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnliftedNewtypes #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DataKinds #-}   {-# OPTIONS_GHC -funbox-strict-fields #-}@@ -59,7 +60,7 @@    PState (..), initParserState, initPragState,    P(..), ParseResult(POk, PFailed),    allocateComments, allocatePriorComments, allocateFinalComments,-   MonadP(..),+   MonadP(..), getBit,    getRealSrcLoc, getPState,    failMsgP, failLocMsgP, srcParseFail,    getPsErrorMessages, getPsMessages,@@ -70,7 +71,8 @@    xtest, xunset, xset,    disableHaddock,    lexTokenStream,-   mkParensEpAnn,+   mkParensEpToks,+   mkParensLocs,    getCommentsFor, getPriorCommentsFor, getFinalCommentsFor,    getEofPos,    commentToAnnotation,@@ -130,6 +132,7 @@ import GHC.Parser.Errors.Basic import GHC.Parser.Errors.Types import GHC.Parser.Errors.Ppr ()+import GHC.Parser.String }  -- -----------------------------------------------------------------------------@@ -139,7 +142,8 @@ -- Any changes here should likely be reflected there. $unispace    = \x05 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $nl          = [\n\r\f]-$whitechar   = [$nl\v\ $unispace]+$space       = [\ $unispace]+$whitechar   = [$nl \v $space] $white_no_nl = $whitechar # \n -- TODO #8424 $tab         = \t @@ -166,6 +170,7 @@  $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic   = [$small $large $symbol $digit $idchar $special $unigraphic \"\']+$charesc   = [a b f n r t v \\ \" \' \&]  $binit     = 0-1 $octit     = 0-7@@ -212,6 +217,20 @@ @floating_point = @numspc @decimal \. @decimal @exponent? | @numspc @decimal @exponent @hex_floating_point = @numspc @hexadecimal \. @hexadecimal @bin_exponent? | @numspc @hexadecimal @bin_exponent +@gap = \\ $whitechar+ \\+@cntrl = $asclarge | \@ | \[ | \\ | \] | \^ | \_+@ascii = \^ @cntrl | "NUL" | "SOH" | "STX" | "ETX" | "EOT" | "ENQ" | "ACK"+       | "BEL" | "BS" | "HT" | "LF" | "VT" | "FF" | "CR" | "SO" | "SI" | "DLE"+       | "DC1" | "DC2" | "DC3" | "DC4" | "NAK" | "SYN" | "ETB" | "CAN"+       | "EM" | "SUB" | "ESC" | "FS" | "GS" | "RS" | "US" | "SP" | "DEL"+-- N.B. ideally, we would do `@escape # \\ \&` instead of duplicating in @escapechar,+-- which is what the Haskell Report says, but this isn't valid Alex syntax, as only+-- character sets can be subtracted, not strings+@escape     = \\ ( $charesc      | @ascii | @decimal | o @octal | x @hexadecimal )+@escapechar = \\ ( $charesc # \& | @ascii | @decimal | o @octal | x @hexadecimal )+@stringchar = ($graphic # [\\ \"]) | $space | @escape     | @gap+@char       = ($graphic # [\\ \']) | $space | @escapechar+ -- normal signed numerical literals can only be explicitly negative, -- not explicitly positive (contrast @exponent) @negative = \-@@ -459,7 +478,7 @@  <0> {   "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid }-  "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label }+  "#" \" @stringchar* \" / { ifExtension OverloadedLabelsBit } { tok_quoted_label } }  <0> {@@ -561,108 +580,63 @@   @octallit                 \# \# / { ifExtension MagicHashBit }        { tok_primword 2 4 octal }   @hexadecimallit           \# \# / { ifExtension MagicHashBit }        { tok_primword 2 4 hexadecimal } +  @decimal                  \# $idchar+  / { ifExtension ExtendedLiteralsBit } { tok_prim_num_ext positive 0 decimal }+  @binarylit                \# $idchar+  / { ifExtension ExtendedLiteralsBit `alexAndPred`+                                             ifExtension BinaryLiteralsBit }   { tok_prim_num_ext positive 2 binary }+  @octallit                 \# $idchar+  / { ifExtension ExtendedLiteralsBit } { tok_prim_num_ext positive 2 octal }+  @hexadecimallit           \# $idchar+  / { ifExtension ExtendedLiteralsBit } { tok_prim_num_ext positive 2 hexadecimal }+  @negative @decimal        \# $idchar+  / { negHashLitPred ExtendedLiteralsBit } { tok_prim_num_ext negative 1 decimal }+  @negative @binarylit      \# $idchar+  / { negHashLitPred ExtendedLiteralsBit `alexAndPred`+                                             ifExtension BinaryLiteralsBit }   { tok_prim_num_ext negative 3 binary }+  @negative @octallit       \# $idchar+  / { negHashLitPred ExtendedLiteralsBit } { tok_prim_num_ext negative 3 octal }+  @negative @hexadecimallit \# $idchar+  / { negHashLitPred ExtendedLiteralsBit } { tok_prim_num_ext negative 3 hexadecimal }++   -- Unboxed floats and doubles (:: Float#, :: Double#)   -- prim_{float,double} work with signed literals   @floating_point                  \# / { ifExtension MagicHashBit }        { tok_frac 1 tok_primfloat }   @floating_point               \# \# / { ifExtension MagicHashBit }        { tok_frac 2 tok_primdouble }-   @negative @floating_point        \# / { negHashLitPred MagicHashBit }     { tok_frac 1 tok_primfloat }   @negative @floating_point     \# \# / { negHashLitPred MagicHashBit }     { tok_frac 2 tok_primdouble }--  @decimal                  \#"Int8"   / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 0 decimal }-  @binarylit                \#"Int8"   / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint8 positive 2 binary }-  @octallit                 \#"Int8"   / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 2 octal }-  @hexadecimallit           \#"Int8"   / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 2 hexadecimal }-  @negative @decimal        \#"Int8"   / { negHashLitPred ExtendedLiteralsBit } { tok_primint8 negative 1 decimal }-  @negative @binarylit      \#"Int8"   / { negHashLitPred ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint8 negative 3 binary }-  @negative @octallit       \#"Int8"   / { negHashLitPred ExtendedLiteralsBit } { tok_primint8 negative 3 octal }-  @negative @hexadecimallit \#"Int8"   / { negHashLitPred ExtendedLiteralsBit } { tok_primint8 negative 3 hexadecimal }--  @decimal                  \#"Int16"  / { ifExtension ExtendedLiteralsBit } { tok_primint16 positive 0 decimal }-  @binarylit                \#"Int16"  / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint16 positive 2 binary }-  @octallit                 \#"Int16"  / { ifExtension ExtendedLiteralsBit } { tok_primint16 positive 2 octal }-  @hexadecimallit           \#"Int16"  / { ifExtension ExtendedLiteralsBit } { tok_primint16 positive 2 hexadecimal }-  @negative @decimal        \#"Int16"  / { negHashLitPred ExtendedLiteralsBit} { tok_primint16 negative 1 decimal }-  @negative @binarylit      \#"Int16"  / { negHashLitPred ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint16 negative 3 binary }-  @negative @octallit       \#"Int16"  / { negHashLitPred ExtendedLiteralsBit} { tok_primint16 negative 3 octal }-  @negative @hexadecimallit \#"Int16"  / { negHashLitPred ExtendedLiteralsBit} { tok_primint16 negative 3 hexadecimal }--  @decimal                  \#"Int32"  / { ifExtension ExtendedLiteralsBit } { tok_primint32 positive 0 decimal }-  @binarylit                \#"Int32"  / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint32 positive 2 binary }-  @octallit                 \#"Int32"  / { ifExtension ExtendedLiteralsBit } { tok_primint32 positive 2 octal }-  @hexadecimallit           \#"Int32"  / { ifExtension ExtendedLiteralsBit } { tok_primint32 positive 2 hexadecimal }-  @negative @decimal        \#"Int32"  / { negHashLitPred ExtendedLiteralsBit } { tok_primint32 negative 1 decimal }-  @negative @binarylit      \#"Int32"  / { negHashLitPred ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint32 negative 3 binary }-  @negative @octallit       \#"Int32"  / { negHashLitPred ExtendedLiteralsBit} { tok_primint32 negative 3 octal }-  @negative @hexadecimallit \#"Int32"  / { negHashLitPred ExtendedLiteralsBit} { tok_primint32 negative 3 hexadecimal }--  @decimal                  \#"Int64"  / { ifExtension ExtendedLiteralsBit } { tok_primint64 positive 0 decimal }-  @binarylit                \#"Int64"  / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint64 positive 2 binary }-  @octallit                 \#"Int64"  / { ifExtension ExtendedLiteralsBit } { tok_primint64 positive 2 octal }-  @hexadecimallit           \#"Int64"  / { ifExtension ExtendedLiteralsBit } { tok_primint64 positive 2 hexadecimal }-  @negative @decimal        \#"Int64"  / { negHashLitPred ExtendedLiteralsBit } { tok_primint64 negative 1 decimal }-  @negative @binarylit      \#"Int64"  / { negHashLitPred ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint64 negative 3 binary }-  @negative @octallit       \#"Int64"  / { negHashLitPred ExtendedLiteralsBit } { tok_primint64 negative 3 octal }-  @negative @hexadecimallit \#"Int64"  / { negHashLitPred ExtendedLiteralsBit } { tok_primint64 negative 3 hexadecimal }--  @decimal                  \#"Int"    / { ifExtension ExtendedLiteralsBit } { tok_primint positive 0 4 decimal }-  @binarylit                \#"Int"    / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint positive 2 6 binary }-  @octallit                 \#"Int"    / { ifExtension ExtendedLiteralsBit } { tok_primint positive 2 6 octal }-  @hexadecimallit           \#"Int"    / { ifExtension ExtendedLiteralsBit } { tok_primint positive 2 6 hexadecimal }-  @negative @decimal        \#"Int"    / { negHashLitPred ExtendedLiteralsBit } { tok_primint negative 1 5 decimal }-  @negative @binarylit      \#"Int"    / { negHashLitPred ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primint negative 3 7 binary }-  @negative @octallit       \#"Int"    / { negHashLitPred ExtendedLiteralsBit } { tok_primint negative 3 7 octal }-  @negative @hexadecimallit \#"Int"    / { negHashLitPred ExtendedLiteralsBit } { tok_primint negative 3 7 hexadecimal }--  @decimal                  \#"Word8"  / { ifExtension ExtendedLiteralsBit } { tok_primword8 0 decimal }-  @binarylit                \#"Word8"  / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primword8 2 binary }-  @octallit                 \#"Word8"  / { ifExtension ExtendedLiteralsBit } { tok_primword8 2 octal }-  @hexadecimallit           \#"Word8"  / { ifExtension ExtendedLiteralsBit } { tok_primword8 2 hexadecimal }--  @decimal                  \#"Word16" / { ifExtension ExtendedLiteralsBit } { tok_primword16 0 decimal }-  @binarylit                \#"Word16" / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primword16 2 binary }-  @octallit                 \#"Word16" / { ifExtension ExtendedLiteralsBit } { tok_primword16 2 octal }-  @hexadecimallit           \#"Word16" / { ifExtension ExtendedLiteralsBit } { tok_primword16 2 hexadecimal }+  0[xX] @numspc @hex_floating_point \# / { ifExtension MagicHashBit `alexAndPred` ifExtension HexFloatLiteralsBit } { tok_frac 1 tok_prim_hex_float }+  0[xX] @numspc @hex_floating_point \# \# / { ifExtension MagicHashBit `alexAndPred` ifExtension HexFloatLiteralsBit } { tok_frac 2 tok_prim_hex_double }+  @negative 0[xX] @numspc @hex_floating_point \# / { ifExtension HexFloatLiteralsBit `alexAndPred` negHashLitPred MagicHashBit } { tok_frac 1 tok_prim_hex_float }+  @negative 0[xX] @numspc @hex_floating_point \# \# / { ifExtension HexFloatLiteralsBit `alexAndPred` negHashLitPred MagicHashBit } { tok_frac 2 tok_prim_hex_double } -  @decimal                  \#"Word32" / { ifExtension ExtendedLiteralsBit } { tok_primword32 0 decimal }-  @binarylit                \#"Word32" / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primword32 2 binary }-  @octallit                 \#"Word32" / { ifExtension ExtendedLiteralsBit } { tok_primword32 2 octal }-  @hexadecimallit           \#"Word32" / { ifExtension ExtendedLiteralsBit } { tok_primword32 2 hexadecimal }+} -  @decimal                  \#"Word64" / { ifExtension ExtendedLiteralsBit } { tok_primword64 0 decimal }-  @binarylit                \#"Word64" / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primword64 2 binary }-  @octallit                 \#"Word64" / { ifExtension ExtendedLiteralsBit } { tok_primword64 2 octal }-  @hexadecimallit           \#"Word64" / { ifExtension ExtendedLiteralsBit } { tok_primword64 2 hexadecimal }+<0> {+  \"\"\" / { ifExtension MultilineStringsBit }         { tok_string_multi }+  \" @stringchar* \"                                   { tok_string }+  \" @stringchar* \" \# / { ifExtension MagicHashBit } { tok_string }+  \' @char        \'                                   { tok_char }+  \' @char        \' \# / { ifExtension MagicHashBit } { tok_char } -  @decimal                  \#"Word"   / { ifExtension ExtendedLiteralsBit } { tok_primword 0 5 decimal }-  @binarylit                \#"Word"   / { ifExtension ExtendedLiteralsBit `alexAndPred`-                                           ifExtension BinaryLiteralsBit }   { tok_primword 2 7 binary }-  @octallit                 \#"Word"   / { ifExtension ExtendedLiteralsBit } { tok_primword 2 7 octal }-  @hexadecimallit           \#"Word"   / { ifExtension ExtendedLiteralsBit } { tok_primword 2 7 hexadecimal }+  -- Check for smart quotes and throw better errors than a plain lexical error (#21843)+  \'              \\ $unigraphic / { isSmartQuote } { smart_quote_error }+  \" @stringchar* \\ $unigraphic / { isSmartQuote } { smart_quote_error }+  -- See Note [Bare smart quote error]+  -- The valid string rule will take precedence because it'll match more+  -- characters than this rule, so this rule will only fire if the string+  -- could not be lexed correctly+  \" @stringchar*    $unigraphic / { isSmartQuote } { smart_quote_error }+} +<string_multi_content> {+  -- Parse as much of the multiline string as possible, except for quotes+  @stringchar* ($nl ([\  $tab] | @gap)* @stringchar*)* { tok_string_multi_content }+  -- Allow bare quotes if it's not a triple quote+  (\" | \"\") / ([\n .] # \") { tok_string_multi_content } } --- Strings and chars are lexed by hand-written code.  The reason is--- that even if we recognise the string or char here in the regex--- lexer, we would still have to parse the string afterward in order--- to convert it to a String. <0> {-  \'                            { lex_char_tok }-  \"                            { lex_string_tok }+  \'\' { token ITtyQuote }++  -- The normal character match takes precedence over this because it matches+  -- more characters. However, if that pattern didn't match, then this quote+  -- could be a quoted identifier, like 'x. Here, just return ITsimpleQuote,+  -- as the parser will lex the varid separately.+  \' / ($graphic # \\ | " ") { token ITsimpleQuote } }  -- Note [Whitespace-sensitive operator parsing]@@ -860,7 +834,7 @@   | ITdependency   | ITrequires -  -- Pragmas, see  Note [Pragma source text] in "GHC.Types.SourceText"+  -- Pragmas, see Note [Pragma source text] in "GHC.Types.SourceText"   | ITinline_prag       SourceText InlineSpec RuleMatchInfo   | ITopaque_prag       SourceText   | ITspec_prag         SourceText                -- SPECIALISE@@ -948,6 +922,7 @@    | ITchar     SourceText Char       -- Note [Literal source text] in "GHC.Types.SourceText"   | ITstring   SourceText FastString -- Note [Literal source text] in "GHC.Types.SourceText"+  | ITstringMulti SourceText FastString -- Note [Literal source text] in "GHC.Types.SourceText"   | ITinteger  IntegralLit           -- Note [Literal source text] in "GHC.Types.SourceText"   | ITrational FractionalLit @@ -1899,22 +1874,57 @@     !fs = lexemeToFastString buf len  -- Variations on the integral numeric literal.-tok_integral :: (SourceText -> Integer -> Token)-             -> (Integer -> Integer)-             -> Int -> Int-             -> (Integer, (Char -> Int))-             -> Action-tok_integral itint transint transbuf translen (radix,char_to_int) span buf len _buf2 = do+tok_integral+  :: (SourceText -> Integer -> Token) -- ^ token constructor+  -> (Integer -> Integer)             -- ^ value transformation (e.g. negate)+  -> Int                              -- ^ Offset of the unsigned value (e.g. 1 when we parsed "-", 2 for "0x", etc.)+  -> Int                              -- ^ Number of non-numeric characters parsed (e.g. 6 in "-12#Int8")+  -> (Integer, (Char -> Int))         -- ^ (radix, char_to_int parsing function)+  -> Action+tok_integral mk_token transval offset translen (radix,char_to_int) span buf len _buf2 = do   numericUnderscores <- getBit NumericUnderscoresBit  -- #14473   let src = lexemeToFastString buf len   when ((not numericUnderscores) && ('_' `elem` unpackFS src)) $ do     pState <- getPState     let msg = PsErrNumUnderscores NumUnderscore_Integral     addError $ mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg-  return $ L span $ itint (SourceText src)-       $! transint $ parseUnsignedInteger-       (offsetBytes transbuf buf) (subtract translen len) radix char_to_int+  return $ L span $ mk_token (SourceText src)+       $! transval $ parseUnsignedInteger+       (offsetBytes offset buf) (subtract translen len) radix char_to_int +-- | Helper to parse ExtendedLiterals (e.g. -0x10#Word32)+--+-- This function finds the offset of the "#" character and checks that the+-- suffix is valid. Then it calls tok_integral with the appropriate suffix+-- length taken into account.+tok_prim_num_ext+  :: (Integer -> Integer)             -- ^ value transformation (e.g. negate)+  -> Int                              -- ^ Offset of the unsigned value (e.g. 1 when we parsed "-", 2 for "0x", etc.)+  -> (Integer, (Char -> Int))         -- ^ (radix, char_to_int parsing function)+  -> Action+tok_prim_num_ext transval offset (radix,char_to_int) span buf len buf2 = do+  let !suffix_offset = findHashOffset buf + 1+  let !suffix_len    = len - suffix_offset+  let !suffix        = lexemeToFastString (offsetBytes suffix_offset buf) suffix_len++  mk_token <- if+    | suffix == fsLit "Word"   -> pure ITprimword+    | suffix == fsLit "Word8"  -> pure ITprimword8+    | suffix == fsLit "Word16" -> pure ITprimword16+    | suffix == fsLit "Word32" -> pure ITprimword32+    | suffix == fsLit "Word64" -> pure ITprimword64+    | suffix == fsLit "Int"    -> pure ITprimint+    | suffix == fsLit "Int8"   -> pure ITprimint8+    | suffix == fsLit "Int16"  -> pure ITprimint16+    | suffix == fsLit "Int32"  -> pure ITprimint32+    | suffix == fsLit "Int64"  -> pure ITprimint64+    | otherwise                -> srcParseFail++  let !translen      = suffix_len+offset+1+  tok_integral mk_token transval offset translen (radix,char_to_int) span buf len buf2+++ tok_num :: (Integer -> Integer)         -> Int -> Int         -> (Integer, (Char->Int)) -> Action@@ -1935,48 +1945,16 @@ tok_primword :: Int -> Int              -> (Integer, (Char->Int)) -> Action tok_primword = tok_integral ITprimword positive+ positive, negative :: (Integer -> Integer) positive = id negative = negate-decimal, octal, hexadecimal :: (Integer, Char -> Int)-decimal = (10,octDecDigit)-binary = (2,octDecDigit)-octal = (8,octDecDigit)-hexadecimal = (16,hexDigit) --- | Helper for defining @IntX@ primitive literal parsers (specifically for---   the ExtendedLiterals extension, such as @123#Int8@).-tok_primintX :: (SourceText -> Integer -> Token)-             -> Int-             -> (Integer -> Integer)-             -> Int-             -> (Integer, (Char->Int)) -> Action-tok_primintX itint addlen transint transbuf =-    tok_integral itint transint transbuf (transbuf+addlen)--tok_primint8,     tok_primint16,  tok_primint32,  tok_primint64-    :: (Integer -> Integer)-    -> Int -> (Integer, (Char->Int)) -> Action-tok_primint8  = tok_primintX ITprimint8   5-tok_primint16 = tok_primintX ITprimint16  6-tok_primint32 = tok_primintX ITprimint32  6-tok_primint64 = tok_primintX ITprimint64  6---- | Helper for defining @WordX@ primitive literal parsers (specifically for---   the ExtendedLiterals extension, such as @234#Word8@).-tok_primwordX :: (SourceText -> Integer -> Token)-              -> Int-              -> Int-              -> (Integer, (Char->Int)) -> Action-tok_primwordX itint addlen transbuf =-    tok_integral itint positive transbuf (transbuf+addlen)--tok_primword8, tok_primword16, tok_primword32, tok_primword64-    :: Int -> (Integer, (Char->Int)) -> Action-tok_primword8  = tok_primwordX ITprimword8  6-tok_primword16 = tok_primwordX ITprimword16 7-tok_primword32 = tok_primwordX ITprimword32 7-tok_primword64 = tok_primwordX ITprimword64 7+binary, octal, decimal, hexadecimal :: (Integer, Char -> Int)+binary      = (2,octDecDigit)+octal       = (8,octDecDigit)+decimal     = (10,octDecDigit)+hexadecimal = (16,hexDigit)  -- readSignificandExponentPair can understand negative rationals, exponents, everything. tok_frac :: Int -> (String -> Token) -> Action@@ -1989,11 +1967,13 @@     addError $ mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg   return (L span $! (f $! src)) -tok_float, tok_primfloat, tok_primdouble :: String -> Token+tok_float, tok_primfloat, tok_primdouble, tok_prim_hex_float, tok_prim_hex_double :: String -> Token tok_float        str = ITrational   $! readFractionalLit str tok_hex_float    str = ITrational   $! readHexFractionalLit str tok_primfloat    str = ITprimfloat  $! readFractionalLit str tok_primdouble   str = ITprimdouble $! readFractionalLit str+tok_prim_hex_float  str = ITprimfloat $! readHexFractionalLit str+tok_prim_hex_double str = ITprimdouble $! readHexFractionalLit str  readFractionalLit, readHexFractionalLit :: String -> FractionalLit readHexFractionalLit = readFractionalLitX readHexSignificandExponentPair Base2@@ -2173,293 +2153,129 @@ -- ----------------------------------------------------------------------------- -- Strings & Chars --- This stuff is horrible.  I hates it.--lex_string_tok :: Action-lex_string_tok span buf _len _buf2 = do-  lexed <- lex_string-  (AI end bufEnd) <- getInput-  let-    tok = case lexed of-      LexedPrimString s -> ITprimstring (SourceText src) (unsafeMkByteString s)-      LexedRegularString s -> ITstring (SourceText src) (mkFastString s)-    src = lexemeToFastString buf (cur bufEnd - cur buf)-  return $ L (mkPsSpan (psSpanStart span) end) tok---lex_quoted_label :: Action-lex_quoted_label span buf _len _buf2 = do-  start <- getInput-  s <- lex_string_helper "" start-  (AI end bufEnd) <- getInput-  let-    token = ITlabelvarid (SourceText src) (mkFastString s)-    src = lexemeToFastString (stepOn buf) (cur bufEnd - cur buf - 1)-    start = psSpanStart span--  return $ L (mkPsSpan start end) token---data LexedString = LexedRegularString String | LexedPrimString String+tok_string :: Action+tok_string span buf len _buf2 = do+  s <- lex_chars ("\"", "\"") span buf (if endsInHash then len - 1 else len) -lex_string :: P LexedString-lex_string = do-  start <- getInput-  s <- lex_string_helper "" start-  magicHash <- getBit MagicHashBit-  if magicHash+  if endsInHash     then do-      i <- getInput-      case alexGetChar' i of-        Just ('#',i) -> do-          setInput i-          when (any (> '\xFF') s) $ do-            pState <- getPState-            let msg = PsErrPrimStringInvalidChar-            let err = mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg-            addError err-          return $ LexedPrimString s-        _other ->-          return $ LexedRegularString s+      when (any (> '\xFF') s) $ do+        pState <- getPState+        let msg = PsErrPrimStringInvalidChar+        let err = mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg+        addError err+      pure $ L span (ITprimstring src (unsafeMkByteString s))     else-      return $ LexedRegularString s---lex_string_helper :: String -> AlexInput -> P String-lex_string_helper s start = do-  i <- getInput-  case alexGetChar' i of-    Nothing -> lit_error i--    Just ('"',i)  -> do-      setInput i-      return (reverse s)--    Just ('\\',i)-        | Just ('&',i) <- next -> do-                setInput i; lex_string_helper s start-        | Just (c,i) <- next, c <= '\x7f' && is_space c -> do-                           -- is_space only works for <= '\x7f' (#3751, #5425)-                setInput i; lex_stringgap s start-        where next = alexGetChar' i--    Just (c, i1) -> do-        case c of-          '\\' -> do setInput i1; c' <- lex_escape; lex_string_helper (c':s) start-          c | isAny c -> do setInput i1; lex_string_helper (c:s) start-          _other | any isDoubleSmartQuote s -> do-            -- if the built-up string s contains a smart double quote character, it was-            -- likely the reason why the string literal was not lexed correctly-            setInput start -- rewind to the first character in the string literal-                           -- so we can find the smart quote character's location-            advance_to_smart_quote_character-            i2@(AI loc _) <- getInput-            case alexGetChar' i2 of-              Just (c, _) -> do add_nonfatal_smart_quote_error c loc; lit_error i-              Nothing -> lit_error i -- should never get here-          _other -> lit_error i---lex_stringgap :: String -> AlexInput -> P String-lex_stringgap s start = do-  i <- getInput-  c <- getCharOrFail i-  case c of-    '\\' -> lex_string_helper s start-    c | c <= '\x7f' && is_space c -> lex_stringgap s start-                           -- is_space only works for <= '\x7f' (#3751, #5425)-    _other -> lit_error i---lex_char_tok :: Action--- Here we are basically parsing character literals, such as 'x' or '\n'--- but we additionally spot 'x and ''T, returning ITsimpleQuote and--- ITtyQuote respectively, but WITHOUT CONSUMING the x or T part--- (the parser does that).--- So we have to do two characters of lookahead: when we see 'x we need to--- see if there's a trailing quote-lex_char_tok span buf _len _buf2 = do        -- We've seen '-   i1 <- getInput       -- Look ahead to first character-   let loc = psSpanStart span-   case alexGetChar' i1 of-        Nothing -> lit_error  i1+      pure $ L span (ITstring src (mkFastString s))+  where+    src = SourceText $ lexemeToFastString buf len+    endsInHash = currentChar (offsetBytes (len - 1) buf) == '#' -        Just ('\'', i2@(AI end2 _)) -> do       -- We've seen ''-                   setInput i2-                   return (L (mkPsSpan loc end2)  ITtyQuote)+-- | Ideally, we would define this completely with Alex syntax, like normal strings.+-- Instead, this is defined as a hybrid solution by manually invoking lex states, which+-- we're doing for two reasons:+--   1. The multiline string should all be one lexical token, not multiple+--   2. We need to allow bare quotes, which can't be done with one regex+tok_string_multi :: Action+tok_string_multi startSpan startBuf _len _buf2 = do+  -- advance to the end of the multiline string+  let startLoc = psSpanStart startSpan+  let i@(AI _ contentStartBuf) =+        case lexDelim $ AI startLoc startBuf of+          Just i -> i+          Nothing -> panic "tok_string_multi did not start with a delimiter"+  (AI _ contentEndBuf, i'@(AI endLoc endBuf)) <- goContent i -        Just ('\\', i2@(AI end2 _)) -> do      -- We've seen 'backslash-                  setInput i2-                  lit_ch <- lex_escape-                  i3 <- getInput-                  mc <- getCharOrFail i3 -- Trailing quote-                  if mc == '\'' then finish_char_tok buf loc lit_ch-                  else if isSingleSmartQuote mc then add_smart_quote_error mc end2-                  else lit_error i3+  -- build the values pertaining to the entire multiline string, including delimiters+  let span = mkPsSpan startLoc endLoc+  let len = byteDiff startBuf endBuf+  let src = SourceText $ lexemeToFastString startBuf len -        Just (c, i2@(AI end2 _))-                | not (isAny c) -> lit_error i1-                | otherwise ->+  -- load the content of the multiline string+  let contentLen = byteDiff contentStartBuf contentEndBuf+  s <-+    either (throwStringLexError (AI startLoc startBuf)) pure $+      lexMultilineString contentLen contentStartBuf -                -- We've seen 'x, where x is a valid character-                --  (i.e. not newline etc) but not a quote or backslash-           case alexGetChar' i2 of      -- Look ahead one more character-                Just ('\'', i3) -> do   -- We've seen 'x'-                        setInput i3-                        finish_char_tok buf loc c-                Just (c, _) | isSingleSmartQuote c -> add_smart_quote_error c end2-                _other -> do            -- We've seen 'x not followed by quote-                                        -- (including the possibility of EOF)-                                        -- Just parse the quote only-                        let (AI end _) = i1-                        return (L (mkPsSpan loc end) ITsimpleQuote)+  setInput i'+  pure $ L span $ ITstringMulti src (mkFastString s)+  where+    goContent i0 =+      case alexScan i0 string_multi_content of+        AlexToken i1 len _+          | Just i2 <- lexDelim i1 -> pure (i1, i2)+          | isEOF i1 -> checkSmartQuotes >> setInput i1 >> lexError LexError+          -- is the next token a tab character?+          -- need this explicitly because there's a global rule matching $tab+          | Just ('\t', _) <- alexGetChar' i1 -> setInput i1 >> lexError LexError+          -- Can happen if no patterns match, e.g. an unterminated gap+          | len == 0  -> setInput i1 >> lexError LexError+          | otherwise -> goContent i1+        AlexSkip i1 _ -> goContent i1+        _ -> setInput i0 >> lexError LexError -finish_char_tok :: StringBuffer -> PsLoc -> Char -> P (PsLocated Token)-finish_char_tok buf loc ch  -- We've already seen the closing quote-                        -- Just need to check for trailing #-  = do  magicHash <- getBit MagicHashBit-        i@(AI end bufEnd) <- getInput-        let src = lexemeToFastString buf (cur bufEnd - cur buf)-        if magicHash then do+    lexDelim =+      let go 0 i = Just i+          go n i =             case alexGetChar' i of-              Just ('#',i@(AI end bufEnd')) -> do-                setInput i-                -- Include the trailing # in SourceText-                let src' = lexemeToFastString buf (cur bufEnd' - cur buf)-                return (L (mkPsSpan loc end)-                          (ITprimchar (SourceText src') ch))-              _other ->-                return (L (mkPsSpan loc end)-                          (ITchar (SourceText src) ch))-            else do-              return (L (mkPsSpan loc end) (ITchar (SourceText src) ch))+              Just ('"', i') -> go (n - 1) i'+              _ -> Nothing+       in go (3 :: Int) -isAny :: Char -> Bool-isAny c | c > '\x7f' = isPrint c-        | otherwise  = is_any c+    -- See Note [Bare smart quote error]+    checkSmartQuotes = do+      let findSmartQuote i0@(AI loc _) =+            case alexGetChar' i0 of+              Just ('\\', i1) | Just (_, i2) <- alexGetChar' i1 -> findSmartQuote i2+              Just (c, i1)+                | isDoubleSmartQuote c -> Just (c, loc)+                | otherwise -> findSmartQuote i1+              _ -> Nothing+      case findSmartQuote (AI (psSpanStart startSpan) startBuf) of+        Just (c, loc) -> throwSmartQuoteError c loc+        Nothing -> pure () -lex_escape :: P Char-lex_escape = do-  i0@(AI loc _) <- getInput-  c <- getCharOrFail i0-  case c of-        'a'   -> return '\a'-        'b'   -> return '\b'-        'f'   -> return '\f'-        'n'   -> return '\n'-        'r'   -> return '\r'-        't'   -> return '\t'-        'v'   -> return '\v'-        '\\'  -> return '\\'-        '"'   -> return '\"'-        '\''  -> return '\''-        -- the next two patterns build up a Unicode smart quote error (#21843)-        smart_double_quote | isDoubleSmartQuote smart_double_quote ->-          add_smart_quote_error smart_double_quote loc-        smart_single_quote | isSingleSmartQuote smart_single_quote ->-          add_smart_quote_error smart_single_quote loc-        '^'   -> do i1 <- getInput-                    c <- getCharOrFail i1-                    if c >= '@' && c <= '_'-                        then return (chr (ord c - ord '@'))-                        else lit_error i1+-- | Dummy action that should never be called. Should only be used in lex states+-- that are manually lexed in tok_string_multi.+tok_string_multi_content :: Action+tok_string_multi_content = panic "tok_string_multi_content unexpectedly invoked" -        'x'   -> readNum is_hexdigit 16 hexDigit-        'o'   -> readNum is_octdigit  8 octDecDigit-        x | is_decdigit x -> readNum2 is_decdigit 10 octDecDigit (octDecDigit x)+lex_chars :: (String, String) -> PsSpan -> StringBuffer -> Int -> P String+lex_chars (startDelim, endDelim) span buf len =+  either (throwStringLexError i0) pure $+    lexString contentLen contentBuf+  where+    i0@(AI _ contentBuf) = advanceInputBytes (length startDelim) $ AI (psSpanStart span) buf -        c1 ->  do-           i <- getInput-           case alexGetChar' i of-            Nothing -> lit_error i0-            Just (c2,i2) ->-              case alexGetChar' i2 of-                Nothing -> do lit_error i0-                Just (c3,i3) ->-                   let str = [c1,c2,c3] in-                   case [ (c,rest) | (p,c) <- silly_escape_chars,-                                     Just rest <- [stripPrefix p str] ] of-                          (escape_char,[]):_ -> do-                                setInput i3-                                return escape_char-                          (escape_char,_:_):_ -> do-                                setInput i2-                                return escape_char-                          [] -> lit_error i0+    -- assumes delimiters are ASCII, with 1 byte per Char+    contentLen = len - length startDelim - length endDelim -readNum :: (Char -> Bool) -> Int -> (Char -> Int) -> P Char-readNum is_digit base conv = do-  i <- getInput-  c <- getCharOrFail i-  if is_digit c-        then readNum2 is_digit base conv (conv c)-        else lit_error i+throwStringLexError :: AlexInput -> StringLexError -> P a+throwStringLexError i (StringLexError e pos) = setInput (advanceInputTo pos i) >> lexError e -readNum2 :: (Char -> Bool) -> Int -> (Char -> Int) -> Int -> P Char-readNum2 is_digit base conv i = do-  input <- getInput-  read i input-  where read i input = do-          case alexGetChar' input of-            Just (c,input') | is_digit c -> do-               let i' = i*base + conv c-               if i' > 0x10ffff-                  then setInput input >> lexError LexNumEscapeRange-                  else read i' input'-            _other -> do-              setInput input; return (chr i) +tok_quoted_label :: Action+tok_quoted_label span buf len _buf2 = do+  s <- lex_chars ("#\"", "\"") span buf len+  pure $ L span (ITlabelvarid src (mkFastString s))+  where+    -- skip leading '#'+    src = SourceText . mkFastString . drop 1 $ lexemeToString buf len -silly_escape_chars :: [(String, Char)]-silly_escape_chars = [-        ("NUL", '\NUL'),-        ("SOH", '\SOH'),-        ("STX", '\STX'),-        ("ETX", '\ETX'),-        ("EOT", '\EOT'),-        ("ENQ", '\ENQ'),-        ("ACK", '\ACK'),-        ("BEL", '\BEL'),-        ("BS", '\BS'),-        ("HT", '\HT'),-        ("LF", '\LF'),-        ("VT", '\VT'),-        ("FF", '\FF'),-        ("CR", '\CR'),-        ("SO", '\SO'),-        ("SI", '\SI'),-        ("DLE", '\DLE'),-        ("DC1", '\DC1'),-        ("DC2", '\DC2'),-        ("DC3", '\DC3'),-        ("DC4", '\DC4'),-        ("NAK", '\NAK'),-        ("SYN", '\SYN'),-        ("ETB", '\ETB'),-        ("CAN", '\CAN'),-        ("EM", '\EM'),-        ("SUB", '\SUB'),-        ("ESC", '\ESC'),-        ("FS", '\FS'),-        ("GS", '\GS'),-        ("RS", '\RS'),-        ("US", '\US'),-        ("SP", '\SP'),-        ("DEL", '\DEL')-        ] --- before calling lit_error, ensure that the current input is pointing to--- the position of the error in the buffer.  This is so that we can report--- a correct location to the user, but also so we can detect UTF-8 decoding--- errors if they occur.-lit_error :: AlexInput -> P a-lit_error i = do setInput i; lexError LexStringCharLit+tok_char :: Action+tok_char span buf len _buf2 = do+  c <- lex_chars ("'", "'") span buf (if endsInHash then len - 1 else len) >>= \case+    [c] -> pure c+    s -> panic $ "tok_char expected exactly one character, got: " ++ show s+  pure . L span $+    if endsInHash+      then ITprimchar src c+      else ITchar src c+  where+    src = SourceText $ lexemeToFastString buf len+    endsInHash = currentChar (offsetBytes (len - 1) buf) == '#' -getCharOrFail :: AlexInput -> P Char-getCharOrFail i =  do-  case alexGetChar' i of-        Nothing -> lexError LexStringCharLitEOF-        Just (c,i)  -> do setInput i; return c  -- ----------------------------------------------------------------------------- -- QuasiQuote@@ -2515,45 +2331,31 @@ -- ----------------------------------------------------------------------------- -- Unicode Smart Quote detection (#21843) -isDoubleSmartQuote :: Char -> Bool-isDoubleSmartQuote '“' = True-isDoubleSmartQuote '”' = True-isDoubleSmartQuote _ = False--isSingleSmartQuote :: Char -> Bool-isSingleSmartQuote '‘' = True-isSingleSmartQuote '’' = True-isSingleSmartQuote _ = False- isSmartQuote :: AlexAccPred ExtsBitmap isSmartQuote _ _ _ (AI _ buf) = let c = prevChar buf ' ' in isSingleSmartQuote c || isDoubleSmartQuote c -smart_quote_error_message :: Char -> PsLoc -> MsgEnvelope PsMessage-smart_quote_error_message c loc =-  let (correct_char, correct_char_name) =-         if isSingleSmartQuote c then ('\'', "Single Quote") else ('"', "Quotation Mark")-      err = mkPlainErrorMsgEnvelope (mkSrcSpanPs (mkPsSpan loc loc)) $-              PsErrUnicodeCharLooksLike c correct_char correct_char_name in-    err+throwSmartQuoteError :: Char -> PsLoc -> P a+throwSmartQuoteError c loc = addFatalError err+  where+    err =+      mkPlainErrorMsgEnvelope (mkSrcSpanPs (mkPsSpan loc loc)) $+        PsErrUnicodeCharLooksLike c correct_char correct_char_name+    (correct_char, correct_char_name) =+      if isSingleSmartQuote c+        then ('\'', "Single Quote")+        else ('"', "Quotation Mark") +-- | Throw a smart quote error, where the smart quote was the last character lexed smart_quote_error :: Action-smart_quote_error span buf _len _buf2 = do-  let c = currentChar buf-  addFatalError (smart_quote_error_message c (psSpanStart span))--add_smart_quote_error :: Char -> PsLoc -> P a-add_smart_quote_error c loc = addFatalError (smart_quote_error_message c loc)--add_nonfatal_smart_quote_error :: Char -> PsLoc -> P ()-add_nonfatal_smart_quote_error c loc = addError (smart_quote_error_message c loc)+smart_quote_error span _ _ buf2 = do+  let c = prevChar buf2 (panic "smart_quote_error unexpectedly called on beginning of input")+  throwSmartQuoteError c (psSpanStart span) -advance_to_smart_quote_character :: P ()-advance_to_smart_quote_character  = do-  i <- getInput-  case alexGetChar' i of-    Just (c, _) | isDoubleSmartQuote c -> return ()-    Just (_, i2) -> do setInput i2; advance_to_smart_quote_character-    Nothing -> return () -- should never get here+-- Note [Bare smart quote error]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- A smart quote inside of a string is allowed, but if a complete valid string+-- couldn't be lexed, we want to see if there's a smart quote that the user+-- thought ended the string, but in fact didn't.  -- ----------------------------------------------------------------------------- -- Warnings@@ -2791,7 +2593,7 @@ getLastLoc :: P PsSpan getLastLoc = P $ \s@(PState { last_loc = last_loc }) -> POk s last_loc -data AlexInput = AI !PsLoc !StringBuffer+data AlexInput = AI !PsLoc !StringBuffer deriving (Show)  {- Note [Unicode in Alex]@@ -2814,19 +2616,19 @@  {-# INLINE adjustChar #-} adjustChar :: Char -> Word8-adjustChar c = fromIntegral $ ord adj_c-  where non_graphic     = '\x00'-        upper           = '\x01'-        lower           = '\x02'-        digit           = '\x03'-        symbol          = '\x04'-        space           = '\x05'-        other_graphic   = '\x06'-        uniidchar       = '\x07'+adjustChar c = adj_c+  where non_graphic     = 0x00+        upper           = 0x01+        lower           = 0x02+        digit           = 0x03+        symbol          = 0x04+        space           = 0x05+        other_graphic   = 0x06+        uniidchar       = 0x07          adj_c           | c <= '\x07' = non_graphic-          | c <= '\x7f' = c+          | c <= '\x7f' = fromIntegral (ord c)           -- Alex doesn't handle Unicode, so when Unicode           -- character is encountered we output these values           -- with the actual character value hidden in the state.@@ -2866,15 +2668,18 @@ -- -- See Note [Unicode in Alex] and #13986. alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (AI _ buf) = chr (fromIntegral (adjustChar pc))+alexInputPrevChar (AI _ buf) = unsafeChr (fromIntegral (adjustChar pc))   where pc = prevChar buf '\n' +unsafeChr :: Int -> Char+unsafeChr (I# c) = GHC.Exts.C# (GHC.Exts.chr# c)+ -- backwards compatibility for Alex 2.x alexGetChar :: AlexInput -> Maybe (Char,AlexInput) alexGetChar inp = case alexGetByte inp of                     Nothing    -> Nothing                     Just (b,i) -> c `seq` Just (c,i)-                       where c = chr $ fromIntegral b+                       where c = unsafeChr $ fromIntegral b  -- See Note [Unicode in Alex] alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)@@ -2899,6 +2704,19 @@   where (c,s') = nextChar s         loc'   = advancePsLoc loc c +-- | Advance the given input N bytes.+advanceInputBytes :: Int -> AlexInput -> AlexInput+advanceInputBytes n i0@(AI _ buf0) = advanceInputTo (cur buf0 + n) i0++-- | Advance the given input to the given position.+advanceInputTo :: Int -> AlexInput -> AlexInput+advanceInputTo pos = go+  where+    go i@(AI _ buf)+      | cur buf >= pos = i+      | Just (_, i') <- alexGetChar' i = go i'+      | otherwise = i -- reached the end, just return the last input+ getInput :: P AlexInput getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (AI l b) @@ -2906,10 +2724,11 @@ setInput (AI l b) = P $ \s -> POk s{ loc=l, buffer=b } ()  nextIsEOF :: P Bool-nextIsEOF = do-  AI _ s <- getInput-  return $ atEnd s+nextIsEOF = isEOF <$> getInput +isEOF :: AlexInput -> Bool+isEOF (AI _ buf) = atEnd buf+ pushLexState :: Int -> P () pushLexState ls = P $ \s@PState{ lex_state=l } -> POk s{lex_state=ls:l} () @@ -3052,8 +2871,12 @@   | NoLexicalNegationBit   -- See Note [Why not LexicalNegationBit]   | OverloadedRecordDotBit   | OverloadedRecordUpdateBit+  | OrPatternsBit   | ExtendedLiteralsBit   | ListTuplePunsBit+  | ViewPatternsBit+  | RequiredTypeArgumentsBit+  | MultilineStringsBit    -- Flags that are updated once parsing starts   | InRulePragBit@@ -3133,8 +2956,12 @@       .|. NoLexicalNegationBit        `xoptNotBit` LangExt.LexicalNegation -- See Note [Why not LexicalNegationBit]       .|. OverloadedRecordDotBit      `xoptBit` LangExt.OverloadedRecordDot       .|. OverloadedRecordUpdateBit   `xoptBit` LangExt.OverloadedRecordUpdate  -- Enable testing via 'getBit OverloadedRecordUpdateBit' in the parser (RecordDotSyntax parsing uses that information).+      .|. OrPatternsBit               `xoptBit` LangExt.OrPatterns       .|. ExtendedLiteralsBit         `xoptBit` LangExt.ExtendedLiterals       .|. ListTuplePunsBit            `xoptBit` LangExt.ListTuplePuns+      .|. ViewPatternsBit             `xoptBit` LangExt.ViewPatterns+      .|. RequiredTypeArgumentsBit    `xoptBit` LangExt.RequiredTypeArguments+      .|. MultilineStringsBit         `xoptBit` LangExt.MultilineStrings     optBits =           HaddockBit        `setBitIf` isHaddock       .|. RawTokenStreamBit `setBitIf` rawTokStream@@ -3224,8 +3051,9 @@   --   the parser will not produce any result, ending in a 'PFailed' state.   addFatalError :: MsgEnvelope PsMessage -> m a -  -- | Check if a given flag is currently set in the bitmap.-  getBit :: ExtBits -> m Bool+  -- | Get parser options+  getParserOpts :: m ParserOpts+   -- | Go through the @comment_q@ in @PState@ and remove all comments   -- that belong within the given span   allocateCommentsP :: RealSrcSpan -> m EpAnnComments@@ -3249,8 +3077,8 @@   addFatalError err =     addError err >> P PFailed -  getBit ext = P $ \s -> let b =  ext `xtest` pExtsBitmap (options s)-                         in b `seq` POk s b+  getParserOpts = P $ \s -> POk s $! options s+   allocateCommentsP ss = P $ \s ->     if null (comment_q s) then POk s emptyComments else  -- fast path     let (comment_q', newAnns) = allocateComments ss (comment_q s) in@@ -3272,6 +3100,10 @@          comment_q = comment_q'        } (EpaCommentsBalanced (Strict.fromMaybe [] header_comments') newAnns) +-- | Check if a given flag is currently set in the bitmap.+getBit :: MonadP m => ExtBits -> m Bool+getBit ext = (\opts -> ext `xtest` pExtsBitmap opts) <$> getParserOpts+ getCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments getCommentsFor (RealSrcSpan l _) = allocateCommentsP l getCommentsFor _ = return emptyComments@@ -3287,9 +3119,9 @@ getEofPos :: P (Strict.Maybe (Strict.Pair RealSrcSpan RealSrcSpan)) getEofPos = P $ \s@(PState { eof_pos = pos }) -> POk s pos -addPsMessage :: SrcSpan -> PsMessage -> P ()+addPsMessage :: MonadP m => SrcSpan -> PsMessage -> m () addPsMessage srcspan msg = do-  diag_opts <- (pDiagOpts . options) <$> getPState+  diag_opts <- pDiagOpts <$> getParserOpts   addWarning (mkPlainMsgEnvelope diag_opts srcspan msg)  addTabWarning :: RealSrcSpan -> P ()@@ -3639,6 +3471,11 @@ topNoLayoutContainsCommas (ALRLayout _ _ : ls) = topNoLayoutContainsCommas ls topNoLayoutContainsCommas (ALRNoLayout b _ : _) = b +-- If the generated alexScan/alexScanUser functions are called multiple times+-- in this file, alexScanUser gets broken out into a separate function and+-- increases memory usage. Make sure GHC inlines this function and optimizes it.+{-# INLINE alexScanUser #-}+ lexToken :: P (PsLocated Token) lexToken = do   inp@(AI loc1 buf) <- getInput@@ -3792,13 +3629,14 @@ %************************************************************************ -} +-- TODO:AZ: we should have only mkParensEpToks. Delee mkParensEpAnn, mkParensLocs  -- |Given a 'RealSrcSpan' that surrounds a 'HsPar' or 'HsParTy', generate--- 'AddEpAnn' values for the opening and closing bordering on the start+-- 'EpToken' values for the opening and closing bordering on the start -- and end of the span-mkParensEpAnn :: RealSrcSpan -> (AddEpAnn, AddEpAnn)-mkParensEpAnn ss = (AddEpAnn AnnOpenP (EpaSpan (RealSrcSpan lo Strict.Nothing)),-                    AddEpAnn AnnCloseP (EpaSpan (RealSrcSpan lc Strict.Nothing)))+mkParensEpToks :: RealSrcSpan -> (EpToken "(", EpToken ")")+mkParensEpToks ss = (EpTok (EpaSpan (RealSrcSpan lo Strict.Nothing)),+                    EpTok (EpaSpan (RealSrcSpan lc Strict.Nothing)))   where     f = srcSpanFile ss     sl = srcSpanStartLine ss@@ -3808,6 +3646,22 @@     lo = mkRealSrcSpan (realSrcSpanStart ss)        (mkRealSrcLoc f sl (sc+1))     lc = mkRealSrcSpan (mkRealSrcLoc f el (ec - 1)) (realSrcSpanEnd ss) ++-- |Given a 'RealSrcSpan' that surrounds a 'HsPar' or 'HsParTy', generate+-- 'EpaLocation' values for the opening and closing bordering on the start+-- and end of the span+mkParensLocs :: RealSrcSpan -> (EpaLocation, EpaLocation)+mkParensLocs ss = (EpaSpan (RealSrcSpan lo Strict.Nothing),+                    EpaSpan (RealSrcSpan lc Strict.Nothing))+  where+    f = srcSpanFile ss+    sl = srcSpanStartLine ss+    sc = srcSpanStartCol ss+    el = srcSpanEndLine ss+    ec = srcSpanEndCol ss+    lo = mkRealSrcSpan (realSrcSpanStart ss)        (mkRealSrcLoc f sl (sc+1))+    lc = mkRealSrcSpan (mkRealSrcLoc f el (ec - 1)) (realSrcSpanEnd ss)+ queueComment :: RealLocated Token -> P() queueComment c = P $ \s -> POk s {   comment_q = commentToAnnotation c : comment_q s@@ -3819,8 +3673,8 @@   -> ([LEpaComment], [LEpaComment]) allocateComments ss comment_q =   let-    (before,rest)  = break (\(L l _) -> isRealSubspanOf (anchor l) ss) comment_q-    (middle,after) = break (\(L l _) -> not (isRealSubspanOf (anchor l) ss)) rest+    (before,rest)  = break (\(L l _) -> isRealSubspanOf (epaLocationRealSrcSpan l) ss) comment_q+    (middle,after) = break (\(L l _) -> not (isRealSubspanOf (epaLocationRealSrcSpan l) ss)) rest     comment_q' = before ++ after     newAnns = middle   in@@ -3838,14 +3692,14 @@     -- And the token preceding the comment is on a different line     cmp :: RealSrcSpan -> LEpaComment -> Bool     cmp later (L l c)-         = srcSpanStartLine later - srcSpanEndLine (anchor l) == 1-          && srcSpanEndLine (ac_prior_tok c) /= srcSpanStartLine (anchor l)+         = srcSpanStartLine later - srcSpanEndLine (epaLocationRealSrcSpan l) == 1+          && srcSpanEndLine (ac_prior_tok c) /= srcSpanStartLine (epaLocationRealSrcSpan l)      go :: [LEpaComment] -> RealSrcSpan -> [LEpaComment]        -> ([LEpaComment], [LEpaComment])     go decl_comments _ [] = ([],decl_comments)     go decl_comments r (c@(L l _):cs) = if cmp r c-                              then go (c:decl_comments) (anchor l) cs+                              then go (c:decl_comments) (epaLocationRealSrcSpan l) cs                               else (reverse (c:cs), decl_comments)   in     go [] ss prior_comments@@ -3857,7 +3711,7 @@   -> (Strict.Maybe [LEpaComment], [LEpaComment], [LEpaComment]) allocatePriorComments ss comment_q mheader_comments =   let-    cmp (L l _) = anchor l <= ss+    cmp (L l _) = epaLocationRealSrcSpan l <= ss     (newAnns,after) = partition cmp comment_q     comment_q'= after     (prior_comments, decl_comments) = splitPriorComments ss newAnns
compiler/GHC/Parser/PostProcess.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiWayIf #-}  -- --  (c) The University of Glasgow 2002-2006@@ -15,7 +16,7 @@         mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot         mkHsOpApp,         mkHsIntegral, mkHsFractional, mkHsIsString,-        mkHsDo, mkSpliceDecl,+        mkHsDo, mkMDo, mkSpliceDecl,         mkRoleAnnotDecl,         mkClassDecl,         mkTyData, mkDataFamInst,@@ -32,7 +33,6 @@         setRdrNameSpace,         fromSpecTyVarBndr, fromSpecTyVarBndrs,         annBinds,-        fixValbindsAnn,         stmtsAnchor, stmtsLoc,          cvBindGroup,@@ -92,7 +92,6 @@         failOpFewArgs,         failNotEnabledImportQualifiedPost,         failImportQualifiedTwice,-        requireExplicitNamespaces,          SumOrTuple (..), @@ -104,6 +103,10 @@         DisambECP(..),         ecpFromExp,         ecpFromCmd,+        ecpFromPat,+        ArrowParsingMode(..),+        withArrowParsingMode, withArrowParsingMode',+        setTelescopeBndrsNameSpace,         PatBuilder,         hsHoleExpr, @@ -126,7 +129,7 @@ import GHC.Prelude import GHC.Hs           -- Lots of it import GHC.Core.TyCon          ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )-import GHC.Core.DataCon        ( DataCon, dataConTyCon )+import GHC.Core.DataCon        ( DataCon, dataConTyCon, dataConName ) import GHC.Core.ConLike        ( ConLike(..) ) import GHC.Core.Coercion.Axiom ( Role, fsFromRole ) import GHC.Types.Name.Reader@@ -145,7 +148,7 @@ import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon,                           nilDataConName, nilDataConKey,                           listTyConName, listTyConKey, sumDataCon,-                          unrestrictedFunTyCon , listTyCon_RDR )+                          unrestrictedFunTyCon , listTyCon_RDR, unitDataCon ) import GHC.Types.ForeignCall import GHC.Types.SrcLoc import GHC.Types.Unique ( hasKey )@@ -200,14 +203,14 @@             -> Located (a,[LHsFunDep GhcPs])             -> OrdList (LHsDecl GhcPs)             -> EpLayout-            -> [AddEpAnn]+            -> AnnClassDecl             -> P (LTyClDecl GhcPs)  mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layout annsIn   = do { (binds, sigs, ats, at_defs, _, docs) <- cvBindsAndSigs where_cls-       ; (cls, tparams, fixity, ann, cs) <- checkTyClHdr True tycl_hdr+       ; (cls, tparams, fixity, ops, cps, cs) <- checkTyClHdr True tycl_hdr        ; tyvars <- checkTyVars (text "class") whereDots cls tparams-       ; let anns' = annsIn Semi.<> ann+       ; let anns' = annsIn { acd_openp = ops, acd_closep = cps}        ; let loc = EpAnn (spanAsAnchor loc') noAnn cs        ; return (L loc (ClassDecl { tcdCExt = (anns', layout, NoAnnSortKey)                                   , tcdCtxt = mcxt@@ -227,18 +230,18 @@          -> Maybe (LHsKind GhcPs)          -> [LConDecl GhcPs]          -> Located (HsDeriving GhcPs)-         -> [AddEpAnn]+         -> AnnDataDefn          -> P (LTyClDecl GhcPs) mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr))          ksig data_cons (L _ maybe_deriv) annsIn-  = do { (tc, tparams, fixity, ann, cs) <- checkTyClHdr False tycl_hdr+  = do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False tycl_hdr        ; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams-       ; let anns' = annsIn Semi.<> ann+       ; let anns = annsIn {andd_openp = ops, andd_closep = cps}        ; data_cons <- checkNewOrData loc' (unLoc tc) is_type_data new_or_data data_cons-       ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv+       ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv anns        ; !cs' <- getCommentsFor loc'        ; let loc = EpAnn (spanAsAnchor loc') noAnn (cs' Semi.<> cs)-       ; return (L loc (DataDecl { tcdDExt = anns',+       ; return (L loc (DataDecl { tcdDExt = noExtField,                                    tcdLName = tc, tcdTyVars = tyvars,                                    tcdFixity = fixity,                                    tcdDataDefn = defn })) }@@ -248,10 +251,11 @@            -> Maybe (LHsKind GhcPs)            -> DataDefnCons (LConDecl GhcPs)            -> HsDeriving GhcPs+           -> AnnDataDefn            -> P (HsDataDefn GhcPs)-mkDataDefn cType mcxt ksig data_cons maybe_deriv+mkDataDefn cType mcxt ksig data_cons maybe_deriv anns   = do { checkDatatypeContext mcxt-       ; return (HsDataDefn { dd_ext = noExtField+       ; return (HsDataDefn { dd_ext = anns                             , dd_cType = cType                             , dd_ctxt = mcxt                             , dd_cons = data_cons@@ -261,14 +265,15 @@ mkTySynonym :: SrcSpan             -> LHsType GhcPs  -- LHS             -> LHsType GhcPs  -- RHS-            -> [AddEpAnn]+            -> EpToken "type"+            -> EpToken "="             -> P (LTyClDecl GhcPs)-mkTySynonym loc lhs rhs annsIn-  = do { (tc, tparams, fixity, ann, cs) <- checkTyClHdr False lhs+mkTySynonym loc lhs rhs antype aneq+  = do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False lhs        ; tyvars <- checkTyVars (text "type") equalsDots tc tparams-       ; let anns' = annsIn Semi.<> ann+       ; let anns = AnnSynDecl ops cps antype aneq        ; let loc' = EpAnn (spanAsAnchor loc) noAnn cs-       ; return (L loc' (SynDecl { tcdSExt = anns'+       ; return (L loc' (SynDecl { tcdSExt = anns                                  , tcdLName = tc, tcdTyVars = tyvars                                  , tcdFixity = fixity                                  , tcdRhs = rhs })) }@@ -277,7 +282,7 @@   :: SrcSpan   -> Located [LocatedN RdrName]   -- LHS   -> LHsSigType GhcPs             -- RHS-  -> [AddEpAnn]+  -> (EpToken "type", TokDcolon)   -> P (LStandaloneKindSig GhcPs) mkStandaloneKindSig loc lhs rhs anns =   do { vs <- mapM check_lhs_name (unLoc lhs)@@ -301,13 +306,13 @@                -> HsOuterFamEqnTyVarBndrs GhcPs                -> LHsType GhcPs                -> LHsType GhcPs-               -> [AddEpAnn]+               -> EpToken "="                -> P (LTyFamInstEqn GhcPs)-mkTyFamInstEqn loc bndrs lhs rhs anns-  = do { (tc, tparams, fixity, ann, cs) <- checkTyClHdr False lhs+mkTyFamInstEqn loc bndrs lhs rhs annEq+  = do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False lhs        ; let loc' = EpAnn (spanAsAnchor loc) noAnn cs        ; return (L loc' $ FamEqn-                        { feqn_ext    = anns `mappend` ann+                        { feqn_ext    = (ops, cps, annEq)                         , feqn_tycon  = tc                         , feqn_bndrs  = bndrs                         , feqn_pats   = tparams@@ -322,45 +327,33 @@               -> Maybe (LHsKind GhcPs)               -> [LConDecl GhcPs]               -> Located (HsDeriving GhcPs)-              -> [AddEpAnn]+              -> AnnDataDefn               -> P (LInstDecl GhcPs) mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)               ksig data_cons (L _ maybe_deriv) anns-  = do { (tc, tparams, fixity, ann, cs) <- checkTyClHdr False tycl_hdr+  = do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False tycl_hdr        ; data_cons <- checkNewOrData loc (unLoc tc) False new_or_data data_cons-       ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv+       ; let anns' = anns {andd_openp = ops, andd_closep = cps}+       ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv anns'        ; let loc' = EpAnn (spanAsAnchor loc) noAnn cs        ; return (L loc' (DataFamInstD noExtField (DataFamInstDecl-                  (FamEqn { feqn_ext    = ann Semi.<> anns+                  (FamEqn { feqn_ext    = ([], [], NoEpTok)                           , feqn_tycon  = tc                           , feqn_bndrs  = bndrs                           , feqn_pats   = tparams                           , feqn_fixity = fixity                           , feqn_rhs    = defn })))) } --- mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)---               ksig data_cons (L _ maybe_deriv) anns---   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr---        ; cs <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan---        ; let anns' = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns emptyComments---        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv---        ; return (L (noAnnSrcSpan loc) (DataFamInstD anns' (DataFamInstDecl---                   (FamEqn { feqn_ext    = anns'---                           , feqn_tycon  = tc---                           , feqn_bndrs  = bndrs---                           , feqn_pats   = tparams---                           , feqn_fixity = fixity---                           , feqn_rhs    = defn })))) }  - mkTyFamInst :: SrcSpan             -> TyFamInstEqn GhcPs-            -> [AddEpAnn]+            -> EpToken "type"+            -> EpToken "instance"             -> P (LInstDecl GhcPs)-mkTyFamInst loc eqn anns = do+mkTyFamInst loc eqn t i = do   return (L (noAnnSrcSpan loc) (TyFamInstD noExtField-              (TyFamInstDecl anns eqn)))+              (TyFamInstDecl (t,i) eqn)))  mkFamDecl :: SrcSpan           -> FamilyInfo GhcPs@@ -368,14 +361,15 @@           -> LHsType GhcPs                   -- LHS           -> LFamilyResultSig GhcPs          -- Optional result signature           -> Maybe (LInjectivityAnn GhcPs)   -- Injectivity annotation-          -> [AddEpAnn]+          -> AnnFamilyDecl           -> P (LTyClDecl GhcPs) mkFamDecl loc info topLevel lhs ksig injAnn annsIn-  = do { (tc, tparams, fixity, ann, cs) <- checkTyClHdr False lhs+  = do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False lhs        ; tyvars <- checkTyVars (ppr info) equals_or_where tc tparams        ; let loc' = EpAnn (spanAsAnchor loc) noAnn cs+       ; let anns' = annsIn { afd_openp = ops, afd_closep = cps }        ; return (L loc' (FamDecl noExtField (FamilyDecl-                                           { fdExt       = annsIn Semi.<> ann+                                           { fdExt       = anns'                                            , fdTopLevel  = topLevel                                            , fdInfo      = info, fdLName = tc                                            , fdTyVars    = tyvars@@ -413,7 +407,7 @@ mkRoleAnnotDecl :: SrcSpan                 -> LocatedN RdrName                -- type being annotated                 -> [Located (Maybe FastString)]    -- roles-                -> [AddEpAnn]+                -> (EpToken "type", EpToken "role")                 -> P (LRoleAnnotDecl GhcPs) mkRoleAnnotDecl loc tycon roles anns   = do { roles' <- mapM parse_role roles@@ -436,6 +430,10 @@             addFatalError $ mkPlainErrorMsgEnvelope loc_role $               (PsErrIllegalRoleName role nearby) +mkMDo :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs+mkMDo ctxt stmts tok loc+  = mkHsDoAnns ctxt stmts (AnnList (Just loc) ListNone [] tok [])+ -- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to -- binders without annotations. Only accepts specified variables, and errors if -- any of the provided binders has an 'InferredSpec' annotation.@@ -446,62 +444,56 @@ -- annotations. Only accepts specified variables, and errors if the provided -- binder has an 'InferredSpec' annotation. fromSpecTyVarBndr :: LHsTyVarBndr Specificity GhcPs -> P (LHsTyVarBndr () GhcPs)-fromSpecTyVarBndr bndr = case bndr of-  (L loc (UserTyVar xtv flag idp))     -> (check_spec flag loc)-                                          >> return (L loc $ UserTyVar xtv () idp)-  (L loc (KindedTyVar xtv flag idp k)) -> (check_spec flag loc)-                                          >> return (L loc $ KindedTyVar xtv () idp k)-  where-    check_spec :: Specificity -> SrcSpanAnnA -> P ()-    check_spec SpecifiedSpec _   = return ()-    check_spec InferredSpec  loc = addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $+fromSpecTyVarBndr (L loc (HsTvb xtv flag idp k)) = do+  case flag of+    SpecifiedSpec -> return ()+    InferredSpec  -> addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $                                      PsErrInferredTypeVarNotAllowed+  return $ L loc (HsTvb xtv () idp k)  -- | Add the annotation for a 'where' keyword to existing @HsLocalBinds@-annBinds :: AddEpAnn -> EpAnnComments -> HsLocalBinds GhcPs+annBinds :: EpToken "where" -> EpAnnComments -> HsLocalBinds GhcPs   -> (HsLocalBinds GhcPs, Maybe EpAnnComments)-annBinds a cs (HsValBinds an bs)  = (HsValBinds (add_where a an cs) bs, Nothing)-annBinds a cs (HsIPBinds an bs)   = (HsIPBinds (add_where a an cs) bs, Nothing)+annBinds w cs (HsValBinds an bs)  = (HsValBinds (add_where w an cs) bs, Nothing)+annBinds w cs (HsIPBinds an bs)   = (HsIPBinds (add_where w an cs) bs, Nothing) annBinds _ cs  (EmptyLocalBinds x) = (EmptyLocalBinds x, Just cs) -add_where :: AddEpAnn -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList-add_where an@(AddEpAnn _ (EpaSpan (RealSrcSpan rs _))) (EpAnn a (AnnList anc o c r t) cs) cs2+add_where :: EpToken "where" -> EpAnn (AnnList (EpToken "where")) -> EpAnnComments -> EpAnn (AnnList (EpToken "where"))+add_where w@(EpTok (EpaSpan (RealSrcSpan rs _))) (EpAnn a al cs) cs2   | valid_anchor a-  = EpAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) (cs Semi.<> cs2)+  = EpAnn (widenAnchorT a w) (al { al_rest = w}) (cs Semi.<> cs2)   | otherwise   = EpAnn (patch_anchor rs a)-          (AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) (cs Semi.<> cs2)-add_where (AddEpAnn _ _) _ _ = panic "add_where"+          (al { al_anchor = (fmap (patch_anchor rs) (al_anchor al))+              , al_rest = w})+          (cs Semi.<> cs2)+add_where _ _ _ = panic "add_where"  -- EpaDelta should only be used for transformations -valid_anchor :: Anchor -> Bool+valid_anchor :: EpaLocation -> Bool valid_anchor (EpaSpan (RealSrcSpan r _)) = srcSpanStartLine r >= 0 valid_anchor _ = False  -- If the decl list for where binds is empty, the anchor ends up -- invalid. In this case, use the parent one-patch_anchor :: RealSrcSpan -> Anchor -> Anchor-patch_anchor r (EpaDelta _ _) = EpaSpan (RealSrcSpan r Strict.Nothing)+patch_anchor :: RealSrcSpan -> EpaLocation -> EpaLocation+patch_anchor r EpaDelta{} = EpaSpan (RealSrcSpan r Strict.Nothing) patch_anchor r1 (EpaSpan (RealSrcSpan r0 mb)) = EpaSpan (RealSrcSpan r mb)   where     r = if srcSpanStartLine r0 < 0 then r1 else r0 patch_anchor _ (EpaSpan ss) = EpaSpan ss -fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList-fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)-  = (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)---- | The 'Anchor' for a stmtlist is based on either the location or+-- | The anchor for a stmtlist is based on either the location or -- the first semicolon annotion.-stmtsAnchor :: Located (OrdList AddEpAnn,a) -> Maybe Anchor-stmtsAnchor (L (RealSrcSpan l mb) ((ConsOL (AddEpAnn _ (EpaSpan (RealSrcSpan r rb))) _), _))+stmtsAnchor :: Located (OrdList (EpToken tok),a) -> Maybe EpaLocation+stmtsAnchor (L (RealSrcSpan l mb) ((ConsOL (EpTok (EpaSpan (RealSrcSpan r rb))) _), _))   = Just $ widenAnchorS (EpaSpan (RealSrcSpan l mb)) (RealSrcSpan r rb) stmtsAnchor (L (RealSrcSpan l mb) _) = Just $ EpaSpan (RealSrcSpan l mb) stmtsAnchor _ = Nothing -stmtsLoc :: Located (OrdList AddEpAnn,a) -> SrcSpan+stmtsLoc :: Located (OrdList (EpToken tok),a) -> SrcSpan stmtsLoc (L l ((ConsOL aa _), _))-  = widenSpan l [aa]+  = widenSpanT l aa stmtsLoc (L l _) = l  {- **********************************************************************@@ -666,7 +658,7 @@  has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool has_args []                                  = panic "GHC.Parser.PostProcess.has_args"-has_args (L _ (Match { m_pats = args }) : _) = not (null args)+has_args (L _ (Match { m_pats = L _ args }) : _) = not (null args)         -- Don't group together FunBinds if they have         -- no arguments.  This is necessary now that variable bindings         -- with no arguments are now treated as FunBinds rather@@ -725,7 +717,7 @@     occ = rdrNameOcc tc  mkPatSynMatchGroup :: LocatedN RdrName-                   -> LocatedL (OrdList (LHsDecl GhcPs))+                   -> LocatedLW (OrdList (LHsDecl GhcPs))                    -> P (MatchGroup GhcPs (LHsExpr GhcPs)) mkPatSynMatchGroup (L loc patsyn_name) (L ld decls) =     do { matches <- mapM fromDecl (fromOL decls)@@ -733,28 +725,33 @@        ; return $ mkMatchGroup FromSource (L ld matches) }   where     fromDecl (L loc decl@(ValD _ (PatBind _-                                 -- AZ: where should these anns come from?-                         pat@(L _ (ConPat noAnn ln@(L _ name) details))+                         pat@(L _ (ConPat _conAnn ln@(L _ name) details))                                _ rhs))) =         do { unless (name == patsyn_name) $                wrongNameBindingErr (locA loc) decl+           -- conAnn should only be AnnOpenP, AnnCloseP, so the rest should be empty+           ; let ann_fun = mk_ann_funrhs [] []            ; match <- case details of-               PrefixCon _ pats -> return $ Match { m_ext = noAnn-                                                  , m_ctxt = ctxt, m_pats = pats+               PrefixCon _ pats -> return $ Match { m_ext = noExtField+                                                  , m_ctxt = ctxt, m_pats = L l pats                                                   , m_grhss = rhs }                    where+                     l = listLocation pats                      ctxt = FunRhs { mc_fun = ln                                    , mc_fixity = Prefix-                                   , mc_strictness = NoSrcStrict }+                                   , mc_strictness = NoSrcStrict+                                   , mc_an = ann_fun } -               InfixCon p1 p2 -> return $ Match { m_ext = noAnn+               InfixCon p1 p2 -> return $ Match { m_ext = noExtField                                                 , m_ctxt = ctxt-                                                , m_pats = [p1, p2]+                                                , m_pats = L l [p1, p2]                                                 , m_grhss = rhs }                    where+                     l = listLocation [p1, p2]                      ctxt = FunRhs { mc_fun = ln                                    , mc_fixity = Infix-                                   , mc_strictness = NoSrcStrict }+                                   , mc_strictness = NoSrcStrict+                                   , mc_an = ann_fun }                 RecCon{} -> recordPatSynErr (locA loc) pat            ; return $ L loc match }@@ -777,12 +774,12 @@     addFatalError $ mkPlainErrorMsgEnvelope loc $       (PsErrRecordSyntaxInPatSynDecl pat) -mkConDeclH98 :: [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]+mkConDeclH98 :: (TokDarrow, (TokForall, EpToken ".")) -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]                 -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs                 -> ConDecl GhcPs -mkConDeclH98 ann name mb_forall mb_cxt args-  = ConDeclH98 { con_ext    = ann+mkConDeclH98 (tdarrow, (tforall,tdot)) name mb_forall mb_cxt args+  = ConDeclH98 { con_ext    = AnnConDeclH98 tforall tdot tdarrow                , con_name   = name                , con_forall = isJust mb_forall                , con_ex_tvs = mb_forall `orElse` []@@ -799,12 +796,12 @@ --   Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details. mkGadtDecl :: SrcSpan            -> NonEmpty (LocatedN RdrName)-           -> EpUniToken "::" "∷"+           -> TokDcolon            -> LHsSigType GhcPs            -> P (LConDecl GhcPs) mkGadtDecl loc names dcol ty = do -  (args, res_ty, annsa, csa) <-+  (args, res_ty, (ops, cps), csa) <-     case body_ty of      L ll (HsFunTy _ hsArr (L (EpAnn anc _ cs) (HsRecTy an rf)) res_ty) -> do        arr <- case hsArr of@@ -814,10 +811,10 @@                  return noAnn         return ( RecConGADT arr (L (EpAnn anc an cs) rf), res_ty-              , [], epAnnComments ll)+              , ([], []), epAnnComments ll)      _ -> do-       let (anns, cs, arg_types, res_type) = splitHsFunType body_ty-       return (PrefixConGADT noExtField arg_types, res_type, anns, cs)+       let ((ops, cps), cs, arg_types, res_type) = splitHsFunType body_ty+       return (PrefixConGADT noExtField arg_types, res_type, (ops,cps), cs)    let bndrs_loc = case outer_bndrs of         HsOuterImplicit{} -> getLoc ty@@ -826,7 +823,7 @@   let l = EpAnn (spanAsAnchor loc) noAnn csa    pure $ L l ConDeclGADT-                     { con_g_ext  = (dcol, annsa)+                     { con_g_ext  = AnnConDeclGADT ops cps dcol                      , con_names  = names                      , con_bndrs  = L bndrs_loc outer_bndrs                      , con_mb_cxt = mcxt@@ -838,8 +835,9 @@  setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser.--- When parsing: --+-- Case #1. When parsing:+-- -- > data T a = T | T1 Int -- -- we parse the data constructors as /types/ because of parser ambiguities,@@ -850,6 +848,13 @@ -- > data [] a = [] | a : [a] -- -- For the exact-name case we return an original name.+--+-- Case #2. When parsing:+--+-- > x = fn (forall a. a)   -- RequiredTypeArguments+--+-- we use setRdrNameSpace to set the namespace of forall-bound variables.+-- setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ) setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ) setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)@@ -940,42 +945,51 @@     check (HsArgPar sp) = addFatalError $ mkPlainErrorMsgEnvelope sp $                             (PsErrMalformedDecl pp_what (unLoc tc))         -- Keep around an action for adjusting the annotations of extra parens-    chkParens :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs+    chkParens :: [EpaLocation] -> [EpaLocation] -> HsBndrVis GhcPs -> LHsType GhcPs               -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)     chkParens ops cps bvis (L l (HsParTy _ (L lt ty)))       = let-          (o,c) = mkParensEpAnn (realSrcSpan $ locA l)+          (o,c) = mkParensLocs (realSrcSpan $ locA l)           (_,lt') = transferCommentsOnlyA l lt         in           chkParens (o:ops) (c:cps) bvis (L lt' ty)     chkParens ops cps bvis ty = chk ops cps bvis ty          -- Check that the name space is correct!-    chk :: [AddEpAnn] -> [AddEpAnn] -> HsBndrVis GhcPs -> LHsType GhcPs -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)-    chk ops cps bvis (L l (HsKindSig annk (L annt (HsTyVar ann _ (L lv tv))) k))-        | isRdrTyVar tv+    chk :: [EpaLocation] -> [EpaLocation] -> HsBndrVis GhcPs -> LHsType GhcPs -> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)+    chk ops cps bvis (L l (HsKindSig tok_dc (L annt t) k))+        | Just (ann, bvar) <- match_bndr_var t             = let+                bkind = HsBndrKind noExtField k                 an = (reverse ops) ++ cps               in-                return (L (widenLocatedAn (l Semi.<> annt) (for_widening bvis:an))-                       (KindedTyVar (an ++ annk ++ ann) bvis (L lv tv) k))-    chk ops cps bvis (L l (HsTyVar ann _ (L ltv tv)))-        | isRdrTyVar tv+                return (L (widenLocatedAnL (l Semi.<> annt) (for_widening bvis:an))+                       (HsTvb (AnnTyVarBndr (reverse ops) cps ann tok_dc) bvis bvar bkind))+    chk ops cps bvis (L l t)+        | Just (ann, bvar) <- match_bndr_var t             = let+                bkind = HsBndrNoKind noExtField                 an = (reverse ops) ++ cps               in-                return (L (widenLocatedAn l (for_widening bvis:an))-                                     (UserTyVar (an ++ ann) bvis (L ltv tv)))+                return (L (widenLocatedAnL l (for_widening bvis:an))+                                     (HsTvb (AnnTyVarBndr (reverse ops) cps ann noAnn) bvis bvar bkind))     chk _ _ _ t@(L loc _)         = addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $             (PsErrUnexpectedTypeInDecl t pp_what (unLoc tc) tparms equals_or_where) -    -- Return an AddEpAnn for use in widenLocatedAn. The AnnKeywordId is not used.-    for_widening :: HsBndrVis GhcPs -> AddEpAnn-    for_widening (HsBndrInvisible (EpTok loc)) = AddEpAnn AnnAnyclass loc-    for_widening  _                            = AddEpAnn AnnAnyclass (EpaDelta (SameLine 0) [])+    match_bndr_var :: HsType GhcPs -> Maybe (EpToken "'", HsBndrVar GhcPs)+    match_bndr_var (HsTyVar ann _ tv) | isRdrTyVar (unLoc tv)+      = Just (ann, HsBndrVar noExtField tv)+    match_bndr_var (HsWildCardTy tok)+      = Just (noAnn, HsBndrWildCard tok)+    match_bndr_var _ = Nothing +    -- Return a EpaLocation for use in widenLocatedAnL.+    for_widening :: HsBndrVis GhcPs -> EpaLocation+    for_widening (HsBndrInvisible (EpTok loc)) = loc+    for_widening  _                            = noAnn + whereDots, equalsDots :: SDoc -- Second argument to checkTyVars whereDots  = text "where ..."@@ -989,7 +1003,7 @@                                        (PsErrIllegalDataTypeContext c)  type LRuleTyTmVar = LocatedAn NoEpAnns RuleTyTmVar-data RuleTyTmVar = RuleTyTmVar [AddEpAnn] (LocatedN RdrName) (Maybe (LHsType GhcPs))+data RuleTyTmVar = RuleTyTmVar AnnTyVarBndr (LocatedN RdrName) (Maybe (LHsType GhcPs)) -- ^ Essentially a wrapper for a @RuleBndr GhcPs@  -- turns RuleTyTmVars into RuleBnrs - this is straightforward@@ -1001,18 +1015,15 @@  -- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs]-mkRuleTyVarBndrs = fmap cvt_one-  where cvt_one (L l (RuleTyTmVar ann v Nothing))-          = L (l2l l) (UserTyVar ann () (fmap tm_to_ty v))-        cvt_one (L l (RuleTyTmVar ann v (Just sig)))-          = L (l2l l) (KindedTyVar ann () (fmap tm_to_ty v) sig)-    -- takes something in namespace 'varName' to something in namespace 'tvName'-        tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)-        tm_to_ty _ = panic "mkRuleTyVarBndrs"+mkRuleTyVarBndrs = fmap (setLHsTyVarBndrNameSpace tvName . cvt_one)+  where cvt_one (L l (RuleTyTmVar ann v msig))+          = L (l2l l) (HsTvb ann () (HsBndrVar noExtField v) (cvt_sig msig))+        cvt_sig Nothing    = HsBndrNoKind noExtField+        cvt_sig (Just sig) = HsBndrKind   noExtField sig  -- See Note [Parsing explicit foralls in Rules] in Parser.y checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P ()-checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)+checkRuleTyVarBndrNames = mapM_ check . mapMaybe (hsTyVarLName . unLoc)   where check (L loc (Unqual occ)) =           when (occNameFS occ `elem` [fsLit "family",fsLit "role"])             (addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $@@ -1028,8 +1039,8 @@  -- | Check if the gadt_constrlist is empty. Only raise parse error for -- `data T where` to avoid affecting existing error message, see #8258.-checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs])-                -> P (Located ([AddEpAnn], [LConDecl GhcPs]))+checkEmptyGADTs :: Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs])+                -> P (Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs])) checkEmptyGADTs gadts@(L span (_, []))           -- Empty GADT declaration.     = do gadtSyntax <- getBit GadtSyntaxBit   -- GADTs implies GADTSyntax          unless gadtSyntax $ addError $ mkPlainErrorMsgEnvelope span $@@ -1043,8 +1054,8 @@              -> P (LocatedN RdrName,     -- the head symbol (type or class name)                    [LHsTypeArg GhcPs],   -- parameters of head symbol                    LexicalFixity,        -- the declaration is in infix format-                   [AddEpAnn],           -- API Annotation for HsParTy-                                         -- when stripping parens+                   [EpToken "("],        -- API Annotation for HsParTy+                   [EpToken ")"],        -- when stripping parens                    EpAnnComments)        -- Accumulated comments from re-arranging -- Well-formedness check and decomposition of type and class heads. -- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])@@ -1061,22 +1072,20 @@            ; let name = mkOccNameFS tcClsName (starSym isUni)            ; let a' = newAnns ll l an            ; return (L a' (Unqual name), acc, fix-                    , (reverse ops') ++ cps', cs) }+                    , (reverse ops'), cps', cs) }      go cs l (HsTyVar _ _ ltc@(L _ tc)) acc ops cps fix-      | isRdrTc tc               = return (ltc, acc, fix, (reverse ops) ++ cps, cs Semi.<> comments l)+      | isRdrTc tc               = return (ltc, acc, fix, (reverse ops), cps, cs Semi.<> comments l)     go cs l (HsOpTy _ _ t1 ltc@(L _ tc) t2) acc ops cps _fix-      | isRdrTc tc               = return (ltc, lhs:rhs:acc, Infix, (reverse ops) ++ cps, cs Semi.<> comments l)+      | isRdrTc tc               = return (ltc, lhs:rhs:acc, Infix, (reverse ops), cps, cs Semi.<> comments l)       where lhs = HsValArg noExtField t1             rhs = HsValArg noExtField t2-    go cs l (HsParTy _ ty)    acc ops cps fix = goL (cs Semi.<> comments l) ty acc (o:ops) (c:cps) fix-      where-        (o,c) = mkParensEpAnn (realSrcSpan (locA l))+    go cs l (HsParTy (o,c) ty)    acc ops cps fix = goL (cs Semi.<> comments l) ty acc (o:ops) (c:cps) fix     go cs l (HsAppTy _ t1 t2) acc ops cps fix = goL (cs Semi.<> comments l) t1 (HsValArg noExtField t2:acc) ops cps fix     go cs l (HsAppKindTy at ty ki) acc ops cps fix = goL (cs Semi.<> comments l) ty (HsTypeArg at ki:acc) ops cps fix     go cs l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix       = return (L (l2l l) (nameRdrName tup_name)-               , map (HsValArg noExtField) ts, fix, (reverse ops)++cps, cs Semi.<> comments l)+               , map (HsValArg noExtField) ts, fix, (reverse ops), cps, cs Semi.<> comments l)       where         arity = length ts         tup_name | is_cls    = cTupleTyConName arity@@ -1088,12 +1097,12 @@      -- Combine the annotations from the HsParTy and HsStarTy into a     -- new one for the LocatedN RdrName-    newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN-    newAnns l@(EpAnn _ (AnnListItem _) csp0) l1@(EpAnn ap (AnnListItem ta) csp) (AnnParen _ o c) =+    newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> (EpToken "(", EpToken ")") -> SrcSpanAnnN+    newAnns l@(EpAnn _ (AnnListItem _) csp0) l1@(EpAnn ap (AnnListItem ta) csp) (o,c) =       let         lr = combineSrcSpans (locA l1) (locA l)       in-        EpAnn (EpaSpan lr) (NameAnn NameParens o ap c ta) (csp0 Semi.<> csp)+        EpAnn (EpaSpan lr) (NameAnn (NameParens o c) ap ta) (csp0 Semi.<> csp)  -- | Yield a parse error if we have a function applied directly to a do block -- etc. and BlockArguments is not enabled.@@ -1139,30 +1148,29 @@ checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =   check ([],[],cs) orig_t  where-  check :: ([EpaLocation],[EpaLocation],EpAnnComments)+  check :: ([EpToken "("],[EpToken ")"],EpAnnComments)         -> LHsType GhcPs -> P (LHsContext GhcPs)-  check (oparens,cparens,cs) (L _l (HsTupleTy ann' HsBoxedOrConstraintTuple ts))+  check (oparens,cparens,cs) (L _l (HsTupleTy (AnnParens o c) HsBoxedOrConstraintTuple ts))     -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can     -- be used as context constraints.     -- Ditto ()-    = mkCTuple (oparens ++ [ap_open ann'], ap_close ann' : cparens, cs) ts+    = mkCTuple (oparens ++ [o], c : cparens, cs) ts    -- With NoListTuplePuns, contexts are parsed as data constructors, which causes failure   -- downstream.   -- This converts them just like when they are parsed as types in the punned case.-  check (oparens,cparens,cs) (L _l (HsExplicitTupleTy anns ts))+  check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (q,o,c) _ ts))     = punsAllowed >>= \case       True -> unprocessed       False -> do         let-          (op, cp) = case anns of-            [o, c] -> ([o], [c])-            [q, _, c] -> ([q], [c])-            _ -> ([], [])-        mkCTuple (oparens ++ (addLoc <$> op), (addLoc <$> cp) ++ cparens, cs) ts-  check (opi,cpi,csi) (L _lp1 (HsParTy ann' ty))-                                  -- to be sure HsParTy doesn't get into the way-    = check (ap_open ann':opi, ap_close ann':cpi, csi) ty+          (op, cp) = case q of+            EpTok ql -> ([EpTok ql], [c])+            _        -> ([o], [c])+        mkCTuple (oparens ++ op, cp ++ cparens, cs) ts+  check (opi,cpi,csi) (L _lp1 (HsParTy (o,c) ty))+                                             -- to be sure HsParTy doesn't get into the way+    = check (o:opi, c:cpi, csi) ty    -- No need for anns, returning original   check (_opi,_cpi,_csi) _t = unprocessed@@ -1170,17 +1178,53 @@   unprocessed =     return (L (EpAnn l (AnnContext Nothing [] []) emptyComments) [orig_t]) -  addLoc (AddEpAnn _ l) = l    mkCTuple (oparens, cparens, cs) ts =     -- Append parens so that the original order in the source is maintained     return (L (EpAnn l (AnnContext Nothing oparens cparens) cs) ts) -checkImportDecl :: Maybe EpaLocation-                -> Maybe EpaLocation+-- | The same as `checkContext`, but for expressions.+--+-- Validate the context constraints and break up a context into a list+-- of predicates.+--+-- @+--     (Eq a, Ord b)        -->  [Eq a, Ord b]+--     Eq a                 -->  [Eq a]+--     (Eq a)               -->  [Eq a]+--     (((Eq a)))           -->  [Eq a]+-- @+checkContextExpr :: LHsExpr GhcPs -> PV (LocatedC [LHsExpr GhcPs])+checkContextExpr orig_expr@(L (EpAnn l _ cs) _) =+  check ([],[], cs) orig_expr+  where+    check :: ([EpToken "("],[EpToken ")"],EpAnnComments)+        -> LHsExpr GhcPs -> PV (LocatedC [LHsExpr GhcPs])+    check (oparens,cparens,cs) (L _ (ExplicitTuple (ap_open, ap_close) tup_args boxity))+             -- Neither unboxed tuples (#e1,e2#) nor tuple sections (e1,,e2,) can be a context+      | isBoxed boxity+      , Just es <- tupArgsPresent_maybe tup_args+      = mkCTuple (oparens ++ [EpTok ap_open], EpTok ap_close : cparens, cs) es+    check (opi, cpi, csi) (L _ (HsPar (open_tok, close_tok) expr))+      = check (opi ++ [open_tok], close_tok : cpi, csi) expr+    check (oparens,cparens,cs) (L _ (HsVar _ (L (EpAnn _ (NameAnnOnly (NameParens open closed) []) _) name)))+      | name == nameRdrName (dataConName unitDataCon)+      = mkCTuple (oparens ++ [open], closed : cparens, cs) []+    check _ _ = unprocessed++    unprocessed =+      return (L (EpAnn l (AnnContext Nothing [] []) emptyComments) [orig_expr])++    mkCTuple (oparens, cparens, cs) ts =+      -- Append parens so that the original order in the source is maintained+      return (L (EpAnn l (AnnContext Nothing oparens cparens) cs) ts)++checkImportDecl :: Maybe (EpToken "qualified")+                -> Maybe (EpToken "qualified")                 -> P () checkImportDecl mPre mPost = do   let whenJust mg f = maybe (pure ()) f mg+      tokenSpan tok = RealSrcSpan (epaLocationRealSrcSpan $ getEpTokenLoc tok) Strict.Nothing    importQualifiedPostEnabled <- getBit ImportQualifiedPostBit @@ -1188,18 +1232,18 @@   -- 'ImportQualifiedPost' is not in effect.   whenJust mPost $ \post ->     when (not importQualifiedPostEnabled) $-      failNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing)+      failNotEnabledImportQualifiedPost (tokenSpan post)    -- Error if 'qualified' occurs in both pre and postpositive   -- positions.   whenJust mPost $ \post ->     when (isJust mPre) $-      failImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing)+      failImportQualifiedTwice (tokenSpan post)    -- Warn if 'qualified' found in prepositive position and   -- 'Opt_WarnPrepositiveQualifiedModule' is enabled.   whenJust mPre $ \pre ->-    warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre) Strict.Nothing)+    warnPrepositiveQualifiedModule (tokenSpan pre)  -- ------------------------------------------------------------------------- -- Checking Patterns.@@ -1224,8 +1268,11 @@  checkPat :: SrcSpanAnnA -> EpAnnComments -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]          -> PV (LPat GhcPs, EpAnnComments)+-- SG: I think this function checks what Haskell2010 calls the `pat` and `lpat`+-- productions checkPat loc cs (L l e@(PatBuilderVar (L ln c))) tyargs args-  | isRdrDataCon c = return (L loc $ ConPat+  | isRdrDataCon c || isRdrTc c+  = return (L loc $ ConPat       { pat_con_ext = noAnn -- AZ: where should this come from?       , pat_con = L ln c       , pat_args = PrefixCon tyargs args@@ -1265,19 +1312,19 @@            _                      | nPlusKPatterns && (plus == plus_RDR)                      -> return (mkNPlusKPat (L nloc n) (L (l2l lloc) lit)-                                (entry l))+                                (EpTok $ entry l))     -- Improve error messages for the @-operator when the user meant an @-pattern    PatBuilderOpApp _ op _ _ | opIsAt (unLoc op) -> do      addError $ mkPlainErrorMsgEnvelope (getLocA op) PsErrAtInPatPos      return (WildPat noExtField) -   PatBuilderOpApp l (L cl c) r anns-     | isRdrDataCon c -> do+   PatBuilderOpApp l (L cl c) r (_os,_cs)+     | isRdrDataCon c || isRdrTc c -> do          l <- checkLPat l          r <- checkLPat r          return $ ConPat-           { pat_con_ext = anns+           { pat_con_ext = noAnn            , pat_con = L cl c            , pat_args = InfixCon l r            }@@ -1316,13 +1363,13 @@  checkValDef :: SrcSpan             -> LocatedA (PatBuilder GhcPs)-            -> (HsMultAnn GhcPs, Maybe (AddEpAnn, LHsType GhcPs))+            -> (HsMultAnn GhcPs, Maybe (TokDcolon, LHsType GhcPs))             -> Located (GRHSs GhcPs (LHsExpr GhcPs))             -> P (HsBind GhcPs)  checkValDef loc lhs (mult, Just (sigAnn, sig)) grhss         -- x :: ty = rhs  parses as a *pattern* binding-  = do lhs' <- runPV $ mkHsTySigPV (combineLocsA lhs sig) lhs sig [sigAnn]+  = do lhs' <- runPV $ mkHsTySigPV (combineLocsA lhs sig) lhs sig sigAnn                         >>= checkLPat        checkPatBind loc lhs' grhss mult @@ -1330,9 +1377,11 @@   | HsNoMultAnn{} <- mult_ann   = do  { mb_fun <- isFunLhs lhs         ; case mb_fun of-            Just (fun, is_infix, pats, ann) ->-              checkFunBind NoSrcStrict loc ann-                           fun is_infix pats grhss+            Just (fun, is_infix, pats, ops, cps) -> do+              let ann_fun = mk_ann_funrhs ops cps+              let l = listLocation pats+              checkFunBind loc ann_fun+                           fun is_infix (L l pats) grhss             Nothing -> do               lhs' <- checkPattern lhs               checkPatBind loc lhs' grhss mult_ann }@@ -1342,24 +1391,27 @@   = do lhs' <- checkPattern lhs        checkPatBind loc lhs' ghrss mult_ann -checkFunBind :: SrcStrictness-             -> SrcSpan-             -> [AddEpAnn]+mk_ann_funrhs :: [EpToken "("] -> [EpToken ")"] -> AnnFunRhs+mk_ann_funrhs ops cps = AnnFunRhs NoEpTok ops cps++checkFunBind :: SrcSpan+             -> AnnFunRhs              -> LocatedN RdrName              -> LexicalFixity-             -> [LocatedA (ArgPatBuilder GhcPs)]+             -> LocatedE [LocatedA (ArgPatBuilder GhcPs)]              -> Located (GRHSs GhcPs (LHsExpr GhcPs))              -> P (HsBind GhcPs)-checkFunBind strictness locF ann (L lf fun) is_infix pats (L _ grhss)+checkFunBind locF ann_fun (L lf fun) is_infix (L lp pats) (L _ grhss)   = do  ps <- runPV_details extraDetails (mapM checkLArgPat pats)         let match_span = noAnnSrcSpan $ locF         return (makeFunBind (L (l2l lf) fun) (L (noAnnSrcSpan $ locA match_span)-                 [L match_span (Match { m_ext = ann+                 [L match_span (Match { m_ext = noExtField                                       , m_ctxt = FunRhs                                           { mc_fun    = L lf fun                                           , mc_fixity = is_infix-                                          , mc_strictness = strictness }-                                      , m_pats = ps+                                          , mc_strictness = NoSrcStrict+                                          , mc_an = ann_fun }+                                      , m_pats = L lp ps                                       , m_grhss = grhss })]))         -- The span of the match covers the entire equation.         -- That isn't quite right, but it'll do for now.@@ -1368,7 +1420,7 @@       | Infix <- is_infix = ParseContext (Just fun) NoIncompleteDoBlock       | otherwise         = noParseContext -makeFunBind :: LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)]+makeFunBind :: LocatedN RdrName -> LocatedLW [LMatch GhcPs (LHsExpr GhcPs)]             -> HsBind GhcPs -- Like GHC.Hs.Utils.mkFunBind, but we need to be able to set the fixity too makeFunBind fn ms@@ -1382,16 +1434,17 @@              -> Located (GRHSs GhcPs (LHsExpr GhcPs))              -> HsMultAnn GhcPs              -> P (HsBind GhcPs)-checkPatBind loc (L _ (BangPat ans (L _ (VarPat _ v))))+checkPatBind loc (L _ (BangPat an (L _ (VarPat _ v))))                         (L _match_span grhss) (HsNoMultAnn _)       = return (makeFunBind v (L (noAnnSrcSpan loc)-                [L (noAnnSrcSpan loc) (m ans v)]))+                [L (noAnnSrcSpan loc) (m an v)]))   where-    m a v = Match { m_ext = a+    m a v = Match { m_ext = noExtField                   , m_ctxt = FunRhs { mc_fun    = v                                     , mc_fixity = Prefix-                                    , mc_strictness = SrcStrict }-                  , m_pats = []+                                    , mc_strictness = SrcStrict+                                    , mc_an = AnnFunRhs a [] [] }+                  , m_pats = noLocA []                  , m_grhss = grhss }  checkPatBind _loc lhs (L _ grhss) mult = do@@ -1430,7 +1483,7 @@  isFunLhs :: LocatedA (PatBuilder GhcPs)       -> P (Maybe (LocatedN RdrName, LexicalFixity,-                   [LocatedA (ArgPatBuilder GhcPs)],[AddEpAnn]))+                   [LocatedA (ArgPatBuilder GhcPs)],[EpToken "("],[EpToken ")"])) -- A variable binding is parsed as a FunBind. -- Just (fun, is_infix, arg_pats) if e is a function LHS isFunLhs e = go e [] [] []@@ -1440,7 +1493,7 @@    go (L l (PatBuilderVar (L loc f))) es ops cps        | not (isRdrDataCon f)        = do            let (_l, loc') = transferCommentsOnlyA l loc-           return (Just (L loc' f, Prefix, es, (reverse ops) ++ cps))+           return (Just (L loc' f, Prefix, es, (reverse ops), cps))    go (L l (PatBuilderApp (L lf f) e))   es       ops cps = do      let (_l, lf') = transferCommentsOnlyA l lf      go (L lf' f) (mk e:es) ops cps@@ -1450,28 +1503,26 @@       -- of funlhs.      where        (_l, le') = transferCommentsOnlyA l le-       (o,c) = mkParensEpAnn (realSrcSpan $ locA l)-   go (L loc (PatBuilderOpApp (L ll l) (L loc' op) r anns)) es ops cps+       (o,c) = mkParensEpToks (realSrcSpan $ locA l)+   go (L loc (PatBuilderOpApp (L ll l) (L loc' op) r (os,cs))) es ops cps       | not (isRdrDataCon op)         -- We have found the function!       = do { let (_l, ll') = transferCommentsOnlyA loc ll-           ; return (Just (L loc' op, Infix, (mk (L ll' l):mk r:es), (anns ++ reverse ops ++ cps))) }+           ; return (Just (L loc' op, Infix, (mk (L ll' l):mk r:es), (os ++ reverse ops), (cs ++ cps))) }       | otherwise                     -- Infix data con; keep going       = do { let (_l, ll') = transferCommentsOnlyA loc ll            ; mb_l <- go (L ll' l) es ops cps            ; return (reassociate =<< mb_l) }         where-          reassociate (op', Infix, j : L k_loc (ArgPatBuilderVisPat k) : es', anns')-            = Just (op', Infix, j : op_app : es', anns')+          reassociate (op', Infix, j : L k_loc (ArgPatBuilderVisPat k) : es', ops', cps')+            = Just (op', Infix, j : op_app : es', ops', cps')             where               op_app = mk $ L loc (PatBuilderOpApp (L k_loc k)-                                    (L loc' op) r (reverse ops ++ cps))+                                    (L loc' op) r (reverse ops, cps))           reassociate _other = Nothing    go (L l (PatBuilderAppType (L lp pat) tok ty_pat@(HsTP _ (L (EpAnn anc ann cs) _)))) es ops cps              = go (L lp' pat) (L (EpAnn anc' ann cs) (ArgPatBuilderArgPat invis_pat) : es) ops cps-             where invis_pat = InvisPat tok ty_pat-                   anc' = case tok of-                     NoEpTok -> anc-                     EpTok l -> widenAnchor anc [AddEpAnn AnnAnyclass l]+             where invis_pat = InvisPat (tok, SpecifiedSpec) ty_pat+                   anc' = widenAnchorT anc tok                    (_l, lp') = transferCommentsOnlyA l lp    go _ _ _ _ = return Nothing @@ -1483,13 +1534,13 @@   ppr (ArgPatBuilderVisPat p) = ppr p   ppr (ArgPatBuilderArgPat p) = ppr p -mkBangTy :: [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs-mkBangTy anns strictness =-  HsBangTy anns (HsSrcBang NoSourceText NoSrcUnpack strictness)+mkBangTy :: EpaLocation -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs+mkBangTy tok_loc strictness =+  HsBangTy ((noAnn, noAnn, tok_loc), NoSourceText) (HsBang NoSrcUnpack strictness)  -- | Result of parsing @{-\# UNPACK \#-}@ or @{-\# NOUNPACK \#-}@. data UnpackednessPragma =-  UnpackednessPragma [AddEpAnn] SourceText SrcUnpackedness+  UnpackednessPragma (EpaLocation, EpToken "#-}") SourceText SrcUnpackedness  -- | Annotate a type with either an @{-\# UNPACK \#-}@ or a @{-\# NOUNPACK \#-}@ pragma. addUnpackednessP :: MonadP m => Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs)@@ -1502,11 +1553,11 @@     -- such as ~T or !T, then add the pragma to the existing HsBangTy.     --     -- Otherwise, wrap the type in a new HsBangTy constructor.-    addUnpackedness an (L _ (HsBangTy x bang t))-      | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang-      = HsBangTy (an Semi.<> x) (HsSrcBang prag unpk strictness) t-    addUnpackedness an t-      = HsBangTy an (HsSrcBang prag unpk NoSrcStrict) t+    addUnpackedness (o,c) (L _ (HsBangTy ((_,_,tl), NoSourceText) bang t))+      | HsBang NoSrcUnpack strictness <- bang+      = HsBangTy ((o,c,tl), prag) (HsBang unpk strictness) t+    addUnpackedness (o,c) t+      = HsBangTy ((o,c,noAnn), prag) (HsBang unpk NoSrcStrict) t  --------------------------------------------------------------------------- -- | Check for monad comprehensions@@ -1547,6 +1598,9 @@ ecpFromCmd :: LHsCmd GhcPs -> ECP ecpFromCmd a = ECP (ecpFromCmd' a) +ecpFromPat :: LPat GhcPs -> ECP+ecpFromPat a = ECP (ecpFromPat' a)+ -- The 'fbinds' parser rule produces values of this type. See Note -- [RecordDotSyntax field updates]. type Fbind b = Either (LHsRecField GhcPs (LocatedA b)) (LHsRecProj GhcPs (LocatedA b))@@ -1570,11 +1624,11 @@  type AnnoBody b   = ( Anno (GRHS GhcPs (LocatedA (Body b GhcPs))) ~ EpAnnCO-    , Anno [LocatedA (Match GhcPs (LocatedA (Body b GhcPs)))] ~ SrcSpanAnnL+    , Anno [LocatedA (Match GhcPs (LocatedA (Body b GhcPs)))] ~ SrcSpanAnnLW     , Anno (Match GhcPs (LocatedA (Body b GhcPs))) ~ SrcSpanAnnA     , Anno (StmtLR GhcPs GhcPs (LocatedA (Body (Body b GhcPs) GhcPs))) ~ SrcSpanAnnA     , Anno [LocatedA (StmtLR GhcPs GhcPs-                       (LocatedA (Body (Body (Body b GhcPs) GhcPs) GhcPs)))] ~ SrcSpanAnnL+                       (LocatedA (Body (Body (Body b GhcPs) GhcPs) GhcPs)))] ~ SrcSpanAnnLW     )  -- | Disambiguate constructs that may appear when we do not know ahead of time whether we are@@ -1587,8 +1641,10 @@   ecpFromCmd' :: LHsCmd GhcPs -> PV (LocatedA b)   -- | Return an expression without ambiguity, or fail in a non-expression context.   ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b)+  -- | Return a pattern without ambiguity, or fail in a non-pattern context.+  ecpFromPat' :: LPat GhcPs -> PV (LocatedA b)   mkHsProjUpdatePV :: SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]-    -> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b))+    -> LocatedA b -> Bool -> Maybe (EpToken "=") -> PV (LHsRecProj GhcPs (LocatedA b))   -- | Disambiguate "let ... in ..."   mkHsLetPV     :: SrcSpan@@ -1607,11 +1663,11 @@   mkHsOpAppPV :: SrcSpan -> LocatedA b -> LocatedN (InfixOp b) -> LocatedA b               -> PV (LocatedA b)   -- | Disambiguate "case ... of ..."-  mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedL [LMatch GhcPs (LocatedA b)])+  mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedLW [LMatch GhcPs (LocatedA b)])              -> EpAnnHsCase -> PV (LocatedA b)   -- | Disambiguate "\... -> ..." (lambda), "\case" and "\cases"   mkHsLamPV :: SrcSpan -> HsLamVariant-            -> (LocatedL [LMatch GhcPs (LocatedA b)]) -> [AddEpAnn]+            -> (LocatedLW [LMatch GhcPs (LocatedA b)]) -> EpAnnLam             -> PV (LocatedA b)   -- | Function argument representation   type FunArg b@@ -1635,8 +1691,9 @@   mkHsDoPV ::     SrcSpan ->     Maybe ModuleName ->-    LocatedL [LStmt GhcPs (LocatedA b)] ->-    AnnList ->+    LocatedLW [LStmt GhcPs (LocatedA b)] ->+    EpaLocation -> -- Token+    EpaLocation -> -- Anchor     PV (LocatedA b)   -- | Disambiguate "( ... )" (parentheses)   mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b)@@ -1650,9 +1707,9 @@   mkHsWildCardPV :: (NoAnn a) => SrcSpan -> PV (LocatedAn a b)   -- | Disambiguate "a :: t" (type annotation)   mkHsTySigPV-    :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)+    :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> TokDcolon -> PV (LocatedA b)   -- | Disambiguate "[a,b,c]" (list syntax)-  mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)+  mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList () -> PV (LocatedA b)   -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices)   mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b)   -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates)@@ -1662,26 +1719,35 @@     SrcSpan ->     LocatedA b ->     ([Fbind b], Maybe SrcSpan) ->-    [AddEpAnn] ->+    (Maybe (EpToken "{"), Maybe (EpToken "}")) ->     PV (LocatedA b)   -- | Disambiguate "-a" (negation)-  mkHsNegAppPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)+  mkHsNegAppPV :: SrcSpan -> LocatedA b -> EpToken "-" -> PV (LocatedA b)   -- | Disambiguate "(# a)" (right operator section)   mkHsSectionR_PV     :: SrcSpan -> LocatedA (InfixOp b) -> LocatedA b -> PV (LocatedA b)-  -- | Disambiguate "(a -> b)" (view pattern)-  mkHsViewPatPV-    :: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)+  -- | Disambiguate "(a -> b)" (view pattern or function type arrow)+  mkHsArrowPV+    :: SrcSpan -> ArrowParsingMode lhs b -> LocatedA lhs -> HsArrowOf (LocatedA b) GhcPs -> LocatedA b -> PV (LocatedA b)+  -- | Disambiguate "%m" to the left of "->" (multiplicity)+  mkHsMultPV+    :: EpToken "%" -> LocatedA b -> PV (TokRarrow -> HsArrowOf (LocatedA b) GhcPs)+  -- | Disambiguate "forall a. b" and "forall a -> b" (forall telescope)+  mkHsForallPV :: SrcSpan -> HsForAllTelescope GhcPs -> LocatedA b -> PV (LocatedA b)+  -- | Disambiguate "(a,b,c)" to the left of "=>" (constraint list)+  checkContextPV :: LocatedA b -> PV (LocatedC [LocatedA b])+  -- | Disambiguate "a => b" (constraint context)+  mkQualPV :: SrcSpan -> LocatedC [LocatedA b] -> LocatedA b -> PV (LocatedA b)   -- | Disambiguate "a@b" (as-pattern)   mkHsAsPatPV     :: SrcSpan -> LocatedN RdrName -> EpToken "@" -> LocatedA b -> PV (LocatedA b)   -- | Disambiguate "~a" (lazy pattern)-  mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)+  mkHsLazyPatPV :: SrcSpan -> LocatedA b -> EpToken "~" -> PV (LocatedA b)   -- | Disambiguate "!a" (bang pattern)-  mkHsBangPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)+  mkHsBangPatPV :: SrcSpan -> LocatedA b -> EpToken "!" -> PV (LocatedA b)   -- | Disambiguate tuple sections and unboxed sums   mkSumOrTuplePV-    :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b)+    :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> (EpaLocation, EpaLocation) -> PV (LocatedA b)   -- | Disambiguate "type t" (embedded type)   mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)   -- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas@@ -1735,6 +1801,7 @@   type Body (HsCmd GhcPs) = HsCmd   ecpFromCmd' = return   ecpFromExp' (L l e) = cmdFail (locA l) (ppr e)+  ecpFromPat' (L l p) = cmdFail (locA l) (ppr p)   mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $                                                  PsErrOverloadedRecordDotInvalid   mkHsLamPV l lam_variant (L lm m) anns = do@@ -1753,7 +1820,7 @@   mkHsOpAppPV l c1 op c2 = do     let cmdArg c = L (l2l $ getLoc c) $ HsCmdTop noExtField c     !cs <- getCommentsFor l-    return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ HsCmdArrForm (AnnList Nothing Nothing Nothing [] []) (reLoc op) Infix Nothing [cmdArg c1, cmdArg c2]+    return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ HsCmdArrForm noAnn (reLoc op) Infix [cmdArg c1, cmdArg c2]    mkHsCasePV l c (L lm m) anns = do     !cs <- getCommentsFor l@@ -1771,10 +1838,10 @@     checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b     !cs <- getCommentsFor l     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns)-  mkHsDoPV l Nothing stmts anns = do+  mkHsDoPV l Nothing stmts tok_loc anc = do     !cs <- getCommentsFor l-    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo anns stmts)-  mkHsDoPV l (Just m)    _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m+    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) ListNone [] tok_loc []) stmts)+  mkHsDoPV l (Just m)    _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m   mkHsParPV l lpar c rpar = do     !cs <- getCommentsFor l     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c)@@ -1796,8 +1863,18 @@     let pp_op = fromMaybe (panic "cannot print infix operator")                           (ppr_infix_expr (unLoc op))     in pp_op <> ppr c-  mkHsViewPatPV l a b _ = cmdFail l $-    ppr a <+> text "->" <+> ppr b+  mkHsArrowPV l mode a arr b = cmdFail l $+    case mode of  -- matching on the mode brings Outputable instances into scope+      ArrowIsViewPat -> ppr a <+> pprHsArrow arr <+> ppr b+      ArrowIsFunType -> ppr a <+> pprHsArrow arr <+> ppr b+  mkHsMultPV pct mult = cmdFail l $+    ppr pct <> ppr mult+    where l = getHasLoc pct `combineSrcSpans` getHasLoc mult+  mkHsForallPV l tele cmd = cmdFail l $+    pprHsForAll tele Nothing <+> ppr cmd+  checkContextPV ctxt = cmdFail (getLocA ctxt) $ ppr ctxt+  mkQualPV l ctxt cmd = cmdFail l $+    ppr ctxt <+> text "=>" <+> ppr cmd   mkHsAsPatPV l v _ c = cmdFail l $     pprPrefixOcc (unLoc v) <> text "@" <> ppr c   mkHsLazyPatPV l c _ = cmdFail l $@@ -1822,6 +1899,9 @@     addError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowCmdInExpr c     return (L l (hsHoleExpr noAnn))   ecpFromExp' = return+  ecpFromPat' p@(L l _) = do+    addError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrOrPatInExpr p+    return (L l (hsHoleExpr noAnn))   mkHsProjUpdatePV l fields arg isPun anns = do     !cs <- getCommentsFor l     return $ mkRdrProjUpdate (EpAnn (spanAsAnchor l) noAnn cs) fields arg isPun anns@@ -1832,7 +1912,7 @@   superInfixOp m = m   mkHsOpAppPV l e1 op e2 = do     !cs <- getCommentsFor l-    return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ OpApp [] e1 (reLoc op) e2+    return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ OpApp noExtField e1 (reLoc op) e2   mkHsCasePV l e (L lm m) anns = do     !cs <- getCommentsFor l     let mg = mkMatchGroup FromSource (L lm m)@@ -1855,9 +1935,9 @@     checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b     !cs <- getCommentsFor l     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns)-  mkHsDoPV l mod stmts anns = do+  mkHsDoPV l mod stmts loc_tok anc = do     !cs <- getCommentsFor l-    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo anns (DoExpr mod) stmts)+    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) ListNone [] loc_tok []) (DoExpr mod) stmts)   mkHsParPV l lpar e rpar = do     !cs <- getCommentsFor l     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)@@ -1890,8 +1970,6 @@   mkHsSectionR_PV l op e = do     !cs <- getCommentsFor l     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (SectionR noExtField op e)-  mkHsViewPatPV l a b _ = addError (mkPlainErrorMsgEnvelope l $ PsErrViewPatInExpr a b)-                          >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn))   mkHsAsPatPV l v _ e   = addError (mkPlainErrorMsgEnvelope l $ PsErrTypeAppWithoutSpace (unLoc v) e)                           >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn))   mkHsLazyPatPV l e   _ = addError (mkPlainErrorMsgEnvelope l $ PsErrLazyPatWithoutSpace e)@@ -1902,6 +1980,21 @@   mkHsEmbTyPV l toktype ty =     return $ L (noAnnSrcSpan l) $       HsEmbTy toktype (mkHsWildCardBndrs ty)+  mkHsArrowPV l mode arg arr res =+    -- In expressions, (e1 -> e2) is always parsed as a function type,+    -- even if ViewPatterns are enabled.+    exprArrowParsingMode mode $+    return $ L (noAnnSrcSpan l) $+      HsFunArr noExtField arr arg res+  mkHsMultPV pct t =+    return $ mkMultExpr pct t+  mkHsForallPV l telescope ty =+    return $ L (noAnnSrcSpan l) $+      HsForAll noExtField (setTelescopeBndrsNameSpace varName telescope) ty+  checkContextPV = checkContextExpr+  mkQualPV l qual ty =+    return $ L (noAnnSrcSpan l) $+      HsQual noExtField qual ty   rejectPragmaPV (L _ (OpApp _ _ _ e)) =     -- assuming left-associative parsing of operators     rejectPragmaPV e@@ -1916,13 +2009,14 @@   type Body (PatBuilder GhcPs) = PatBuilder   ecpFromCmd' (L l c)    = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowCmdInPat c   ecpFromExp' (L l e)    = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowExprInPat e+  ecpFromPat' (L l p)    = return $ L l (PatBuilderPat p)   mkHsLetPV l _ _ _ _    = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLetInPat   mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrOverloadedRecordDotInvalid   type InfixOp (PatBuilder GhcPs) = RdrName   superInfixOp m = m   mkHsOpAppPV l p1 op p2 = do     !cs <- getCommentsFor l-    return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ PatBuilderOpApp p1 op p2 []+    return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ PatBuilderOpApp p1 op p2 ([],[])    mkHsLamPV l lam_variant _ _     = addFatalError $ mkPlainErrorMsgEnvelope l (PsErrLambdaInPat lam_variant) @@ -1934,7 +2028,7 @@     !cs <- getCommentsFor (locA l)     return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t))   mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat-  mkHsDoPV l _ _ _       = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat+  mkHsDoPV l _ _ _ _    = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat   mkHsParPV l lpar p rpar   = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar)   mkHsVarPV v@(getLoc -> l) = return $ L (l2l l) (PatBuilderVar v)   mkHsLitPV lit@(L l a) = do@@ -1943,9 +2037,11 @@     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (LitPat noExtField a))   mkHsOverLitPV (L l a) = return $ L l (PatBuilderOverLit a)   mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (PatBuilderPat (WildPat noExtField))-  mkHsTySigPV l b sig anns = do-    p <- checkLPat b-    return $ L l (PatBuilderPat (SigPat anns p (mkHsPatSigType noAnn sig)))+  mkHsTySigPV l p t anns = do+    p' <- checkLPat p+    let sig = mkHsPatSigType noAnn t+    sig_pat <- addSigPatP l p' sig anns+    return $ fmap PatBuilderPat sig_pat   mkHsExplicitListPV l xs anns = do     ps <- traverse checkLPat xs     !cs <- getCommentsFor l@@ -1968,10 +2064,27 @@     !cs <- getCommentsFor l     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (mkNPat lit (Just noSyntaxExpr) anns))   mkHsSectionR_PV l op p = patFail l (PsErrParseRightOpSectionInPat (unLoc op) (unLoc p))-  mkHsViewPatPV l a b anns = do-    p <- checkLPat b-    !cs <- getCommentsFor l-    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (ViewPat anns a p))+  mkHsArrowPV l ArrowIsViewPat a arr b = do+      p <- checkLPat b+      !cs <- getCommentsFor l+      return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (ViewPat tok a p))+    where+      tok :: TokRarrow+      tok = case arr of+        HsUnrestrictedArrow x -> x+        _ -> -- unreachable case because in Parser.y the reduction rules for+             -- (a %m -> b) and (a ->. b) use ArrowIsFunType+             panic "mkHsArrowPV ArrowIsViewPat: expected HsUnrestrictedArrow"+  mkHsArrowPV l ArrowIsFunType a arr b =+    patFail l (PsErrTypeSyntaxInPat (PETS_FunctionArrow a arr b))+  mkHsMultPV tok arg =+    let l = getHasLoc tok `combineSrcSpans` getLocA arg in+    patFail l (PsErrTypeSyntaxInPat (PETS_Multiplicity tok arg))+  mkHsForallPV l tele body = patFail l (PsErrTypeSyntaxInPat (PETS_ForallTelescope tele body))+  checkContextPV ctx = patFail (getLocA ctx) (PsErrTypeSyntaxInPat (PETS_ConstraintContext ctx))+  mkQualPV _ _ _ =  -- unreachable because mkQualPV is only called on the result+                    -- of checkContextPV, which fails in patterns+                  panic "mkQualPV in a pattern"   mkHsAsPatPV l v at e = do     p <- checkLPat e     !cs <- getCommentsFor l@@ -1992,6 +2105,149 @@       PatBuilderPat (EmbTyPat toktype (mkHsTyPat ty))   rejectPragmaPV _ = return () +-- For reasons of backwards compatibility, we can't simply add the pattern+-- signature if the inner pattern is a view pattern. Consider:+--      (f -> p :: t)+-- There are two ways to parse it+--      (f -> (p :: t))   -- legacy parse+--      ((f -> p) :: t)   -- future parse+-- The grammar in Parser.y is structured in such a way that we get the+-- future parse by default. Until we're ready to make the breaking change,+-- we need to do some extra work here to push the signature under the view+-- pattern (and emit a warning).+addSigPatP :: SrcSpanAnnA -> LPat GhcPs -> HsPatSigType GhcPs -> TokDcolon -> PV (LPat GhcPs)+addSigPatP l viewpat@(L _ ViewPat{}) sig anns =+  -- Test case: T24159_viewpat+  do { let futureParse = L l (SigPat anns viewpat sig)+     ; legacyParse <- go viewpat+     ; addPsMessage (locA l) (PsWarnViewPatternSignatures legacyParse futureParse)+     ; return legacyParse }+  where+    sig_loc_no_comments :: SrcSpan+    sig_loc_no_comments = getLocA (hsps_body sig)++    -- Test case for comments and locations preservation: Test24159+    go :: LPat GhcPs -> PV (LPat GhcPs)+    go  (L (EpAnn (EpaSpan view_pat_loc) anns cs1) (ViewPat anns' e' p')) = do+      sig' <- go  p'+      let new_loc = view_pat_loc `combineSrcSpans` sig_loc_no_comments+      cs2 <- getCommentsFor new_loc+      let ep_ann_loc = EpAnn (spanAsAnchor new_loc) anns (cs1 Semi.<> cs2)+      pure (L ep_ann_loc (ViewPat anns' e' sig'))++    go p = pure $ L new_loc (SigPat anns p sig)+      where new_loc = noAnnSrcSpan ((getLocA p) `combineSrcSpans` sig_loc_no_comments)++addSigPatP l p sig anns = do+  return $ L l (SigPat anns p sig)++{- Note [Arrow parsing mode]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this example:+  f (K (a -> b)) = ()++A pattern of the form (a -> b) could be parsed in one of two ways:+  * a view pattern `viewfn -> pat` (with ViewPatterns)+  * a function type `t1 -> t2`     (with RequiredTypeArguments)++This depends on the enabled extensions:+  NoViewPatterns, RequiredTypeArguments     =>  function type+  NoViewPatterns, NoRequiredTypeArguments   =>  error (suggest ViewPatterns)+  ViewPatterns,   RequiredTypeArguments     =>  view pattern+  ViewPatterns,   NoRequiredTypeArguments   =>  view pattern++The decision how to parse arrow patterns (p1 -> p2) is captured by the+`ArrowParsingMode` data type, produced in `withArrowParsingMode` and+consumed in `mkHsArrowPV`.++Naively, one might expect to see the following definition:++  -- a simple (but insufficient) definition+  data ArrowParsingMode = ArrowIsViewPat | ArrowIsFunType++However, there is a slight complication that leads us to parameterize these+constructor with GADT type indices. In a pattern (p1 -> p2), what is the AST+type to represent the LHS `p1`? It depends:+  * if (p1 -> p2) is a view pattern,  `p1` is an HsExpr+  * if (p1 -> p2) is a function type, `p1` is a  Pat (PatBuilder)++And since the decision how to parse `p1` depends on the arrow parsing mode, we+could try to encode the LHS type as a GADT index:++  -- a less simple (but still insufficient) definition+  data ArrowParsingMode lhs where+    ArrowIsViewPat :: ArrowParsingMode (PatBuilder GhcPs)+    ArrowIsFunType :: ArrowParsingMode (HsExpr GhcPs)++This definition would suffice for parsing patterns, but remember that+expressions, commands, and patterns are all parsed using a unified framework+`DisambECP`, as described in Note [Ambiguous syntactic categories].++In an expression (e1 -> e2), the LHS is always represented by an HsExpr.+We can account for this with a further refinement of the definition:++  -- actual definition+  data ArrowParsingMode lhs rhs where+    ArrowIsViewPat :: ArrowParsingMode (HsExpr GhcPs) b+    ArrowIsFunType :: ArrowParsingMode b b++So when parsing a view pattern, the LHS is an HsExpr; and when parsing a+function type, the type of the LHS is assumed to match the type of the RHS,+which works out just right both for expressions and patterns.+-}++-- The arrow parsing mode is selected depending on the enabled extensions and+-- determines how we parse patterns of the form (p1 -> p2). See Note [Arrow parsing mode]+data ArrowParsingMode lhs rhs where+  ArrowIsViewPat :: ArrowParsingMode (HsExpr GhcPs) b   -- the LHS is always of type HsExpr+  ArrowIsFunType :: ArrowParsingMode b b                -- the LHS is of the same type as RHS++-- When parsing an expression (e1 -> e2), the LHS `e1` is an HsExpr regardless of+-- the arrow parsing mode. `exprArrowParsingMode` proves this to the type checker.+-- See Note [Arrow parsing mode]+exprArrowParsingMode :: ArrowParsingMode lhs (HsExpr GhcPs) -> (lhs ~ HsExpr GhcPs => r) -> r+exprArrowParsingMode ArrowIsViewPat k = k+exprArrowParsingMode ArrowIsFunType k = k++-- Check the enabled extensions and select the appropriate ArrowParsingMode,+-- then pass it to a continuation. See Note [Arrow parsing mode]+withArrowParsingMode :: DisambECP b => (forall lhs. DisambECP lhs => ArrowParsingMode lhs b -> PV r) -> PV r+withArrowParsingMode cont = do+  vpEnabled <- getBit ViewPatternsBit+  rtaEnabled <- getBit RequiredTypeArgumentsBit+  if | vpEnabled  -> cont ArrowIsViewPat+     | rtaEnabled -> cont ArrowIsFunType+     | otherwise  -> cont ArrowIsViewPat -- Error message should suggest ViewPatterns in patterns++-- Type-restricted variant of `withArrowParsingMode` to aid type inference (#25103)+withArrowParsingMode' :: DisambECP b => (forall lhs. DisambECP lhs => ArrowParsingMode lhs b -> PV (LocatedA b)) -> PV (LocatedA b)+withArrowParsingMode' = withArrowParsingMode++-- When a forall-type occurs in term syntax, forall-bound variables should+-- inhabit the term namespace `varName` rather than the usual `tvName`.+-- See Note [Types in terms].+--+-- Since type variable binders in a `HsForAllTelescope` produced by the+-- `forall_telescope` nonterminal have their namespaces set to `tvName`,+-- we use `setTelescopeBndrsNameSpace` to fix them up.+setTelescopeBndrsNameSpace :: NameSpace -> HsForAllTelescope GhcPs -> HsForAllTelescope GhcPs+setTelescopeBndrsNameSpace ns forall_telescope =+  case forall_telescope of+    HsForAllInvis x bndrs -> HsForAllInvis x (set_bndrs_ns bndrs)+    HsForAllVis   x bndrs -> HsForAllVis   x (set_bndrs_ns bndrs)+  where+    set_bndrs_ns :: [LHsTyVarBndr flag GhcPs] -> [LHsTyVarBndr flag GhcPs]+    set_bndrs_ns = map (setLHsTyVarBndrNameSpace ns)++setLHsTyVarBndrNameSpace :: NameSpace -> LHsTyVarBndr flag GhcPs -> LHsTyVarBndr flag GhcPs+setLHsTyVarBndrNameSpace ns (L l tvb) = L l tvb'+  where tvb' = tvb { tvb_var = setHsBndrVarNameSpace ns (tvb_var tvb) }++setHsBndrVarNameSpace :: NameSpace -> HsBndrVar GhcPs -> HsBndrVar GhcPs+setHsBndrVarNameSpace ns (HsBndrVar x (L l rdr)) = HsBndrVar x (L l rdr')+  where rdr' = setRdrNameSpace rdr ns+setHsBndrVarNameSpace _ (HsBndrWildCard x) = HsBndrWildCard x+ -- | Ensure that a literal pattern isn't of type Addr#, Float#, Double#. checkUnboxedLitPat :: Located (HsLit GhcPs) -> PV () checkUnboxedLitPat (L loc lit) =@@ -2021,15 +2277,15 @@ mkPatRec ::   LocatedA (PatBuilder GhcPs) ->   HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->-  [AddEpAnn] ->+  (Maybe (EpToken "{"), Maybe (EpToken "}")) ->   PV (PatBuilder GhcPs)-mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) anns+mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields x fs dd) anns   | isRdrDataCon (unLoc c)   = do fs <- mapM checkPatField fs        return $ PatBuilderPat $ ConPat          { pat_con_ext = anns          , pat_con = c-         , pat_args = RecCon (HsRecFields fs dd)+         , pat_args = RecCon (HsRecFields x fs dd)          } mkPatRec p _ _ =   addFatalError $ mkPlainErrorMsgEnvelope (getLocA p) $@@ -2611,7 +2867,7 @@         -> LHsExpr GhcPs         -> SrcSpan         -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)-        -> [AddEpAnn]+        -> (Maybe (EpToken "{"), Maybe (EpToken "}"))         -> PV (HsExpr GhcPs) mkRecConstrOrUpdate _ (L _ (HsVar _ (L l c))) _lrec (fbinds,dd) anns   | isRdrDataCon c@@ -2626,7 +2882,8 @@                                           PsErrDotsInRecordUpdate   | otherwise = mkRdrRecordUpd overloaded_update exp fs anns -mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> [AddEpAnn] -> PV (HsExpr GhcPs)+mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> (Maybe (EpToken "{"), Maybe (EpToken "}"))+  -> PV (HsExpr GhcPs) mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do   -- We do not need to know if OverloadedRecordDot is in effect. We do   -- however need to know if OverloadedRecordUpdate (passed in@@ -2652,7 +2909,7 @@     True -> do       let qualifiedFields =             [ L l lbl | L _ (HsFieldBind _ (L l lbl) _ _) <- fs'-                      , isQual . ambiguousFieldOccRdrName $ lbl+                      , isQual . fieldOccRdrName $ lbl             ]       case qualifiedFields of           qf:_ -> addFatalError $ mkPlainErrorMsgEnvelope (getLocA qf) $@@ -2687,25 +2944,25 @@           punnedVar f  = if not pun then arg else noLocA . HsVar noExtField . noLocA . mkRdrUnqual . mkVarOccFS $ f  mkRdrRecordCon-  :: LocatedN RdrName -> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs+  :: LocatedN RdrName -> HsRecordBinds GhcPs -> (Maybe (EpToken "{"), Maybe (EpToken "}")) -> HsExpr GhcPs mkRdrRecordCon con flds anns   = RecordCon { rcon_ext = anns, rcon_con = con, rcon_flds = flds } -mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg-mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }-mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs+mk_rec_fields :: [LocatedA (HsRecField GhcPs arg)] -> Maybe SrcSpan -> HsRecFields GhcPs arg+mk_rec_fields fs Nothing = HsRecFields { rec_ext = noExtField, rec_flds = fs, rec_dotdot = Nothing }+mk_rec_fields fs (Just s)  = HsRecFields { rec_ext = noExtField, rec_flds = fs                                      , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) }  mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun)-  = HsFieldBind noAnn (L loc (Unambiguous noExtField rdr)) arg pun+  = HsFieldBind noAnn (L loc (FieldOcc noExtField rdr)) arg pun  mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation                -> InlinePragma -- The (Maybe Activation) is because the user can omit -- the activation spec (and usually does) mkInlinePragma src (inl, match_info) mb_act-  = InlinePragma { inl_src = src -- Note [Pragma source text] in "GHC.Types.SourceText"+  = InlinePragma { inl_src = src -- See Note [Pragma source text] in "GHC.Types.SourceText"                  , inl_inline = inl                  , inl_sat    = Nothing                  , inl_act    = act@@ -2762,8 +3019,9 @@ mkImport :: Located CCallConv          -> Located Safety          -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)-         -> P ([AddEpAnn] -> HsDecl GhcPs)-mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =+         -> (EpToken "import", TokDcolon)+         -> P (EpToken "foreign" -> HsDecl GhcPs)+mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) (timport, td) =     case unLoc cconv of       CCallConv          -> returnSpec =<< mkCImport       CApiConv           -> do@@ -2799,8 +3057,8 @@         funcTarget = CFunction (StaticTarget esrc entity' Nothing True)         importSpec = CImport (L (l2l loc) esrc) (reLoc cconv) (reLoc safety) Nothing funcTarget -    returnSpec spec = return $ \ann -> ForD noExtField $ ForeignImport-          { fd_i_ext  = ann+    returnSpec spec = return $ \tforeign -> ForD noExtField $ ForeignImport+          { fd_i_ext  = (tforeign, timport, td)           , fd_name   = v           , fd_sig_ty = ty           , fd_fi     = spec@@ -2872,10 +3130,11 @@ -- mkExport :: Located CCallConv          -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)-         -> P ([AddEpAnn] -> HsDecl GhcPs)-mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty)- = return $ \ann -> ForD noExtField $-   ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty+         -> ( EpToken "export", TokDcolon)+         -> P (EpToken "foreign" -> HsDecl GhcPs)+mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty) (texport, td)+ = return $ \tforeign -> ForD noExtField $+   ForeignExport { fd_e_ext = (tforeign, texport, td), fd_name = v, fd_sig_ty = ty                  , fd_fe = CExport (L (l2l le) esrc) (L (l2l lc) (CExportStatic esrc entity' cconv)) }   where     entity' | nullFS entity = mkExtName (unLoc v)@@ -2894,26 +3153,26 @@ -- Help with module system imports/exports  data ImpExpSubSpec = ImpExpAbs-                   | ImpExpAll+                   | ImpExpAll (EpToken "..")                    | ImpExpList [LocatedA ImpExpQcSpec]                    | ImpExpAllWith [LocatedA ImpExpQcSpec]  data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)-                  | ImpExpQcType EpaLocation (LocatedN RdrName)-                  | ImpExpQcWildcard+                  | ImpExpQcType (EpToken "type") (LocatedN RdrName)+                  | ImpExpQcWildcard (EpToken "..") (EpToken ",") -mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> [AddEpAnn] -> LocatedA ImpExpQcSpec+mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec                -> ImpExpSubSpec -> P (IE GhcPs)-mkModuleImpExp warning anns (L l specname) subs = do+mkModuleImpExp warning (top, tcp) (L l specname) subs = do   case subs of     ImpExpAbs       | isVarNameSpace (rdrNameSpace name)                        -> return $ IEVar warning                            (L l (ieNameFromSpec specname)) Nothing-      | otherwise      -> IEThingAbs (warning, anns) . L l <$> nameT <*> pure noExportDoc-    ImpExpAll          -> IEThingAll (warning, anns) . L l <$> nameT <*> pure noExportDoc+      | otherwise      -> IEThingAbs warning . L l <$> nameT <*> pure noExportDoc+    ImpExpAll tok      -> IEThingAll (warning, (top, tok, tcp)) . L l <$> nameT <*> pure noExportDoc     ImpExpList xs      ->-      (\newName -> IEThingWith (warning, anns) (L l newName)+      (\newName -> IEThingWith (warning, (top,NoEpTok,NoEpTok,tcp)) (L l newName)         NoIEWildcard (wrapped xs)) <$> nameT <*> pure noExportDoc     ImpExpAllWith xs                       ->       do allowed <- getBit PatternSynonymsBit@@ -2922,10 +3181,13 @@             let withs = map unLoc xs                 pos   = maybe NoIEWildcard IEWildcard                           (findIndex isImpExpQcWildcard withs)+                (td,tc) = case find isImpExpQcWildcard withs of+                  Just (ImpExpQcWildcard td tc) -> (td,tc)+                  _ -> (NoEpTok, NoEpTok)                 ies :: [LocatedA (IEWrappedName GhcPs)]                 ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs             in (\newName-                        -> IEThingWith (warning, anns) (L l newName) pos ies)+                        -> IEThingWith (warning, (top,td,tc,tcp)) (L l newName) pos ies)                <$> nameT <*> pure noExportDoc           else addFatalError $ mkPlainErrorMsgEnvelope (locA l) $                  PsErrIllegalPatSynExport@@ -2942,12 +3204,12 @@      ieNameVal (ImpExpQcName ln)   = unLoc ln     ieNameVal (ImpExpQcType _ ln) = unLoc ln-    ieNameVal (ImpExpQcWildcard)  = panic "ieNameVal got wildcard"+    ieNameVal ImpExpQcWildcard{}  = panic "ieNameVal got wildcard"      ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs     ieNameFromSpec (ImpExpQcName   (L l n)) = IEName noExtField (L l n)     ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n)-    ieNameFromSpec (ImpExpQcWildcard)  = panic "ieName got wildcard"+    ieNameFromSpec ImpExpQcWildcard{}       = panic "ieName got wildcard"      wrapped = map (fmap ieNameFromSpec) @@ -2957,7 +3219,7 @@   do requireExplicitNamespaces (getLocA name)      return (fmap (`setRdrNameSpace` tcClsName) name) -checkImportSpec :: LocatedL [LIE GhcPs] -> P (LocatedL [LIE GhcPs])+checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs]) checkImportSpec ie@(L _ specs) =     case [l | (L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of       [] -> return ie@@ -2967,18 +3229,18 @@       addFatalError $ mkPlainErrorMsgEnvelope l PsErrIllegalImportBundleForm  -- In the correct order-mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec)-mkImpExpSubSpec [] = return ([], ImpExpList [])-mkImpExpSubSpec [L la ImpExpQcWildcard] =-  return ([AddEpAnn AnnDotdot (entry la)], ImpExpAll)+mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ImpExpSubSpec+mkImpExpSubSpec [] = return (ImpExpList [])+mkImpExpSubSpec [L _ (ImpExpQcWildcard td _tc)] =+  return (ImpExpAll td) mkImpExpSubSpec xs =   if (any (isImpExpQcWildcard . unLoc) xs)-    then return $ ([], ImpExpAllWith xs)-    else return $ ([], ImpExpList xs)+    then return $ (ImpExpAllWith xs)+    else return $ (ImpExpList xs)  isImpExpQcWildcard :: ImpExpQcSpec -> Bool-isImpExpQcWildcard ImpExpQcWildcard = True-isImpExpQcWildcard _                = False+isImpExpQcWildcard (ImpExpQcWildcard _ _) = True+isImpExpQcWildcard _                      = False  ----------------------------------------------------------------------------- -- Warnings and failures@@ -3100,10 +3362,7 @@       PV_Ok acc{pv_warnings= w `addMessage` pv_warnings acc} ()   addFatalError err =     addError err >> PV (const PV_Failed)-  getBit ext =-    PV $ \ctx acc ->-      let b = ext `xtest` pExtsBitmap (pv_options ctx) in-      PV_Ok acc $! b+  getParserOpts = PV $ \ctx acc -> PV_Ok acc $! pv_options ctx   allocateCommentsP ss = PV $ \_ s ->     if null (pv_comment_q s) then PV_Ok s emptyComments else  -- fast path     let (comment_q', newAnns) = allocateComments ss (pv_comment_q s) in@@ -3176,7 +3435,7 @@       addError $ mkPlainErrorMsgEnvelope span $ PsErrIllegalBangPattern e  mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)-                 -> [AddEpAnn]+                 -> (EpaLocation, EpaLocation)                  -> PV (LHsExpr GhcPs)  -- Tuple@@ -3191,18 +3450,15 @@ -- Sum -- mkSumOrTupleExpr l Unboxed (Sum alt arity e) = --     return $ L l (ExplicitSum noExtField alt arity e)-mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) anns = do-    let an = case anns of-               [AddEpAnn AnnOpenPH o, AddEpAnn AnnClosePH c] ->-                 AnnExplicitSum o barsp barsa c-               _ -> panic "mkSumOrTupleExpr"+mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) (o, c) = do+    let an = AnnExplicitSum o barsp barsa c     !cs <- getCommentsFor (locA l)     return $ L (EpAnn anc anIn (csIn Semi.<> cs)) (ExplicitSum an alt arity e) mkSumOrTupleExpr l Boxed a@Sum{} _ =     addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrUnsupportedBoxedSumExpr a  mkSumOrTuplePat-  :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> [AddEpAnn]+  :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> (EpaLocation, EpaLocation)   -> PV (LocatedA (PatBuilder GhcPs))  -- Tuple@@ -3232,7 +3488,7 @@   let loc = locA x `combineSrcSpans` locA op `combineSrcSpans` locA y   in L (noAnnSrcSpan loc) (mkHsOpTy prom x op y) -mkMultTy :: EpToken "%" -> LHsType GhcPs -> EpUniToken "->" "→" -> HsArrow GhcPs+mkMultTy :: EpToken "%" -> LHsType GhcPs -> TokRarrow -> HsArrow GhcPs mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1))) arr   -- See #18888 for the use of (SourceText "1") above   = HsLinearArrow (EpPct1 pct1 arr)@@ -3242,6 +3498,16 @@     pct1 = epTokenWidenR pct (locA (getLoc t)) mkMultTy pct t arr = HsExplicitMult (pct, arr) t +mkMultExpr :: EpToken "%" -> LHsExpr GhcPs -> TokRarrow -> HsArrowOf (LHsExpr GhcPs) GhcPs+mkMultExpr pct t@(L _ (HsOverLit _ (OverLit _ (HsIntegral (IL (SourceText (unpackFS -> "1")) _ 1))))) arr+  -- See #18888 for the use of (SourceText "1") above+  = HsLinearArrow (EpPct1 pct1 arr)+  where+    -- The location of "%" combined with the location of "1".+    pct1 :: EpToken "%1"+    pct1 = epTokenWidenR pct (locA (getLoc t))+mkMultExpr pct t arr = HsExplicitMult (pct, arr) t+ mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs mkMultAnn pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1)))   -- See #18888 for the use of (SourceText "1") above@@ -3261,7 +3527,7 @@ epTokenWidenR NoEpTok _ = NoEpTok epTokenWidenR (EpTok l) (UnhelpfulSpan _) = EpTok l epTokenWidenR (EpTok (EpaSpan s1)) s2 = EpTok (EpaSpan (combineSrcSpans s1 s2))-epTokenWidenR (EpTok (EpaDelta _ _)) _ =+epTokenWidenR (EpTok EpaDelta{}) _ =   -- Never happens because the parser does not produce EpaDelta.   panic "epTokenWidenR: EpaDelta" @@ -3288,11 +3554,11 @@ mkRdrProjection flds anns =   HsProjection {       proj_ext = anns-    , proj_flds = flds+    , proj_flds = fmap unLoc flds     }  mkRdrProjUpdate :: SrcSpanAnnA -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]-                -> LHsExpr GhcPs -> Bool -> [AddEpAnn]+                -> LHsExpr GhcPs -> Bool -> Maybe (EpToken "=")                 -> LHsRecProj GhcPs (LHsExpr GhcPs) mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!" mkRdrProjUpdate loc (L l flds) arg isPun anns =@@ -3346,9 +3612,9 @@ -- type or data constructor, based on the extension @ListTuplePuns@. -- The case with an explicit promotion quote, @'(Int, Double)@, is handled -- by 'mkExplicitTupleTy'.-mkTupleSyntaxTy :: EpaLocation+mkTupleSyntaxTy :: EpToken "("                 -> [LocatedA (HsType GhcPs)]-                -> EpaLocation+                -> EpToken ")"                 -> P (HsType GhcPs) mkTupleSyntaxTy parOpen args parClose =   punsIfElse enabled disabled@@ -3356,10 +3622,10 @@     enabled =       HsTupleTy annParen HsBoxedOrConstraintTuple args     disabled =-      HsExplicitTupleTy annsKeyword args+      HsExplicitTupleTy annsKeyword NotPromoted args -    annParen = AnnParen AnnParens parOpen parClose-    annsKeyword = [AddEpAnn AnnOpenP parOpen, AddEpAnn AnnCloseP parClose]+    annParen = AnnParens parOpen parClose+    annsKeyword = (NoEpTok, parOpen, parClose)  -- | Decide whether to parse tuple con syntax @(,)@ in a type as a -- type or data constructor, based on the extension @ListTuplePuns@.@@ -3375,8 +3641,8 @@ -- constructor, based on the extension @ListTuplePuns@. -- The case with an explicit promotion quote, @'[]@, is handled by -- 'mkExplicitListTy'.-mkListSyntaxTy0 :: EpaLocation-                -> EpaLocation+mkListSyntaxTy0 :: EpToken "["+                -> EpToken "]"                 -> SrcSpan                 -> P (HsType GhcPs) mkListSyntaxTy0 brkOpen brkClose span =@@ -3390,17 +3656,17 @@     disabled =       HsExplicitListTy annsKeyword NotPromoted [] -    rdrNameAnn = NameAnnOnly NameSquare brkOpen brkClose []-    annsKeyword = [AddEpAnn AnnOpenS brkOpen, AddEpAnn AnnCloseS brkClose]+    rdrNameAnn = NameAnnOnly (NameSquare brkOpen brkClose) []+    annsKeyword = (NoEpTok, brkOpen, brkClose)     fullLoc = EpaSpan span  -- | Decide whether to parse list type syntax @[Int]@ in a type as a -- type or data constructor, based on the extension @ListTuplePuns@. -- The case with an explicit promotion quote, @'[Int]@, is handled -- by 'mkExplicitListTy'.-mkListSyntaxTy1 :: EpaLocation+mkListSyntaxTy1 :: EpToken "["                 -> LocatedA (HsType GhcPs)-                -> EpaLocation+                -> EpToken "]"                 -> P (HsType GhcPs) mkListSyntaxTy1 brkOpen t brkClose =   punsIfElse enabled disabled@@ -3410,5 +3676,5 @@     disabled =       HsExplicitListTy annsKeyword NotPromoted [t] -    annsKeyword = [AddEpAnn AnnOpenS brkOpen, AddEpAnn AnnCloseS brkClose]-    annParen = AnnParen AnnParensSquare brkOpen brkClose+    annsKeyword = (NoEpTok, brkOpen, brkClose)+    annParen = AnnParensSquare brkOpen brkClose
compiler/GHC/Parser/PostProcess/Haddock.hs view
@@ -53,7 +53,6 @@ import GHC.Hs  import GHC.Types.SrcLoc-import GHC.Data.Bag  import Data.Semigroup import Data.Foldable@@ -305,7 +304,7 @@ --    import I (a, b, c)         -- do not use here! -- -- Imports cannot have documentation comments anyway.-instance HasHaddock (LocatedL [LocatedA (IE GhcPs)]) where+instance HasHaddock (LocatedLI [LocatedA (IE GhcPs)]) where   addHaddock (L l_exports exports) =     extendHdkA (locA l_exports) $ do       exports' <- addHaddockInterleaveItems EpNoLayout mkDocIE exports@@ -1461,7 +1460,7 @@  mkLHsDocTy :: LHsType GhcPs -> Maybe (Located HsDocString) -> LHsType GhcPs mkLHsDocTy t Nothing = t-mkLHsDocTy t (Just doc) = L (getLoc t) (HsDocTy noAnn t $ lexLHsDocString doc)+mkLHsDocTy t (Just doc) = L (getLoc t) (HsDocTy noExtField t $ lexLHsDocString doc)  getForAllTeleLoc :: HsForAllTelescope GhcPs -> SrcSpan getForAllTeleLoc tele =@@ -1488,7 +1487,7 @@   -- - 'LHsDecl' produced by 'decl_cls' in Parser.y always have a 'BufSpan'   -- - 'partitionBindsAndSigs' does not discard this 'BufSpan'   mergeListsBy cmpBufSpanA [-    mapLL (\b -> ValD noExtField b) (bagToList all_bs),+    mapLL (\b -> ValD noExtField b) all_bs,     mapLL (\s -> SigD noExtField s) all_ss,     mapLL (\t -> TyClD noExtField (FamDecl noExtField t)) all_ts,     mapLL (\tfi -> InstD noExtField (TyFamInstD noExtField tfi)) all_tfis,
+ compiler/GHC/Parser/String.hs view
@@ -0,0 +1,407 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++module GHC.Parser.String (+  StringLexError (..),+  lexString,+  lexMultilineString,++  -- * Unicode smart quote helpers+  isDoubleSmartQuote,+  isSingleSmartQuote,+) where++import GHC.Prelude hiding (getChar)++import Control.Arrow ((>>>))+import Control.Monad (when)+import Data.Char (chr, ord)+import qualified Data.Foldable1 as Foldable1+import qualified Data.List.NonEmpty as NonEmpty+import Data.Maybe (listToMaybe, mapMaybe)+import GHC.Data.StringBuffer (StringBuffer)+import qualified GHC.Data.StringBuffer as StringBuffer+import GHC.Parser.CharClass (+  hexDigit,+  is_decdigit,+  is_hexdigit,+  is_octdigit,+  is_space,+  octDecDigit,+ )+import GHC.Parser.Errors.Types (LexErr (..))+import GHC.Utils.Panic (panic)++type BufPos = Int+data StringLexError = StringLexError LexErr BufPos++lexString :: Int -> StringBuffer -> Either StringLexError String+lexString = lexStringWith processChars processChars+  where+    processChars :: HasChar c => [c] -> Either (c, LexErr) [c]+    processChars =+          collapseGaps+      >>> resolveEscapes++-- -----------------------------------------------------------------------------+-- Lexing interface++{-+Note [Lexing strings]+~~~~~~~~~~~~~~~~~~~~~++After verifying if a string is lexically valid with Alex, we still need to do+some post processing of the string, namely:+1. Collapse string gaps+2. Resolve escape characters++The problem: 'lexemeToString' is more performant than manually reading+characters from the StringBuffer. However, that completely erases the position+of each character, which we need in order to report the correct position for+error messages (e.g. when resolving escape characters).++So what we'll do is do two passes. The first pass is optimistic; just convert+to a plain String and process it. If this results in an error, we do a second+pass, this time where each character is annotated with its position. Now, the+error has all the information it needs.++Ideally, lexStringWith would take a single (forall c. HasChar c => ...) function,+but to help the specializer, we pass it in twice to concretize it for the two+types we actually use.+-}++-- | See Note [Lexing strings]+lexStringWith ::+  ([Char] -> Either (Char, LexErr) [Char])+  -> ([CharPos] -> Either (CharPos, LexErr) [CharPos])+  -> Int+  -> StringBuffer+  -> Either StringLexError String+lexStringWith processChars processCharsPos len buf =+  case processChars $ bufferChars buf len of+    Right s -> Right s+    Left _ ->+      case processCharsPos $ bufferLocatedChars buf len of+        Right _ -> panic "expected lex error on second pass"+        Left ((_, pos), e) -> Left $ StringLexError e pos++class HasChar c where+  getChar :: c -> Char+  setChar :: Char -> c -> c++instance HasChar Char where+  getChar = id+  setChar = const++instance HasChar (Char, x) where+  getChar = fst+  setChar c (_, x) = (c, x)++pattern Char :: HasChar c => Char -> c+pattern Char c <- (getChar -> c)+{-# COMPLETE Char #-}++bufferChars :: StringBuffer -> Int -> [Char]+bufferChars = StringBuffer.lexemeToString++type CharPos = (Char, BufPos)++bufferLocatedChars :: StringBuffer -> Int -> [CharPos]+bufferLocatedChars initialBuf len = go initialBuf+  where+    go buf+      | atEnd buf = []+      | otherwise  =+          let (c, buf') = StringBuffer.nextChar buf+           in (c, StringBuffer.cur buf) : go buf'++    atEnd buf = StringBuffer.byteDiff initialBuf buf >= len++-- -----------------------------------------------------------------------------+-- Lexing phases++collapseGaps :: HasChar c => [c] -> [c]+collapseGaps = go+  where+    go = \case+      c1@(Char '\\') : c2@(Char c) : cs+        | is_space c -> go $ dropGap cs+        | otherwise  -> c1 : c2 : go cs+      c : cs -> c : go cs+      [] -> []++    dropGap = \case+      Char '\\' : cs -> cs+      _ : cs -> dropGap cs+      [] -> panic "gap unexpectedly ended"++resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c]+resolveEscapes = go dlistEmpty+  where+    go !acc = \case+      [] -> pure $ dlistToList acc+      Char '\\' : Char '&' : cs -> go acc cs+      backslash@(Char '\\') : cs ->+        case resolveEscapeChar cs of+          Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs'+          Left (c, e) -> Left (c, e)+      c : cs -> go (acc `dlistSnoc` c) cs++-- -----------------------------------------------------------------------------+-- Escape characters++-- | Resolve a escape character, after having just lexed a backslash.+-- Assumes escape character is valid.+resolveEscapeChar :: HasChar c => [c] -> Either (c, LexErr) (Char, [c])+resolveEscapeChar = \case+  Char 'a'  : cs -> pure ('\a', cs)+  Char 'b'  : cs -> pure ('\b', cs)+  Char 'f'  : cs -> pure ('\f', cs)+  Char 'n'  : cs -> pure ('\n', cs)+  Char 'r'  : cs -> pure ('\r', cs)+  Char 't'  : cs -> pure ('\t', cs)+  Char 'v'  : cs -> pure ('\v', cs)+  Char '\\' : cs -> pure ('\\', cs)+  Char '"'  : cs -> pure ('\"', cs)+  Char '\'' : cs -> pure ('\'', cs)+  -- escape codes+  Char 'x' : cs -> parseNum is_hexdigit 16 hexDigit cs+  Char 'o' : cs -> parseNum is_octdigit 8 octDecDigit cs+  cs@(Char c : _) | is_decdigit c -> parseNum is_decdigit 10 octDecDigit cs+  -- control characters (e.g. '\^M')+  Char '^' : Char c : cs -> pure (chr $ ord c - ord '@', cs)+  -- long form escapes (e.g. '\NUL')+  cs | Just (esc, cs') <- parseLongEscape cs -> pure (esc, cs')+  -- shouldn't happen+  Char c : _ -> panic $ "found unexpected escape character: " ++ show c+  [] -> panic "escape character unexpectedly ended"+  where+    parseNum isDigit base toDigit =+      let go x = \case+            ch@(Char c) : cs | isDigit c -> do+              let x' = x * base + toDigit c+              when (x' > 0x10ffff) $ Left (ch, LexNumEscapeRange)+              go x' cs+            cs -> pure (chr x, cs)+       in go 0++parseLongEscape :: HasChar c => [c] -> Maybe (Char, [c])+parseLongEscape cs = listToMaybe (mapMaybe tryParse longEscapeCodes)+  where+    tryParse (code, esc) =+      case splitAt (length code) cs of+        (pre, cs') | map getChar pre == code -> Just (esc, cs')+        _ -> Nothing++    longEscapeCodes =+      [ ("NUL", '\NUL')+      , ("SOH", '\SOH')+      , ("STX", '\STX')+      , ("ETX", '\ETX')+      , ("EOT", '\EOT')+      , ("ENQ", '\ENQ')+      , ("ACK", '\ACK')+      , ("BEL", '\BEL')+      , ("BS" , '\BS' )+      , ("HT" , '\HT' )+      , ("LF" , '\LF' )+      , ("VT" , '\VT' )+      , ("FF" , '\FF' )+      , ("CR" , '\CR' )+      , ("SO" , '\SO' )+      , ("SI" , '\SI' )+      , ("DLE", '\DLE')+      , ("DC1", '\DC1')+      , ("DC2", '\DC2')+      , ("DC3", '\DC3')+      , ("DC4", '\DC4')+      , ("NAK", '\NAK')+      , ("SYN", '\SYN')+      , ("ETB", '\ETB')+      , ("CAN", '\CAN')+      , ("EM" , '\EM' )+      , ("SUB", '\SUB')+      , ("ESC", '\ESC')+      , ("FS" , '\FS' )+      , ("GS" , '\GS' )+      , ("RS" , '\RS' )+      , ("US" , '\US' )+      , ("SP" , '\SP' )+      , ("DEL", '\DEL')+      ]++-- -----------------------------------------------------------------------------+-- Unicode Smart Quote detection (#21843)++isDoubleSmartQuote :: Char -> Bool+isDoubleSmartQuote = \case+  '“' -> True+  '”' -> True+  _ -> False++isSingleSmartQuote :: Char -> Bool+isSingleSmartQuote = \case+  '‘' -> True+  '’' -> True+  _ -> False++-- -----------------------------------------------------------------------------+-- Multiline strings++-- | See Note [Multiline string literals]+--+-- Assumes string is lexically valid. Skips the steps about splitting+-- and rejoining lines, and instead manually find newline characters,+-- for performance.+lexMultilineString :: Int -> StringBuffer -> Either StringLexError String+lexMultilineString = lexStringWith processChars processChars+  where+    processChars :: HasChar c => [c] -> Either (c, LexErr) [c]+    processChars =+          collapseGaps             -- Step 1+      >>> normalizeEOL+      >>> expandLeadingTabs        -- Step 3+      >>> rmCommonWhitespacePrefix -- Step 4+      >>> collapseOnlyWsLines      -- Step 5+      >>> rmFirstNewline           -- Step 7a+      >>> rmLastNewline            -- Step 7b+      >>> resolveEscapes           -- Step 8++    -- Normalize line endings to LF. The spec dictates that lines should be+    -- split on newline characters and rejoined with ``\n``. But because we+    -- aren't actually splitting/rejoining, we'll manually normalize here+    normalizeEOL :: HasChar c => [c] -> [c]+    normalizeEOL =+      let go = \case+            Char '\r' : c@(Char '\n') : cs -> c : go cs+            c@(Char '\r') : cs -> setChar '\n' c : go cs+            c@(Char '\f') : cs -> setChar '\n' c : go cs+            c : cs -> c : go cs+            [] -> []+       in go++    -- expands all tabs, since the lexer will verify that tabs can only appear+    -- as leading indentation+    expandLeadingTabs :: HasChar c => [c] -> [c]+    expandLeadingTabs =+      let go !col = \case+            c@(Char '\t') : cs ->+              let fill = 8 - (col `mod` 8)+               in replicate fill (setChar ' ' c) ++ go (col + fill) cs+            c : cs -> c : go (if getChar c == '\n' then 0 else col + 1) cs+            [] -> []+       in go 0++    rmCommonWhitespacePrefix :: HasChar c => [c] -> [c]+    rmCommonWhitespacePrefix cs0 =+      let commonWSPrefix = getCommonWsPrefix (map getChar cs0)+          go = \case+            c@(Char '\n') : cs -> c : go (dropLine commonWSPrefix cs)+            c : cs -> c : go cs+            [] -> []+          -- drop x characters from the string, or up to a newline, whichever+          -- comes first+          dropLine !x = \case+            cs | x <= 0 -> cs+            cs@(Char '\n' : _) -> cs+            _ : cs -> dropLine (x - 1) cs+            [] -> []+       in go cs0++    collapseOnlyWsLines :: HasChar c => [c] -> [c]+    collapseOnlyWsLines =+      let go = \case+            c@(Char '\n') : cs | Just cs' <- checkAllWs cs -> c : go cs'+            c : cs -> c : go cs+            [] -> []+          checkAllWs = \case+            -- got all the way to a newline or the end of the string, return+            cs@(Char '\n' : _) -> Just cs+            cs@[] -> Just cs+            -- found whitespace, continue+            Char c : cs | is_space c -> checkAllWs cs+            -- anything else, stop+            _ -> Nothing+       in go++    rmFirstNewline :: HasChar c => [c] -> [c]+    rmFirstNewline = \case+      Char '\n' : cs -> cs+      cs -> cs++    rmLastNewline :: HasChar c => [c] -> [c]+    rmLastNewline =+      let go = \case+            [] -> []+            [Char '\n'] -> []+            c : cs -> c : go cs+       in go++-- | See step 4 in Note [Multiline string literals]+--+-- Assumes tabs have already been expanded.+getCommonWsPrefix :: String -> Int+getCommonWsPrefix s =+  case NonEmpty.nonEmpty includedLines of+    Nothing -> 0+    Just ls -> Foldable1.minimum $ NonEmpty.map (length . takeWhile is_space) ls+  where+    includedLines =+        filter (not . all is_space) -- ignore whitespace-only lines+      . drop 1                      -- ignore first line in calculation+      $ lines s++{-+Note [Multiline string literals]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Multiline string literals were added following the acceptance of the+proposal: https://github.com/ghc-proposals/ghc-proposals/pull/569++Multiline string literals are syntax sugar for normal string literals,+with an extra post processing step. This all happens in the Lexer; that+is, HsMultilineString will contain the post-processed string. This matches+the same behavior as HsString, which contains the normalized string+(see Note [Literal source text]).++The canonical steps for post processing a multiline string are:+1. Collapse string gaps+2. Split the string by newlines+3. Convert leading tabs into spaces+    * In each line, any tabs preceding non-whitespace characters are replaced with spaces up to the next tab stop+4. Remove common whitespace prefix in every line except the first (see below)+5. If a line contains only whitespace, remove all of the whitespace+6. Join the string back with `\n` delimiters+7a. If the first character of the string is a newline, remove it+7b. If the last character of the string is a newline, remove it+8. Interpret escaped characters++The common whitespace prefix can be informally defined as "The longest+prefix of whitespace shared by all lines in the string, excluding the+first line and any whitespace-only lines".++It's more precisely defined with the following algorithm:++1. Take a list representing the lines in the string+2. Ignore the following elements in the list:+    * The first line (we want to ignore everything before the first newline)+    * Empty lines+    * Lines with only whitespace characters+3. Calculate the longest prefix of whitespace shared by all lines in the remaining list+-}++-- -----------------------------------------------------------------------------+-- DList++newtype DList a = DList ([a] -> [a])++dlistEmpty :: DList a+dlistEmpty = DList id++dlistToList :: DList a -> [a]+dlistToList (DList f) = f []++dlistSnoc :: DList a -> a -> DList a+dlistSnoc (DList f) x = DList (f . (x :))
compiler/GHC/Parser/Types.hs view
@@ -27,7 +27,7 @@ import Language.Haskell.Syntax  data SumOrTuple b-  = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]+  = Sum ConTag Arity (LocatedA b) [EpToken "|"] [EpToken "|"]   -- ^ Last two are the locations of the '|' before and after the payload   | Tuple [Either (EpAnn Bool) (LocatedA b)] @@ -57,13 +57,13 @@   | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))   | PatBuilderAppType (LocatedA (PatBuilder p)) (EpToken "@") (HsTyPat GhcPs)   | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)-                    (LocatedA (PatBuilder p)) [AddEpAnn]+                    (LocatedA (PatBuilder p)) ([EpToken "("], [EpToken ")"])   | PatBuilderVar (LocatedN RdrName)   | PatBuilderOverLit (HsOverLit GhcPs)  -- These instances are here so that they are not orphans type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs)))             = EpAnnCO-type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL+type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW type instance Anno (Match GhcPs (LocatedA (PatBuilder GhcPs)))            = SrcSpanAnnA type instance Anno (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))     = SrcSpanAnnA @@ -110,4 +110,4 @@   ppr (InfixDataConBuilder lhs data_con rhs) =     ppr lhs <+> ppr data_con <+> ppr rhs -type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL+type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW
compiler/GHC/Platform.hs view
@@ -17,6 +17,7 @@    , ByteOrder(..)    , target32Bit    , isARM+   , isPPC    , osElfTarget    , osMachOTarget    , osSubsectionsViaSymbols@@ -74,6 +75,9 @@    , platformHasGnuNonexecStack       :: !Bool    , platformHasIdentDirective        :: !Bool    , platformHasSubsectionsViaSymbols :: !Bool+      -- ^ Enable Darwin .subsections_via_symbols directive+      --+      -- See Note [Subsections Via Symbols] in GHC.CmmToAsm.X86.Ppr    , platformIsCrossCompiling         :: !Bool    , platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix    , platformTablesNextToCode         :: !Bool@@ -250,10 +254,8 @@   ArchPPC_64 ELF_V1 -> False -- powerpc64   ArchPPC_64 ELF_V2 -> False -- powerpc64le   ArchS390X         -> False-  ArchRISCV64       -> False   ArchLoongArch64   -> False   ArchJavaScript    -> False-  ArchWasm32        -> False   _                 -> True  @@ -287,6 +289,7 @@   , platformMisc_ghcWithInterpreter   :: Bool   , platformMisc_libFFI               :: Bool   , platformMisc_llvmTarget           :: String+  , platformMisc_targetRTSLinkerOnlySupportsSharedLibs :: Bool   }  platformSOName :: Platform -> FilePath -> FilePath
compiler/GHC/Platform/Reg.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MagicHash #-}+ -- | An architecture independent description of a register. --      This needs to stay architecture independent because it is used --      by NCGMonad and the register allocators, which are shared@@ -27,12 +29,17 @@ where  import GHC.Prelude+import GHC.Exts ( Int(I#), dataToTag# )  import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Unique import GHC.Builtin.Uniques import GHC.Platform.Reg.Class+import qualified GHC.Platform.Reg.Class.Unified   as Unified+import qualified GHC.Platform.Reg.Class.Separate  as Separate+import qualified GHC.Platform.Reg.Class.NoVectors as NoVectors+import GHC.Platform.ArchOS  -- | An identifier for a primitive real machine register. type RegNo@@ -53,72 +60,68 @@ --      Virtual regs can be of either class, so that info is attached. -- data VirtualReg-        = VirtualRegI  {-# UNPACK #-} !Unique-        | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register-        | VirtualRegF  {-# UNPACK #-} !Unique-        | VirtualRegD  {-# UNPACK #-} !Unique--        deriving (Eq, Show)+   -- | Integer virtual register+   = VirtualRegI    { virtualRegUnique :: {-# UNPACK #-} !Unique }+   -- | High part of 2-word virtual register+   | VirtualRegHi   { virtualRegUnique :: {-# UNPACK #-} !Unique }+   -- | Double virtual register+   | VirtualRegD    { virtualRegUnique :: {-# UNPACK #-} !Unique }+   -- | 128-bit wide vector virtual register+   | VirtualRegV128 { virtualRegUnique :: {-# UNPACK #-} !Unique }+   deriving (Eq, Show) --- This is laborious, but necessary. We can't derive Ord because--- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the--- implementation. See Note [No Ord for Unique]+-- We can't derive Ord, because Unique doesn't have an Ord instance.+-- Note nonDetCmpUnique in the implementation. See Note [No Ord for Unique]. -- This is non-deterministic but we do not currently support deterministic -- code-generation. See Note [Unique Determinism and code generation] instance Ord VirtualReg where-  compare (VirtualRegI a) (VirtualRegI b) = nonDetCmpUnique a b-  compare (VirtualRegHi a) (VirtualRegHi b) = nonDetCmpUnique a b-  compare (VirtualRegF a) (VirtualRegF b) = nonDetCmpUnique a b-  compare (VirtualRegD a) (VirtualRegD b) = nonDetCmpUnique a b--  compare VirtualRegI{} _ = LT-  compare _ VirtualRegI{} = GT-  compare VirtualRegHi{} _ = LT-  compare _ VirtualRegHi{} = GT-  compare VirtualRegF{} _ = LT-  compare _ VirtualRegF{} = GT--+  compare vr1 vr2 =+    case compare (I# (dataToTag# vr1)) (I# (dataToTag# vr2)) of+      LT -> LT+      GT -> GT+      EQ -> nonDetCmpUnique (virtualRegUnique vr1) (virtualRegUnique vr2)  instance Uniquable VirtualReg where-        getUnique reg-         = case reg of-                VirtualRegI u   -> u-                VirtualRegHi u  -> u-                VirtualRegF u   -> u-                VirtualRegD u   -> u+        getUnique = virtualRegUnique  instance Outputable VirtualReg where         ppr reg          = case reg of-                VirtualRegI  u  -> text "%vI_"   <> pprUniqueAlways u-                VirtualRegHi u  -> text "%vHi_"  <> pprUniqueAlways u-                -- this code is kinda wrong on x86-                -- because float and double occupy the same register set-                -- namely SSE2 register xmm0 .. xmm15-                VirtualRegF  u  -> text "%vFloat_"   <> pprUniqueAlways u-                VirtualRegD  u  -> text "%vDouble_"   <> pprUniqueAlways u-+                VirtualRegI    u -> text "%vI_"   <> pprUniqueAlways u+                VirtualRegHi   u -> text "%vHi_"  <> pprUniqueAlways u+                VirtualRegD    u -> text "%vDouble_" <> pprUniqueAlways u+                VirtualRegV128 u -> text "%vV128_"   <> pprUniqueAlways u   renameVirtualReg :: Unique -> VirtualReg -> VirtualReg-renameVirtualReg u r- = case r of-        VirtualRegI _   -> VirtualRegI  u-        VirtualRegHi _  -> VirtualRegHi u-        VirtualRegF _   -> VirtualRegF  u-        VirtualRegD _   -> VirtualRegD  u---classOfVirtualReg :: VirtualReg -> RegClass-classOfVirtualReg vr- = case vr of-        VirtualRegI{}   -> RcInteger-        VirtualRegHi{}  -> RcInteger-        VirtualRegF{}   -> RcFloat-        VirtualRegD{}   -> RcDouble-+renameVirtualReg u r = r { virtualRegUnique = u } +classOfVirtualReg :: Arch -> VirtualReg -> RegClass+classOfVirtualReg arch vr+  = case vr of+        VirtualRegI{} ->+          case regArch of+            Unified   ->   Unified.RcInteger+            Separate  ->  Separate.RcInteger+            NoVectors -> NoVectors.RcInteger+        VirtualRegHi{} ->+          case regArch of+            Unified   ->   Unified.RcInteger+            Separate  ->  Separate.RcInteger+            NoVectors -> NoVectors.RcInteger+        VirtualRegD{} ->+          case regArch of+            Unified   ->   Unified.RcFloatOrVector+            Separate  ->  Separate.RcFloat+            NoVectors -> NoVectors.RcFloat+        VirtualRegV128{} ->+          case regArch of+            Unified   ->  Unified.RcFloatOrVector+            Separate  -> Separate.RcVector+            NoVectors -> pprPanic "classOfVirtualReg VirtualRegV128"+                           ( text "arch:" <+> text ( show arch ) )+  where+    regArch = registerArch arch  -- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform -- when supplied with the vreg for the lower-half of the quantity.
compiler/GHC/Platform/Reg/Class.hs view
@@ -1,33 +1,56 @@--- | An architecture independent description of a register's class.+{-# LANGUAGE LambdaCase #-} module GHC.Platform.Reg.Class-        ( RegClass (..) )-+  ( RegClass (..), RegArch(..), registerArch ) where  import GHC.Prelude -import GHC.Utils.Outputable as Outputable import GHC.Types.Unique-import GHC.Builtin.Uniques+import GHC.Builtin.Uniques ( mkRegClassUnique )+import GHC.Platform.ArchOS+import GHC.Utils.Outputable ( Outputable(ppr), text )   -- | The class of a register. --      Used in the register allocator. --      We treat all registers in a class as being interchangeable. ---data RegClass-        = RcInteger-        | RcFloat-        | RcDouble-        deriving Eq-+newtype RegClass = RegClass Int+  deriving ( Eq, Ord, Show )  instance Uniquable RegClass where-    getUnique RcInteger = mkRegClassUnique 0-    getUnique RcFloat   = mkRegClassUnique 1-    getUnique RcDouble  = mkRegClassUnique 2+  getUnique ( RegClass i ) = mkRegClassUnique i +-- | This instance is just used for the graph colouring register allocator.+-- Prefer using either 'GHC.Platform.Reg.Class.Separate.pprRegClass'+-- or 'GHC.Platform.Reg.Class.Unified.pprRegClass', which is more informative. instance Outputable RegClass where-    ppr RcInteger       = Outputable.text "I"-    ppr RcFloat         = Outputable.text "F"-    ppr RcDouble        = Outputable.text "D"+  ppr (RegClass i) = ppr i++-- | The register architecture of a given machine.+data RegArch+  -- | Floating-point and vector registers are unified (e.g. X86, AArch64).+  = Unified+  -- | Floating-point and vector registers are separate (e.g. RISC-V).+  | Separate+  -- | No vector registers.+  | NoVectors+  deriving ( Eq, Ord, Show )++instance Outputable RegArch where+  ppr regArch = text (show regArch)++-- | What is the register architecture of the given architecture?+registerArch :: Arch -> RegArch+registerArch arch =+  case arch of+    ArchX86       -> Unified+    ArchX86_64    -> Unified+    ArchPPC       -> Unified+    ArchPPC_64 {} -> Unified+    ArchAArch64   -> Unified+    -- Support for vector registers not yet implemented for RISC-V+    -- see panic in `getFreeRegs`.+    --ArchRISCV64   -> Separate+    ArchRISCV64   -> NoVectors+    _             -> NoVectors
+ compiler/GHC/Platform/Reg/Class/NoVectors.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}++-- | Register classes for architectures which don't have any vector registers.+module GHC.Platform.Reg.Class.NoVectors+  ( RegClass ( RcInteger, RcFloat )+  , pprRegClass, allRegClasses+  )++where++import GHC.Utils.Outputable ( SDoc, text )+import GHC.Platform.Reg.Class ( RegClass(..) )++pattern RcInteger, RcFloat :: RegClass+pattern RcInteger = RegClass 0+pattern RcFloat   = RegClass 1+{-# COMPLETE RcInteger, RcFloat #-}++pprRegClass :: RegClass -> SDoc+pprRegClass = \case+  RcInteger -> text "I"+  RcFloat   -> text "F"++allRegClasses :: [RegClass]+allRegClasses = [RcInteger, RcFloat]
+ compiler/GHC/Platform/Reg/Class/Separate.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}++-- | Register classes for architectures which have registers+-- for scalar floating-point values that are separate from all vector registers.+module GHC.Platform.Reg.Class.Separate+  ( RegClass ( RcInteger, RcFloat, RcVector )+  , pprRegClass, allRegClasses+  )++where++import GHC.Utils.Outputable ( SDoc, text )+import GHC.Platform.Reg.Class ( RegClass(..) )++pattern RcInteger, RcFloat, RcVector :: RegClass+pattern RcInteger = RegClass 0+pattern RcFloat   = RegClass 1+pattern RcVector  = RegClass 2+{-# COMPLETE RcInteger, RcFloat, RcVector #-}++pprRegClass :: RegClass -> SDoc+pprRegClass = \case+  RcInteger -> text "I"+  RcFloat   -> text "F"+  RcVector  -> text "V"++allRegClasses :: [RegClass]+allRegClasses = [RcInteger, RcFloat, RcVector]
+ compiler/GHC/Platform/Reg/Class/Unified.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}++-- | Register classes for architectures which don't have separate registers+-- for scalar floating-point values separate from vector registers.+module GHC.Platform.Reg.Class.Unified+  ( RegClass ( RcInteger, RcFloatOrVector )+  , pprRegClass, allRegClasses+  )++where++import GHC.Utils.Outputable ( SDoc, text )+import GHC.Platform.Reg.Class ( RegClass(..) )++pattern RcInteger, RcFloatOrVector :: RegClass+pattern RcInteger       = RegClass 0+pattern RcFloatOrVector = RegClass 1+{-# COMPLETE RcInteger, RcFloatOrVector #-}++pprRegClass :: RegClass -> SDoc+pprRegClass = \case+  RcInteger       -> text "I"+  RcFloatOrVector -> text "F"++allRegClasses :: [RegClass]+allRegClasses = [RcInteger, RcFloatOrVector]
compiler/GHC/Prelude/Basic.hs view
@@ -18,13 +18,13 @@ --     like pprTrace.  module GHC.Prelude.Basic-  (module X-  ,Applicative (..)-  ,module Bits-  ,shiftL, shiftR-  ,head, tail--  , strictGenericLength+  ( module X+  , Applicative (..)+  , module Bits+  , bit+  , shiftL, shiftR+  , setBit, clearBit+  , head, tail   ) where  @@ -63,14 +63,14 @@ import GHC.Stack.Types (HasCallStack)  #if MIN_VERSION_base(4,16,0)-import GHC.Bits as Bits hiding (shiftL, shiftR)+import GHC.Bits as Bits hiding (bit, shiftL, shiftR, setBit, clearBit) # if defined(DEBUG) import qualified GHC.Bits as Bits (shiftL, shiftR) # endif  #else --base <4.15-import Data.Bits as Bits hiding (shiftL, shiftR)+import Data.Bits as Bits hiding (bit, shiftL, shiftR, setBit, clearBit) # if defined(DEBUG) import qualified Data.Bits as Bits (shiftL, shiftR) # endif@@ -80,7 +80,7 @@    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The safe shifts can introduce branches which come at the cost of performance. We still want the additional-debugability for debug builds. So we define it as one or the+debuggability for debug builds. So we define it as one or the other depending on the DEBUG setting.  Why do we then continue on to re-export the rest of Data.Bits?@@ -111,6 +111,16 @@ shiftR = Bits.unsafeShiftR #endif +{-# INLINE bit #-}+bit :: (Num a, Bits.Bits a) => Int -> a+bit = \ i -> 1 `shiftL` i+{-# INLINE setBit #-}+setBit :: (Num a, Bits.Bits a) => a -> Int -> a+setBit = \ x i -> x Bits..|. bit i+{-# INLINE clearBit #-}+clearBit :: (Num a, Bits.Bits a) => a -> Int -> a+clearBit = \ x i -> x Bits..&. Bits.complement (bit i)+ {- Note [Proxies for head and tail] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Prelude.head and Prelude.tail have recently acquired {-# WARNING in "x-partial" #-},@@ -128,15 +138,3 @@ tail :: HasCallStack => [a] -> [a] tail = Prelude.tail {-# INLINE tail #-}--{- |-The 'genericLength' function defined in base can't be specialised due to the-NOINLINE pragma.--It is also not strict in the accumulator, and strictGenericLength is not exported.--See #25706 for why it is important to use a strict, specialised version.---}-strictGenericLength :: Num a => [x] -> a-strictGenericLength = fromIntegral . length
compiler/GHC/Runtime/Context.hs view
@@ -31,6 +31,7 @@ import GHC.Core.InstEnv import GHC.Core.Type +import GHC.Types.DefaultEnv ( DefaultEnv, emptyDefaultEnv ) import GHC.Types.Fixity.Env import GHC.Types.Id.Info ( IdDetails(..) ) import GHC.Types.Name@@ -269,8 +270,8 @@          ic_fix_env :: FixityEnv,             -- ^ Fixities declared in let statements -         ic_default :: Maybe [Type],-             -- ^ The current default types, set by a 'default' declaration+         ic_default :: DefaultEnv,+             -- ^ The current default classes and types, set by 'default' declarations           ic_resume :: [Resume],              -- ^ The stack of breakpoint contexts@@ -319,7 +320,7 @@        ic_fix_env    = emptyNameEnv,        ic_monad      = ioTyConName,  -- IO monad by default        ic_int_print  = printName,    -- System.IO.print by default-       ic_default    = Nothing,+       ic_default    = emptyDefaultEnv,        ic_resume     = [],        ic_cwd        = Nothing,        ic_plugins    = emptyPlugins@@ -362,7 +363,7 @@ extendInteractiveContext :: InteractiveContext                          -> [TyThing]                          -> InstEnv -> [FamInst]-                         -> Maybe [Type]+                         -> DefaultEnv                          -> FixityEnv                          -> InteractiveContext extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env
compiler/GHC/Runtime/Interpreter/Types.hs view
@@ -20,6 +20,8 @@    , JSState (..)    , NodeJsSettings (..)    , defaultNodeJsSettings+   , WasmInterp+   , WasmInterpConfig (..)    ) where @@ -32,9 +34,11 @@ import GHC.Data.FastString ( FastString ) import Foreign +import GHC.Platform import GHC.Utils.TmpFs import GHC.Utils.Logger import GHC.Unit.Env+import GHC.Unit.State import GHC.Unit.Types import GHC.StgToJS.Types import GHC.StgToJS.Linker.Types@@ -65,6 +69,7 @@ data ExtInterp   = ExtIServ !IServ   | ExtJS !JSInterp+  | ExtWasm !WasmInterp  -- | External interpreter --@@ -80,10 +85,12 @@  type IServ    = ExtInterpState IServConfig    () type JSInterp = ExtInterpState JSInterpConfig JSInterpExtra+type WasmInterp = ExtInterpState WasmInterpConfig ()  data InterpProcess = InterpProcess   { interpPipe   :: !Pipe           -- ^ Pipe to communicate with the server   , interpHandle :: !ProcessHandle  -- ^ Process handle of the server+  , interpLock   :: !(MVar ())      -- ^ Lock to prevent concurrent access to the stream   }  -- | Status of an external interpreter@@ -161,3 +168,16 @@   , jsInterpFinderCache :: !FinderCache   } +------------------------+-- Wasm Stuff+------------------------++data WasmInterpConfig = WasmInterpConfig+  { wasmInterpDyLD           :: !FilePath  -- ^ Location of dyld.mjs script+  , wasmInterpLibDir         ::  FilePath  -- ^ wasi-sdk sysroot libdir containing libc.so, etc+  , wasmInterpOpts           :: ![String]  -- ^ Additional command line arguments for iserv+  , wasmInterpTargetPlatform :: !Platform+  , wasmInterpProfiled       :: !Bool      -- ^ Are we profiling yet?+  , wasmInterpHsSoSuffix     :: !String    -- ^ Shared lib filename common suffix sans .so, e.g. p-ghc9.13.20241001+  , wasmInterpUnitState      :: !UnitState+  }
compiler/GHC/Settings.hs view
@@ -65,6 +65,7 @@   , sTargetPlatformString   , sGhcWithInterpreter   , sLibFFI+  , sTargetRTSLinkerOnlySupportsSharedLibs   ) where  import GHC.Prelude@@ -304,3 +305,6 @@ sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc sLibFFI :: Settings -> Bool sLibFFI = platformMisc_libFFI . sPlatformMisc++sTargetRTSLinkerOnlySupportsSharedLibs :: Settings -> Bool+sTargetRTSLinkerOnlySupportsSharedLibs = platformMisc_targetRTSLinkerOnlySupportsSharedLibs . sPlatformMisc
compiler/GHC/Stg/Syntax.hs view
@@ -54,7 +54,6 @@          -- utils         stgRhsArity, freeVarsOfRhs,-        isDllConApp,         stgArgType,         stgArgRep,         stgArgRep1,@@ -87,17 +86,14 @@  import GHC.Types.ForeignCall ( ForeignCall ) import GHC.Types.Id-import GHC.Types.Name        ( isDynLinkName ) import GHC.Types.Tickish     ( StgTickish ) import GHC.Types.Var.Set import GHC.Types.Literal     ( Literal, literalType ) import GHC.Types.RepType ( typePrimRep, typePrimRep1, typePrimRepU, typePrimRep_maybe ) -import GHC.Unit.Module       ( Module ) import GHC.Utils.Outputable import GHC.Utils.Panic.Plain -import GHC.Platform import GHC.Builtin.PrimOps ( PrimOp, PrimCall )  import Data.ByteString ( ByteString )@@ -138,51 +134,6 @@   = StgVarArg  Id   | StgLitArg  Literal --- | Does this constructor application refer to anything in a different--- *Windows* DLL?--- If so, we can't allocate it statically-isDllConApp-  :: Platform-  -> Bool          -- is Opt_ExternalDynamicRefs enabled?-  -> Module-  -> DataCon-  -> [StgArg]-  -> Bool-isDllConApp platform ext_dyn_refs this_mod con args- | not ext_dyn_refs    = False- | platformOS platform == OSMinGW32-    = isDynLinkName platform this_mod (dataConName con) || any is_dll_arg args- | otherwise = False-  where-    -- NB: typePrimRep1 is legit because any free variables won't have-    -- unlifted type (there are no unlifted things at top level)-    is_dll_arg :: StgArg -> Bool-    is_dll_arg (StgVarArg v) =  isAddrRep (typePrimRep1 (idType v))-                             && isDynLinkName platform this_mod (idName v)-    is_dll_arg _             = False---- True of machine addresses; these are the things that don't work across DLLs.--- The key point here is that VoidRep comes out False, so that a top level--- nullary GADT constructor is False for isDllConApp------    data T a where---      T1 :: T Int------ gives------    T1 :: forall a. (a~Int) -> T a------ and hence the top-level binding------    $WT1 :: T Int---    $WT1 = T1 Int (Coercion (Refl Int))------ The coercion argument here gets VoidRep-isAddrRep :: PrimOrVoidRep -> Bool-isAddrRep (NVRep AddrRep)      = True-isAddrRep (NVRep (BoxedRep _)) = True -- FIXME: not true for JavaScript-isAddrRep _                    = False- -- | Type of an @StgArg@ -- -- Very half baked because we have lost the type arguments.@@ -721,24 +672,35 @@  This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module. -A @ReEntrant@ closure may be entered multiple times, but should not be updated-or blackholed. An @Updatable@ closure should be updated after evaluation (and-may be blackholed during evaluation). A @SingleEntry@ closure will only be-entered once, and so need not be updated but may safely be blackholed. -} -data UpdateFlag = ReEntrant | Updatable | SingleEntry+data UpdateFlag+  = ReEntrant+      -- ^ A @ReEntrant@ closure may be entered multiple times, but should not+      -- be updated or blackholed.+  | Updatable+      -- ^ An @Updatable@ closure should be updated after evaluation (and may be+      -- blackholed during evaluation).+  | SingleEntry+      -- ^ A @SingleEntry@ closure will only be entered once, and so need not be+      -- updated but may safely be blackholed.+  | JumpedTo+      -- ^ A @JumpedTo@ (join-point) closure is entered once or multiple times+      -- but has no heap-allocated associated closure.+  deriving (Show,Eq)  instance Outputable UpdateFlag where     ppr u = char $ case u of                        ReEntrant   -> 'r'                        Updatable   -> 'u'                        SingleEntry -> 's'+                       JumpedTo    -> 'j'  isUpdatable :: UpdateFlag -> Bool isUpdatable ReEntrant   = False isUpdatable SingleEntry = False isUpdatable Updatable   = True+isUpdatable JumpedTo    = False  {- ************************************************************************
+ compiler/GHC/StgToCmm/CgUtils.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE GADTs #-}++-----------------------------------------------------------------------------+--+-- Code generator utilities; mostly monadic+--+-- (c) The University of Glasgow 2004-2006+--+-----------------------------------------------------------------------------++module GHC.StgToCmm.CgUtils (+        fixStgRegisters,+        baseRegOffset,+        get_Regtable_addr_from_offset,+        regTableOffset,+        get_GlobalReg_addr,++        -- * Streaming for CG+        CgStream+  ) where++import GHC.Prelude++import GHC.Platform.Regs+import GHC.Platform+import GHC.Cmm+import GHC.Cmm.Dataflow.Block+import GHC.Cmm.Dataflow.Graph+import GHC.Cmm.Utils+import GHC.Cmm.CLabel+import GHC.Utils.Panic+import GHC.Cmm.Dataflow.Label++import GHC.Data.Stream (Stream)+import GHC.Types.Unique.DSM (UniqDSMT)++-- -----------------------------------------------------------------------------+-- Streaming++-- | The Stream instantiation used for code generation.+-- Note the underlying monad is @UniqDSMT IO@, where @UniqDSMT@ is a transformer+-- that propagates a deterministic unique supply (essentially an incrementing+-- counter) from which new uniques are deterministically created during the+-- code generation stages following StgToCmm.+-- See Note [Object determinism].+type CgStream = Stream (UniqDSMT IO)+++-- -----------------------------------------------------------------------------+-- Information about global registers++baseRegOffset :: Platform -> GlobalReg -> Int+baseRegOffset platform reg = case reg of+   VanillaReg 1         -> pc_OFFSET_StgRegTable_rR1  constants+   VanillaReg 2         -> pc_OFFSET_StgRegTable_rR2  constants+   VanillaReg 3         -> pc_OFFSET_StgRegTable_rR3  constants+   VanillaReg 4         -> pc_OFFSET_StgRegTable_rR4  constants+   VanillaReg 5         -> pc_OFFSET_StgRegTable_rR5  constants+   VanillaReg 6         -> pc_OFFSET_StgRegTable_rR6  constants+   VanillaReg 7         -> pc_OFFSET_StgRegTable_rR7  constants+   VanillaReg 8         -> pc_OFFSET_StgRegTable_rR8  constants+   VanillaReg 9         -> pc_OFFSET_StgRegTable_rR9  constants+   VanillaReg 10        -> pc_OFFSET_StgRegTable_rR10 constants+   VanillaReg n         -> panic ("Registers above R10 are not supported (tried to use R" ++ show n ++ ")")+   FloatReg  1          -> pc_OFFSET_StgRegTable_rF1 constants+   FloatReg  2          -> pc_OFFSET_StgRegTable_rF2 constants+   FloatReg  3          -> pc_OFFSET_StgRegTable_rF3 constants+   FloatReg  4          -> pc_OFFSET_StgRegTable_rF4 constants+   FloatReg  5          -> pc_OFFSET_StgRegTable_rF5 constants+   FloatReg  6          -> pc_OFFSET_StgRegTable_rF6 constants+   FloatReg  n          -> panic ("Registers above F6 are not supported (tried to use F" ++ show n ++ ")")+   DoubleReg 1          -> pc_OFFSET_StgRegTable_rD1 constants+   DoubleReg 2          -> pc_OFFSET_StgRegTable_rD2 constants+   DoubleReg 3          -> pc_OFFSET_StgRegTable_rD3 constants+   DoubleReg 4          -> pc_OFFSET_StgRegTable_rD4 constants+   DoubleReg 5          -> pc_OFFSET_StgRegTable_rD5 constants+   DoubleReg 6          -> pc_OFFSET_StgRegTable_rD6 constants+   DoubleReg n          -> panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")+   XmmReg 1             -> pc_OFFSET_StgRegTable_rXMM1 constants+   XmmReg 2             -> pc_OFFSET_StgRegTable_rXMM2 constants+   XmmReg 3             -> pc_OFFSET_StgRegTable_rXMM3 constants+   XmmReg 4             -> pc_OFFSET_StgRegTable_rXMM4 constants+   XmmReg 5             -> pc_OFFSET_StgRegTable_rXMM5 constants+   XmmReg 6             -> pc_OFFSET_StgRegTable_rXMM6 constants+   XmmReg n             -> panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")+   YmmReg 1             -> pc_OFFSET_StgRegTable_rYMM1 constants+   YmmReg 2             -> pc_OFFSET_StgRegTable_rYMM2 constants+   YmmReg 3             -> pc_OFFSET_StgRegTable_rYMM3 constants+   YmmReg 4             -> pc_OFFSET_StgRegTable_rYMM4 constants+   YmmReg 5             -> pc_OFFSET_StgRegTable_rYMM5 constants+   YmmReg 6             -> pc_OFFSET_StgRegTable_rYMM6 constants+   YmmReg n             -> panic ("Registers above YMM6 are not supported (tried to use YMM" ++ show n ++ ")")+   ZmmReg 1             -> pc_OFFSET_StgRegTable_rZMM1 constants+   ZmmReg 2             -> pc_OFFSET_StgRegTable_rZMM2 constants+   ZmmReg 3             -> pc_OFFSET_StgRegTable_rZMM3 constants+   ZmmReg 4             -> pc_OFFSET_StgRegTable_rZMM4 constants+   ZmmReg 5             -> pc_OFFSET_StgRegTable_rZMM5 constants+   ZmmReg 6             -> pc_OFFSET_StgRegTable_rZMM6 constants+   ZmmReg n             -> panic ("Registers above ZMM6 are not supported (tried to use ZMM" ++ show n ++ ")")+   Sp                   -> pc_OFFSET_StgRegTable_rSp    constants+   SpLim                -> pc_OFFSET_StgRegTable_rSpLim constants+   LongReg 1            -> pc_OFFSET_StgRegTable_rL1    constants+   LongReg n            -> panic ("Registers above L1 are not supported (tried to use L" ++ show n ++ ")")+   Hp                   -> pc_OFFSET_StgRegTable_rHp             constants+   HpLim                -> pc_OFFSET_StgRegTable_rHpLim          constants+   CCCS                 -> pc_OFFSET_StgRegTable_rCCCS           constants+   CurrentTSO           -> pc_OFFSET_StgRegTable_rCurrentTSO     constants+   CurrentNursery       -> pc_OFFSET_StgRegTable_rCurrentNursery constants+   HpAlloc              -> pc_OFFSET_StgRegTable_rHpAlloc        constants+   EagerBlackholeInfo   -> pc_OFFSET_stgEagerBlackholeInfo       constants+   GCEnter1             -> pc_OFFSET_stgGCEnter1                 constants+   GCFun                -> pc_OFFSET_stgGCFun                    constants+   BaseReg              -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:BaseReg"+   PicBaseReg           -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:PicBaseReg"+   MachSp               -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:MachSp"+   UnwindReturnReg      -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:UnwindReturnReg"+ where+   !constants = platformConstants platform+++-- -----------------------------------------------------------------------------+--+-- STG/Cmm GlobalReg+--+-- -----------------------------------------------------------------------------++-- | We map STG registers onto appropriate CmmExprs.  Either they map+-- to real machine registers or stored as offsets from BaseReg.  Given+-- a GlobalReg, get_GlobalReg_addr always produces the+-- register table address for it.+get_GlobalReg_addr :: Platform -> GlobalReg -> CmmExpr+get_GlobalReg_addr platform BaseReg = regTableOffset platform 0+get_GlobalReg_addr platform mid+    = get_Regtable_addr_from_offset platform (baseRegOffset platform mid)++-- Calculate a literal representing an offset into the register table.+-- Used when we don't have an actual BaseReg to offset from.+regTableOffset :: Platform -> Int -> CmmExpr+regTableOffset platform n =+  CmmLit (CmmLabelOff mkMainCapabilityLabel (pc_OFFSET_Capability_r (platformConstants platform) + n))++get_Regtable_addr_from_offset :: Platform -> Int -> CmmExpr+get_Regtable_addr_from_offset platform offset =+    if haveRegBase platform+    then cmmRegOff (baseReg platform) offset+    else regTableOffset platform offset++-- | Fixup global registers so that they assign to locations within the+-- RegTable if they aren't pinned for the current target.+fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl+fixStgRegisters _ top@(CmmData _ _) = top++fixStgRegisters platform (CmmProc info lbl live graph) =+  let graph' = modifyGraph (mapGraphBlocks mapMap (fixStgRegBlock platform)) graph+  in CmmProc info lbl live graph'++fixStgRegBlock :: Platform -> Block CmmNode e x -> Block CmmNode e x+fixStgRegBlock platform block = mapBlock (fixStgRegStmt platform) block++fixStgRegStmt :: Platform -> CmmNode e x -> CmmNode e x+fixStgRegStmt platform stmt = fixAssign $ mapExpDeep fixExpr stmt+  where+    fixAssign stmt =+      case stmt of+        CmmAssign (CmmGlobal reg_use) src+          -- MachSp isn't an STG register; it's merely here for tracking unwind+          -- information+          | reg == MachSp -> stmt+          | otherwise ->+            let baseAddr = get_GlobalReg_addr platform reg+            in case reg `elem` activeStgRegs platform of+                True  -> CmmAssign (CmmGlobal reg_use) src+                False -> CmmStore baseAddr src NaturallyAligned+          where reg = globalRegUse_reg reg_use+        other_stmt -> other_stmt++    fixExpr expr = case expr of+        -- MachSp isn't an STG; it's merely here for tracking unwind information+        CmmReg (CmmGlobal (GlobalRegUse MachSp _)) -> expr+        CmmReg (CmmGlobal reg_use) ->+            -- Replace register leaves with appropriate StixTrees for+            -- the given target.  MagicIds which map to a reg on this+            -- arch are left unchanged.  For the rest, BaseReg is taken+            -- to mean the address of the reg table in MainCapability,+            -- and for all others we generate an indirection to its+            -- location in the register table.+            let reg = globalRegUse_reg reg_use in+            case reg `elem` activeStgRegs platform of+                True  -> expr+                False ->+                    let baseAddr = get_GlobalReg_addr platform reg+                    in case reg of+                        BaseReg -> baseAddr+                        _other  -> CmmLoad baseAddr+                                     (globalRegUse_type reg_use)+                                     NaturallyAligned++        CmmRegOff greg@(CmmGlobal reg) offset ->+            -- RegOf leaves are just a shorthand form. If the reg maps+            -- to a real reg, we keep the shorthand, otherwise, we just+            -- expand it and defer to the above code.+            -- NB: to ensure type correctness we need to ensure the Add+            --     as well as the Int need to be of the same size as the+            --     register.+            case globalRegUse_reg reg `elem` activeStgRegs platform of+                True  -> expr+                False -> CmmMachOp (MO_Add (cmmRegWidth greg)) [+                                    fixExpr (CmmReg greg),+                                    CmmLit (CmmInt (fromIntegral offset)+                                                   (cmmRegWidth greg))]++        other_expr -> other_expr
compiler/GHC/StgToCmm/Config.hs view
@@ -46,7 +46,6 @@   ---------------------------------- Flags --------------------------------------   , stgToCmmLoopification  :: !Bool              -- ^ Loopification enabled (cf @-floopification@)   , stgToCmmAlignCheck     :: !Bool              -- ^ Insert alignment check (cf @-falignment-sanitisation@)-  , stgToCmmOptHpc         :: !Bool              -- ^ perform code generation for code coverage   , stgToCmmFastPAPCalls   :: !Bool              -- ^   , stgToCmmSCCProfiling   :: !Bool              -- ^ Check if cost-centre profiling is enabled   , stgToCmmEagerBlackHole :: !Bool              -- ^@@ -63,9 +62,10 @@   , stgToCmmDoBoundsCheck  :: !Bool              -- ^ decides whether to check array bounds in StgToCmm.Prim                                                  -- or not   , stgToCmmDoTagCheck     :: !Bool              -- ^ Verify tag inference predictions.+  , stgToCmmObjectDeterminism :: !Bool           -- ^ Enable deterministic code generation (more precisely, the deterministic unique-renaming pass in StgToCmm)   ------------------------------ Backend Flags -----------------------------------  , stgToCmmAllowBigArith             :: !Bool   -- ^ Allowed to emit larger than native size arithmetic (only LLVM and C backends)-  , stgToCmmAllowBigQuot              :: !Bool   -- ^ Allowed to emit larger than native size division operations+  , stgToCmmAllowArith64              :: !Bool   -- ^ Allowed to emit 64-bit arithmetic operations+  , stgToCmmAllowQuot64               :: !Bool   -- ^ Allowed to emit 64-bit division operations   , stgToCmmAllowQuotRemInstr         :: !Bool   -- ^ Allowed to generate QuotRem instructions   , stgToCmmAllowQuotRem2             :: !Bool   -- ^ Allowed to generate QuotRem   , stgToCmmAllowExtendedAddSubInstrs :: !Bool   -- ^ Allowed to generate AddWordC, SubWordC, Add2, etc.
compiler/GHC/StgToCmm/Types.hs view
@@ -22,7 +22,6 @@  import GHC.Utils.Outputable - {- Note [Conveying CAF-info and LFInfo between modules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/StgToJS/Object.hs view
@@ -66,6 +66,9 @@ import           Control.Monad  import           Data.Array+import qualified Data.ByteString          as B+import qualified Data.ByteString.Unsafe   as B+import           Data.Char (isSpace) import           Data.Int import           Data.IntSet (IntSet) import qualified Data.IntSet as IS@@ -75,10 +78,7 @@ import qualified Data.Map as M import           Data.Word import           Data.Semigroup-import qualified Data.ByteString          as B-import qualified Data.ByteString.Unsafe   as B-import Data.Char (isSpace)-import System.IO+import           System.IO  import GHC.Settings.Constants (hiVersion) @@ -168,7 +168,7 @@ data Object = Object   { objModuleName    :: !ModuleName     -- ^ name of the module-  , objHandle        :: !BinHandle+  , objHandle        :: !ReadBinHandle     -- ^ BinHandle that can be used to read the ObjBlocks   , objPayloadOffset :: !(Bin ObjBlock)     -- ^ Offset of the payload (units)@@ -253,7 +253,7 @@  -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index-putObjBlock :: BinHandle -> ObjBlock -> IO ()+putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do     put_ bh b     put_ bh c@@ -264,7 +264,7 @@  -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index)-getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock+getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do     b <- get bh     c <- get bh@@ -299,7 +299,7 @@ -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject-  :: BinHandle+  :: WriteBinHandle   -> ModuleName -- ^ module   -> BlockInfo  -- ^ block infos   -> [ObjBlock] -- ^ linkable units and their symbols@@ -313,15 +313,16 @@   -- object in an archive.   put_ bh (moduleNameString mod_name) -  (bh_fs, _bin_dict, put_dict) <- initFSTable bh+  (fs_tbl, fs_writer) <- initFastStringWriterTable+  let bh_fs = addWriterToUserData fs_writer bh -  forwardPut_ bh (const put_dict) $ do+  forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do     put_ bh_fs deps      -- forward put the index     forwardPut_ bh_fs (put_ bh_fs) $ do       idx <- forM os $ \o -> do-        p <- tellBin bh_fs+        p <- tellBinWriter bh_fs         -- write units without their symbols         putObjBlock bh_fs o         -- return symbols and offset to store in the index@@ -329,7 +330,7 @@       pure idx  -- | Parse object header-getObjectHeader :: BinHandle -> IO (Either String ModuleName)+getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do   magic <- getByteString bh (B.length hsHeader)   case magic == hsHeader of@@ -344,15 +345,15 @@   -- | Parse object body. Must be called after a successful getObjectHeader-getObjectBody :: BinHandle -> ModuleName -> IO Object+getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do   -- Read the string table   dict <- forwardGet bh0 (getDictionary bh0)-  let bh = setUserData bh0 $ noUserData { ud_get_fs = getDictFastString dict }+  let bh = setReaderUserData bh0 $ newReadState (panic "No name allowed") (getDictFastString dict)    block_info  <- get bh   idx         <- forwardGet bh (get bh)-  payload_pos <- tellBin bh+  payload_pos <- tellBinReader bh    pure $ Object     { objModuleName    = mod_name@@ -363,7 +364,7 @@     }  -- | Parse object-getObject :: BinHandle -> IO (Maybe Object)+getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do   getObjectHeader bh >>= \case     Left _err      -> pure Nothing@@ -392,7 +393,7 @@     bh = objHandle obj     read_entry (IndexEntry syms offset,i)       | IS.member i bids = do-          seekBin bh offset+          seekBinReader bh offset           Just <$> getObjBlock syms bh       | otherwise = pure Nothing @@ -408,12 +409,12 @@ -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO ()+putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n)              | otherwise = put_ bh n   where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a+getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16)  -- | Helper to convert Int to Int32@@ -537,7 +538,7 @@  instance Binary Ident where   put_ bh (identFS -> xs) = put_ bh xs-  get  bh                = global <$> get bh+  get  bh                 = name <$> get bh  instance Binary ClosureInfo where   put_ bh (ClosureInfo v regs name layo typ static) = do@@ -778,7 +779,7 @@   -- | Read a JS object from BinHandle-parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString)+parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do   magic <- getByteString bh (B.length jsHeader)   case magic == jsHeader of
+ compiler/GHC/StgToJS/Symbols.hs view
@@ -0,0 +1,1217 @@+{-# LANGUAGE OverloadedStrings #-}++-- | JS symbol generation+module GHC.StgToJS.Symbols where++import GHC.Prelude++import GHC.JS.JStg.Syntax+import GHC.JS.Ident++import GHC.Data.FastString+import GHC.Unit.Module+import GHC.Utils.Word64 (intToWord64)+import Data.ByteString (ByteString)+import Data.Word (Word64)+import qualified Data.ByteString.Char8   as BSC+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Lazy    as BSL++import Data.Array+import Data.Semigroup ((<>))++-- | Hexadecimal representation of an int+--+-- Used for the sub indices.+intBS :: Int -> ByteString+intBS = word64BS . intToWord64++-- | Hexadecimal representation of a 64-bit word+--+-- Used for uniques. We could use base-62 as GHC usually does but this is likely+-- faster.+word64BS :: Word64 -> ByteString+word64BS = BSL.toStrict . BSB.toLazyByteString . BSB.word64Hex++-- | Return z-encoded unit:module+unitModuleStringZ :: Module -> ByteString+unitModuleStringZ mod = mconcat+  [ fastZStringToByteString (zEncodeFS (unitIdFS (moduleUnitId mod)))+  , BSC.pack "ZC" -- z-encoding for ":"+  , fastZStringToByteString (zEncodeFS (moduleNameFS (moduleName mod)))+  ]++-- | the global linkable unit of a module exports this symbol, depend on it to+--   include that unit (used for cost centres)+moduleGlobalSymbol :: Module -> FastString+moduleGlobalSymbol m = mkFastStringByteString $ mconcat+  [ hdB+  , unitModuleStringZ m+  , BSC.pack "_<global>"+  ]++moduleExportsSymbol :: Module -> FastString+moduleExportsSymbol m = mkFastStringByteString $ mconcat+  [ hdB+  , unitModuleStringZ m+  , BSC.pack "_<exports>"+  ]++-- | Make JS symbol corresponding to the given Haskell symbol in the given+-- module+mkJsSymbolBS :: Bool -> Module -> FastString -> ByteString+mkJsSymbolBS exported mod s = mconcat+  [ if exported then hdB else hddB+  , unitModuleStringZ mod+  , BSC.pack "zi" -- z-encoding of "."+  , fastZStringToByteString (zEncodeFS s)+  ]++-- | Make JS symbol corresponding to the given Haskell symbol in the given+-- module+mkJsSymbol :: Bool -> Module -> FastString -> FastString+mkJsSymbol exported mod s = mkFastStringByteString (mkJsSymbolBS exported mod s)++-- | Make JS symbol for given module and unique.+mkFreshJsSymbol :: Module -> Int -> FastString+mkFreshJsSymbol mod i = mkFastStringByteString $ mconcat+  [ hddB+  , unitModuleStringZ mod+  , BSC.pack "_"+  , intBS i+  ]++-- | Make symbol "h$XYZ" or "h$$XYZ"+mkRawSymbol :: Bool -> FastString -> FastString+mkRawSymbol exported fs+  | exported  = mkFastStringByteString $ mconcat [ hdB,  bytesFS fs ]+  | otherwise = mkFastStringByteString $ mconcat [ hddB, bytesFS fs ]++-- | "h$$" constant string+hddB :: ByteString+hddB = BSC.pack "h$$"++-- | "h$" constant string+hdB :: ByteString+hdB = BSC.take 2 hddB++hd :: JStgExpr+hd = global hdStr++hdStr :: FastString+hdStr = mkFastStringByteString hdB++hdlB :: ByteString+hdlB = BSC.pack "h$l"++----------------------------------------- Runtime -------------------------------+hdApply :: JStgExpr+hdApply = global hdApplyStr++hdApplyStr :: FastString+hdApplyStr = fsLit "h$apply"++hdMoveRegs2 :: FastString+hdMoveRegs2 = fsLit "h$moveRegs2"++hdPapGen :: JStgExpr+hdPapGen = global hdPapGenStr++hdPapGenStr :: FastString+hdPapGenStr = fsLit "h$pap_gen"++hdSetReg :: JStgExpr+hdSetReg = global hdSetRegStr++hdSetRegStr :: FastString+hdSetRegStr = fsLit "h$setReg"++hdGetReg :: JStgExpr+hdGetReg = global hdGetRegStr++hdGetRegStr :: FastString+hdGetRegStr = fsLit "h$getReg"++hdResetRegisters :: Ident+hdResetRegisters = name "h$resetRegisters"++hdResetResultVars :: Ident+hdResetResultVars = name "h$resetResultVars"++hdInitClosure :: FastString+hdInitClosure = fsLit "h$init_closure"++hdRegs :: JStgExpr+hdRegs = global (identFS hdRegsStr)++hdRegsStr :: Ident+hdRegsStr = name "h$regs"++hdReturn :: JStgExpr+hdReturn = global (identFS hdReturnStr)++hdReturnStr :: Ident+hdReturnStr = name "h$return"++hdStack :: JStgExpr+hdStack = global (identFS hdStackStr)++hdStackStr :: Ident+hdStackStr = name "h$stack"++hdStackPtr :: JStgExpr+hdStackPtr = global (identFS hdStackPtrStr)++hdStackPtrStr :: Ident+hdStackPtrStr = name "h$sp"++hdBlackHoleTrap :: JStgExpr+hdBlackHoleTrap = global (identFS hdBlackHoleTrapStr)++hdBlackHoleTrapStr :: Ident+hdBlackHoleTrapStr = name "h$blackholeTrap"++hdBlockOnBlackHoleStr :: FastString+hdBlockOnBlackHoleStr = "h$blockOnBlackhole"++hdBlackHoleLNE :: JStgExpr+hdBlackHoleLNE = global (identFS hdBlackHoleLNEStr)++hdBlackHoleLNEStr :: Ident+hdBlackHoleLNEStr = name "h$bh_lne"++hdClosureTypeName :: JStgExpr+hdClosureTypeName = global (identFS hdClosureTypeNameStr)++hdClosureTypeNameStr :: Ident+hdClosureTypeNameStr = name "h$closureTypeName"++hdBh :: JStgExpr+hdBh = global hdBhStr++hdBhStr :: FastString+hdBhStr = fsLit "h$bh"++hdBlackHole :: JStgExpr+hdBlackHole = global (identFS hdBlackHoleStr)++hdBlackHoleStr :: Ident+hdBlackHoleStr = name "h$blackhole"++hdUpdFrame :: JStgExpr+hdUpdFrame = global (identFS hdUpdFrameStr)++hdUpdFrameStr :: Ident+hdUpdFrameStr = name $ fsLit "h$upd_frame"++hdCSel :: JStgExpr+hdCSel = global hdCSelStr++hdCSelStr :: FastString+hdCSelStr = "h$c_sel_"++hdEntry :: Ident+hdEntry = name hdEntryStr++hdEntryStr :: FastString+hdEntryStr = fsLit "h$e"++hdApGen :: JStgExpr+hdApGen = global (identFS hdApGenStr)++hdApGenStr :: Ident+hdApGenStr = name "h$ap_gen"++hdApGenFastStr :: Ident+hdApGenFastStr = name $ fsLit $ unpackFS (identFS hdApGenStr) ++ "_fast"++hdLog :: JStgExpr+hdLog = global hdLogStr++hdLogStr :: FastString+hdLogStr = fsLit "h$log"++hdMkFunctionPtr :: JStgExpr+hdMkFunctionPtr = global "h$mkFunctionPtr"++hdInitStatic :: JStgExpr+hdInitStatic = global (identFS hdInitStaticStr)++hdInitStaticStr :: Ident+hdInitStaticStr = name "h$initStatic"++hdHsSptInsert :: JStgExpr+hdHsSptInsert = global "h$hs_spt_insert"++hdCurrentThread :: JStgExpr+hdCurrentThread = global (identFS hdCurrentThreadStr)++hdCurrentThreadStr :: Ident+hdCurrentThreadStr = name "h$currentThread"++hdWakeupThread :: FastString+hdWakeupThread = fsLit "h$wakeupThread"++hdPaps :: JStgExpr+hdPaps = global hdPapsStr++hdPapsStr :: FastString+hdPapsStr = fsLit "h$paps"++hdPapStr_ :: FastString+hdPapStr_ = fsLit "h$pap_"++hdLazyEntryStr :: Ident+hdLazyEntryStr = name "h$lazy_e"++hdUnboxEntry :: JStgExpr+hdUnboxEntry = global (identFS hdUnboxEntryStr)++hdUnboxEntryStr :: Ident+hdUnboxEntryStr = name "h$unbox_e"++hdMaskFrame :: JStgExpr+hdMaskFrame = global (identFS hdMaskFrameStr)++hdMaskFrameStr :: Ident+hdMaskFrameStr = name "h$maskFrame"++hdUnMaskFrameStr :: Ident+hdUnMaskFrameStr = name "h$unmaskFrame"++hdReturnF :: JStgExpr+hdReturnF = global (identFS hdReturnFStr)++hdReturnFStr :: Ident+hdReturnFStr = name "h$returnf"++hdResumeEntryStr :: Ident+hdResumeEntryStr = name "h$resume_e"++hdFlushStdout :: JStgExpr+hdFlushStdout = global (identFS hdFlushStdoutStr)++hdFlushStdoutStr :: Ident+hdFlushStdoutStr = name "h$flushStdout"++hdFlushStdoutEntry :: JStgExpr+hdFlushStdoutEntry = global (identFS hdFlushStdoutEntryStr)++hdFlushStdoutEntryStr :: Ident+hdFlushStdoutEntryStr = name "h$flushStdout_e"++hdRunIOEntry :: JStgExpr+hdRunIOEntry = global (identFS hdRunIOEntryStr)++hdRunIOEntryStr :: Ident+hdRunIOEntryStr = name "h$runio_e"++hdReduce :: JStgExpr+hdReduce = global (identFS hdReduceStr)++hdReduceStr :: Ident+hdReduceStr = name "h$reduce"++hdThrowStr :: FastString+hdThrowStr = fsLit "h$throw"++hdRaiseAsyncFrame :: JStgExpr+hdRaiseAsyncFrame = global (identFS hdRaiseAsyncFrameStr)++hdRaiseAsyncFrameStr :: Ident+hdRaiseAsyncFrameStr = name "h$raiseAsync_frame"++hdRaiseAsyncEntry :: JStgExpr+hdRaiseAsyncEntry = global (identFS hdRaiseAsyncEntryStr)++hdRaiseAsyncEntryStr :: Ident+hdRaiseAsyncEntryStr = name "h$raiseAsync_e"++hdRaiseEntry :: JStgExpr+hdRaiseEntry = global (identFS hdRaiseEntryStr)++hdRaiseEntryStr :: Ident+hdRaiseEntryStr = name "h$raise_e"++hdKeepAliveEntry :: JStgExpr+hdKeepAliveEntry = global (identFS hdKeepAliveEntryStr)++hdKeepAliveEntryStr :: Ident+hdKeepAliveEntryStr = name "h$keepAlive_e"++hdSelect2Return :: JStgExpr+hdSelect2Return = global (identFS hdSelect2ReturnStr)++hdSelect2ReturnStr :: Ident+hdSelect2ReturnStr = name "h$select2_ret"++hdSelect2Entry :: JStgExpr+hdSelect2Entry = global (identFS hdSelect2EntryStr)++hdSelect2EntryStr :: Ident+hdSelect2EntryStr = name "h$select2_e"++hdSelect1Ret :: JStgExpr+hdSelect1Ret = global (identFS hdSelect1RetStr)++hdSelect1RetStr :: Ident+hdSelect1RetStr = name "h$select1_ret"++hdSelect1EntryStr :: Ident+hdSelect1EntryStr = name "h$select1_e"++hdStaticThunkStr :: FastString+hdStaticThunkStr = fsLit "h$static_thunk"++hdStaticThunksStr+  , hdStaticThunksArrStr+  , hdCAFsStr+  , hdCAFsResetStr :: Ident+hdStaticThunksStr    = name "h$staticThunks"+hdStaticThunksArrStr = name "h$staticThunksArr"+hdCAFsStr            = name "h$CAFs"+hdCAFsResetStr       = name "h$CAFsReset"++hdUpdThunkEntryStr :: Ident+hdUpdThunkEntryStr = name "h$upd_thunk_e"++hdAp3EntryStr :: Ident+hdAp3EntryStr = name "h$ap3_e"++hdAp2EntryStr :: Ident+hdAp2EntryStr = name "h$ap2_e"++hdAp1EntryStr :: Ident+hdAp1EntryStr = name "h$ap1_e"++hdDataToTagEntryStr :: Ident+hdDataToTagEntryStr = name "h$dataToTag_e"++hdTagToEnum :: FastString+hdTagToEnum = fsLit "h$tagToEnum"++hdCatchEntryStr :: Ident+hdCatchEntryStr = name "h$catch_e"++hdNoopStr :: Ident+hdNoopStr = name "h$noop"++hdNoopEntry :: JStgExpr+hdNoopEntry = global (identFS hdNoopEntryStr)++hdNoopEntryStr :: Ident+hdNoopEntryStr = name "h$noop_e"++hdC0 :: JStgExpr+hdC0 = global (identFS hdC0Str)++hdC :: JStgExpr+hdC = global (identFS hdCStr)++hdC0Str :: Ident+hdC0Str = name "h$c0"++hdCStr :: Ident+hdCStr = name "h$c"++hdData2Entry :: Ident+hdData2Entry = name "h$data2_e"++hdData1Entry :: Ident+hdData1Entry = name "h$data1_e"++hdTrueEntry :: Ident+hdTrueEntry = name "h$true_e"++hdFalseEntry :: Ident+hdFalseEntry = name "h$false_e"++hdDoneMainEntry :: JStgExpr+hdDoneMainEntry = global (identFS hdDoneMainEntryStr)++hdDoneMainEntryStr :: Ident+hdDoneMainEntryStr = name "h$doneMain_e"++hdDoneMain :: JStgExpr+hdDoneMain = global "h$doneMain"++hdDone :: Ident+hdDone = name "h$done"++hdExitProcess :: FastString+hdExitProcess = "h$exitProcess"++hdTraceAlloc :: FastString+hdTraceAlloc = fsLit "h$traceAlloc"++hdDebugAllocNotifyAlloc :: FastString+hdDebugAllocNotifyAlloc = fsLit "h$debugAlloc_notifyAlloc"++hdRtsTraceForeign+  , hdRtsProfiling+  , hdCtFun+  , hdCtCon+  , hdCtThunk+  , hdCtPap+  , hdCtBlackhole+  , hdCtStackFrame+  , hdCtVtPtr+  , hdVtVoid+  , hdVtInt+  , hdVtDouble+  , hdVtLong+  , hdVtAddr+  , hdVtObj+  , hdVtArr :: Ident+hdRtsTraceForeign = name "h$rts_traceForeign"+hdRtsProfiling    = name "h$rts_profiling"+hdCtFun           = name "h$ct_fun"+hdCtCon           = name "h$ct_con"+hdCtThunk         = name "h$ct_thunk"+hdCtPap           = name "h$ct_pap"+hdCtBlackhole     = name "h$ct_blackhole"+hdCtStackFrame    = name "h$ct_stackframe"+hdCtVtPtr         = name "h$vt_ptr"+hdVtVoid          = name "h$vt_void"+hdVtInt           = name "h$vt_int"+hdVtDouble        = name "h$vt_double"+hdVtLong          = name "h$vt_long"+hdVtAddr          = name "h$vt_addr"+hdVtObj           = name "h$vt_obj"+hdVtArr           = name "h$vt_arr"+++hdLoads :: Array Int Ident+hdLoads = listArray (1,32) [ name . mkFastStringByteString $ hdlB <> BSC.pack (show n)+                           | n <- [1..32::Int]+                           ]++----------------------------------------- Precompiled Aps ----------------------+hdAp00 :: JStgExpr+hdAp00 = global (identFS hdAp00Str)++hdAp00Str :: Ident+hdAp00Str = name "h$ap_0_0"++hdAp00FastStr :: FastString+hdAp00FastStr = fsLit "h$ap_0_0_fast"++hdAp11Fast :: FastString+hdAp11Fast = fsLit "h$ap_1_1_fast"++hdAp10 :: JStgExpr+hdAp10 = global "h$ap_1_0"++hdAp33FastStr :: FastString+hdAp33FastStr = fsLit "h$ap_3_3_fast"++hdAp22FastStr :: FastString+hdAp22FastStr = fsLit "h$ap_2_2_fast"++----------------------------------------- ByteArray -----------------------------+hdNewByteArrayStr :: FastString+hdNewByteArrayStr = "h$newByteArray"++hdCopyMutableByteArrayStr :: FastString+hdCopyMutableByteArrayStr = "h$copyMutableByteArray"++hdCheckOverlapByteArrayStr :: FastString+hdCheckOverlapByteArrayStr = "h$checkOverlapByteArray"++hdShrinkMutableCharArrayStr :: FastString+hdShrinkMutableCharArrayStr = "h$shrinkMutableCharArray"++----------------------------------------- EventLog -----------------------------+hdTraceEventStr :: FastString+hdTraceEventStr = "h$traceEvent"++hdTraceEventBinaryStr :: FastString+hdTraceEventBinaryStr = "h$traceEventBinary"++hdTraceMarkerStr :: FastString+hdTraceMarkerStr = "h$traceMarker"++----------------------------------------- FFI ----------------------------------+hdThrowJSException :: JStgExpr+hdThrowJSException = global $ fsLit "h$throwJSException"++hdUnboxFFIResult :: JStgExpr+hdUnboxFFIResult = global (identFS hdUnboxFFIResultStr)++hdUnboxFFIResultStr :: Ident+hdUnboxFFIResultStr = name "h$unboxFFIResult"++hdMkForeignCallback :: JStgExpr+hdMkForeignCallback = global $ fsLit "h$mkForeignCallback"++hdTraceForeign :: JStgExpr+hdTraceForeign = global $ fsLit "h$traceForeign"++hdBuildObject :: JStgExpr+hdBuildObject = global hdBuildObjectStr++hdBuildObjectStr :: FastString+hdBuildObjectStr = fsLit "h$buildObject"++hdCallDynamicStr :: FastString+hdCallDynamicStr = fsLit "h$callDynamic"++except :: JStgExpr+except = global $ identFS exceptStr++exceptStr :: Ident+exceptStr = name $ fsLit "except"++excepStr :: FastString+excepStr = fsLit "excep"++----------------------------------------- Accessors -----------------------------++-- for almost all other symbols that are faststrings we turn 'foo' into 'fooStr'+-- because these are overloaded with JStgExpr's. But for accessors we leave+-- these as FastStrings because they will become Idents after the refactor.+mv :: FastString+mv = fsLit "mv"++lngth :: FastString+lngth = fsLit "length"++-- | only for byte arrays. This is a JS byte array method+len :: FastString+len = fsLit "len"++slice :: FastString+slice = fsLit "slice"++this :: JStgExpr+this = global "this"++arr :: FastString+arr = fsLit "arr"++dv :: FastString+dv = fsLit "dv"++d1, d2, d3 :: JStgExpr+d1 = global d1Str+d2 = global d2Str+d3 = global d3Str++d1Str, d2Str, d3Str :: FastString+d1Str = fsLit "d1"+d2Str = fsLit "d2"+d3Str = fsLit "d3"++getInt16 :: FastString+getInt16 = "getInt16"++getUint16 :: FastString+getUint16 = "getUint16"++getInt32 :: FastString+getInt32 = "getInt32"++getUint32 :: FastString+getUint32 = "getUint32"++getFloat32 :: FastString+getFloat32 = "getFloat32"++getFloat64 :: FastString+getFloat64 = "getFloat64"++setInt16 :: FastString+setInt16 = "setInt16"++setUint16 :: FastString+setUint16 = "setUint16"++setInt32 :: FastString+setInt32 = "setInt32"++setUint32 :: FastString+setUint32 = "setUint32"++setFloat32 :: FastString+setFloat32 = "setFloat32"++setFloat64 :: FastString+setFloat64 = "setFloat64"++i3, u8, u1, f6, f3 :: FastString+i3 = "i3"+u8 = "u8"+u1 = "u1"+f6 = "f6"+f3 = "f3"++val :: FastString+val = fsLit "val"++label :: FastString+label = fsLit "label"++mask :: FastString+mask = fsLit "mask"++unMask :: FastString+unMask = fsLit "unmask"++resume :: FastString+resume = "resume"++f :: FastString+f = fsLit "f"++n :: FastString+n = fsLit "n"++hasOwnProperty :: FastString+hasOwnProperty = fsLit "hasOwnProperty"++hdCollectProps :: FastString+hdCollectProps = fsLit "h$collectProps"++replace :: FastString+replace = fsLit "replace"++substring :: FastString+substring = fsLit "substring"++trace :: FastString+trace = fsLit "trace"++apply :: FastString+apply = fsLit "apply"++----------------------------------------- STM ----------------------------------+hdMVar :: JStgExpr+hdMVar = global hdMVarStr++hdMVarStr :: FastString+hdMVarStr = fsLit "h$MVar"++hdTakeMVar :: JStgExpr+hdTakeMVar = global hdTakeMVarStr++hdTakeMVarStr :: FastString+hdTakeMVarStr = fsLit "h$takeMVar"++hdTryTakeMVarStr :: FastString+hdTryTakeMVarStr = fsLit "h$tryTakeMVar"++hdPutMVarStr :: FastString+hdPutMVarStr = fsLit "h$putMVar"++hdTryPutMVarStr :: FastString+hdTryPutMVarStr = fsLit "h$tryPutMVar"++hdNewTVar :: FastString+hdNewTVar = fsLit "h$newTVar"++hdReadTVar :: FastString+hdReadTVar = fsLit "h$readTVar"++hdReadTVarIO :: FastString+hdReadTVarIO = fsLit "h$readTVarIO"++hdWriteTVar :: FastString+hdWriteTVar = fsLit "h$writeTVar"++hdReadMVarStr :: FastString+hdReadMVarStr = fsLit "h$readMVar"++hdStmRemoveBlockedThreadStr :: FastString+hdStmRemoveBlockedThreadStr = fsLit "h$stmRemoveBlockedThread"++hdStmStartTransactionStr :: FastString+hdStmStartTransactionStr = fsLit "h$stmStartTransaction"++hdAtomicallyEntry :: JStgExpr+hdAtomicallyEntry = global (identFS hdAtomicallyEntryStr)++hdAtomicallyEntryStr :: Ident+hdAtomicallyEntryStr = name $ fsLit "h$atomically_e"++hdAtomicallyStr :: FastString+hdAtomicallyStr = "h$atomically"++hdStgResumeRetryEntry :: JStgExpr+hdStgResumeRetryEntry = global (identFS hdStgResumeRetryEntryStr)++hdStgResumeRetryEntryStr :: Ident+hdStgResumeRetryEntryStr = name $ fsLit "h$stmResumeRetry_e"++hdStmCommitTransactionStr :: FastString+hdStmCommitTransactionStr = fsLit "h$stmCommitTransaction"++hdStmValidateTransactionStr :: FastString+hdStmValidateTransactionStr = "h$stmValidateTransaction"++hdStmCatchRetryEntry :: JStgExpr+hdStmCatchRetryEntry = global (identFS hdStmCatchRetryEntryStr)++hdStmCatchRetryEntryStr :: Ident+hdStmCatchRetryEntryStr = name $ fsLit "h$stmCatchRetry_e"++hdStmRetryStr :: FastString+hdStmRetryStr = fsLit "h$stmRetry"++hdStmCatchRetryStr :: FastString+hdStmCatchRetryStr = fsLit "h$stmCatchRetry"++hdStmCatchEntry :: JStgExpr+hdStmCatchEntry = global (identFS hdStmCatchEntryStr)++hdCatchStmStr :: FastString+hdCatchStmStr = fsLit "h$catchStm"++hdStmCatchEntryStr :: Ident+hdStmCatchEntryStr = name $ fsLit "h$catchStm_e"++hdRetryInterrupted :: JStgExpr+hdRetryInterrupted = global (identFS hdRetryInterruptedStr)++hdRetryInterruptedStr :: Ident+hdRetryInterruptedStr = name $ fsLit "h$retryInterrupted"++hdMaskUnintFrame :: JStgExpr+hdMaskUnintFrame = global (identFS hdMaskUnintFrameStr)++hdMaskUnintFrameStr :: Ident+hdMaskUnintFrameStr = name $ fsLit "h$maskUnintFrame"++hdReschedule :: JStgExpr+hdReschedule = global (identFS hdRescheduleStr)++hdRescheduleStr :: Ident+hdRescheduleStr = name $ fsLit "h$reschedule"++hdRestoreThread :: JStgExpr+hdRestoreThread = global (identFS hdRestoreThreadStr)++hdRestoreThreadStr :: Ident+hdRestoreThreadStr = name $ fsLit "h$restoreThread"++hdFinishedThread :: FastString+hdFinishedThread = fsLit "h$finishThread"++----------------------------------------- Z-Encodings ---------------------------+hdPrimOpStr :: FastString+hdPrimOpStr = fsLit "h$primop_"++wrapperColonStr :: FastString+wrapperColonStr = fsLit "ghczuwrapperZC" -- equivalent non-z-encoding => ghc_wrapper:++hdInternalExceptionTypeDivZero :: JStgExpr+hdInternalExceptionTypeDivZero = global "h$ghczminternalZCGHCziInternalziExceptionziTypezidivZZeroException"++hdInternalExceptionTypeOverflow :: JStgExpr+hdInternalExceptionTypeOverflow = global "h$ghczminternalZCGHCziInternalziExceptionziTypezioverflowException"++hdInternalExceptionTypeUnderflow :: JStgExpr+hdInternalExceptionTypeUnderflow = global "h$ghczminternalZCGHCziInternalziExceptionziTypeziunderflowException"++hdInternalExceptionControlExceptionBaseNonTermination :: JStgExpr+hdInternalExceptionControlExceptionBaseNonTermination = global "h$ghczminternalZCGHCziInternalziControlziExceptionziBasezinonTermination"++hdGhcInternalIOHandleFlush :: JStgExpr+hdGhcInternalIOHandleFlush = global "h$ghczminternalZCGHCziInternalziIOziHandlezihFlush"++hdGhcInternalIOHandleFDStdout :: JStgExpr+hdGhcInternalIOHandleFDStdout = global "h$ghczminternalZCGHCziInternalziIOziHandleziFDzistdout"++hdGhcInternalJSPrimValConEntryStr :: FastString+hdGhcInternalJSPrimValConEntryStr = fsLit "h$ghczminternalZCGHCziInternalziJSziPrimziJSVal_con_e"++----------------------------------------- Profiling -----------------------------+hdBuildCCSPtrStr :: FastString+hdBuildCCSPtrStr = "h$buildCCSPtr"++hdClearCCSStr :: FastString+hdClearCCSStr = "h$clearCCS"++hdRestoreCCSStr :: FastString+hdRestoreCCSStr = fsLit "h$restoreCCS"++hdSetCcsEntry :: JStgExpr+hdSetCcsEntry = global (identFS hdSetCcsEntryStr)++hdSetCcsEntryStr :: Ident+hdSetCcsEntryStr = name $ fsLit "h$setCcs_e"++ccStr :: FastString+ccStr = fsLit "cc"+----------------------------------------- Others -------------------------------+unknown :: FastString+unknown = fsLit "<unknown>"++typeof :: FastString+typeof = fsLit "typeof"++hdRawStr :: FastString+hdRawStr = fsLit "h$rstr"++throwStr :: FastString+throwStr = fsLit "throw"++hdCheckObj :: JStgExpr+hdCheckObj = global $ fsLit "h$checkObj"++console :: JStgExpr+console = global consoleStr++consoleStr :: FastString+consoleStr = fsLit "console"++arguments :: JStgExpr+arguments = global argumentsStr++argumentsStr :: FastString+argumentsStr = fsLit "arguments"++hdReportHeapOverflow :: JStgExpr+hdReportHeapOverflow = global (identFS hdReportHeapOverflowStr)++hdReportHeapOverflowStr :: Ident+hdReportHeapOverflowStr = name $ fsLit "h$reportHeapOverflow"++hdReportStackOverflow :: JStgExpr+hdReportStackOverflow = global (identFS hdReportStackOverflowStr)++hdReportStackOverflowStr :: Ident+hdReportStackOverflowStr = name $ fsLit "h$reportStackOverflow"++hdDumpRes :: JStgExpr+hdDumpRes = global (identFS hdDumpResStr)++hdDumpResStr :: Ident+hdDumpResStr = name $ fsLit "h$dumpRes"++ghcjsArray :: FastString+ghcjsArray = fsLit "__ghcjsArray"++----------------------------------------- Compact -------------------------------++hdCompactSize :: FastString+hdCompactSize = fsLit "h$compactSize"++hdCompactAddWithSharing :: FastString+hdCompactAddWithSharing = fsLit "h$compactAddWithSharing"++hdCompactAdd :: FastString+hdCompactAdd = fsLit "h$compactAdd"++hdCompactFixupPointers :: FastString+hdCompactFixupPointers = fsLit "h$compactFixupPointers"++hdCompactAllocateBlock :: FastString+hdCompactAllocateBlock = fsLit "h$compactAllocateBlock"++hdCompactGetNextBlock :: FastString+hdCompactGetNextBlock = fsLit "h$compactGetNextBlock"++hdCompactGetFirstBlock :: FastString+hdCompactGetFirstBlock = fsLit "h$compactGetFirstBlock"++hdCompactContainsAny :: FastString+hdCompactContainsAny = fsLit "h$compactContainsAny"++hdCompactContains :: FastString+hdCompactContains = fsLit "h$compactContains"++hdCompactResize :: FastString+hdCompactResize = fsLit "h$compactResize"++hdCompactNew :: FastString+hdCompactNew = fsLit "h$compactNew"++----------------------------------------- Stable Pointers -----------------------++hdStableNameInt :: FastString+hdStableNameInt = fsLit "h$stableNameInt"++hdMakeStableName :: FastString+hdMakeStableName = fsLit "h$makeStableName"++hdDeRefStablePtr :: FastString+hdDeRefStablePtr = fsLit "h$deRefStablePtr"++hdStablePtrBuf :: JStgExpr+hdStablePtrBuf = global "h$stablePtrBuf"++hdMakeStablePtrStr :: FastString+hdMakeStablePtrStr = fsLit "h$makeStablePtr"++------------------------------- Weak Pointers -----------------------------------++hdKeepAlive :: FastString+hdKeepAlive = fsLit "h$keepAlive"++hdFinalizeWeak :: FastString+hdFinalizeWeak = fsLit "h$finalizeWeak"++hdMakeWeakNoFinalizer :: FastString+hdMakeWeakNoFinalizer = fsLit "h$makeWeakNoFinalizer"++hdMakeWeak :: FastString+hdMakeWeak = fsLit "h$makeWeak"++------------------------------- Concurrency Primitives -------------------------++hdGetThreadLabel :: FastString+hdGetThreadLabel = fsLit "h$getThreadLabel"++hdListThreads :: FastString+hdListThreads = fsLit "h$listThreads"++hdThreadStatus :: FastString+hdThreadStatus = fsLit "h$threadStatus"++hdYield :: FastString+hdYield = fsLit "h$yield"++hdKillThread :: FastString+hdKillThread = fsLit "h$killThread"++hdFork :: FastString+hdFork = fsLit "h$fork"++------------------------------- Delay/Wait Ops ---------------------------------++hdWaitWrite :: FastString+hdWaitWrite = fsLit "h$waitWrite"++hdWaitRead :: FastString+hdWaitRead = fsLit "h$waitRead"++hdDelayThread :: FastString+hdDelayThread = fsLit "h$delayThread"++------------------------------- Exceptions --------------------------------------++hdCatchStr :: FastString+hdCatchStr = fsLit "h$catch"++hdMaskAsyncStr :: FastString+hdMaskAsyncStr = fsLit "h$maskAsync"++hdMaskUnintAsyncStr :: FastString+hdMaskUnintAsyncStr = fsLit "h$maskUnintAsync"++hdUnmaskAsyncStr :: FastString+hdUnmaskAsyncStr = fsLit "h$unmaskAsync"++------------------------------- Mutable variables --------------------------------------++hdMutVarStr :: FastString+hdMutVarStr = fsLit "h$MutVar"++hdAtomicModifyMutVar2Str :: FastString+hdAtomicModifyMutVar2Str = fsLit "h$atomicModifyMutVar2"++hdAtomicModifyMutVarStr :: FastString+hdAtomicModifyMutVarStr = fsLit "h$atomicModifyMutVar"++------------------------------- Addr# ------------------------------------------++hdComparePointerStr :: FastString+hdComparePointerStr = fsLit "h$comparePointer"++------------------------------- Byte Arrays -------------------------------------++hdCompareByteArraysStr :: FastString+hdCompareByteArraysStr = fsLit "h$compareByteArrays"++hdResizeMutableByteArrayStr :: FastString+hdResizeMutableByteArrayStr = fsLit "h$resizeMutableByteArray"++hdShrinkMutableByteArrayStr :: FastString+hdShrinkMutableByteArrayStr = fsLit "h$shrinkMutableByteArray"++------------------------------- Arrays ------------------------------------------++hdCopyMutableArrayStr :: FastString+hdCopyMutableArrayStr = fsLit "h$copyMutableArray"++hdNewArrayStr :: FastString+hdNewArrayStr = fsLit "h$newArray"++hdSliceArrayStr :: FastString+hdSliceArrayStr = fsLit "h$sliceArray"++------------------------------ Float --------------------------------------------++hdDecodeFloatIntStr :: FastString+hdDecodeFloatIntStr = fsLit "h$decodeFloatInt"++hdCastFloatToWord32Str :: FastString+hdCastFloatToWord32Str = fsLit "h$castFloatToWord32"++hdCastWord32ToFloatStr :: FastString+hdCastWord32ToFloatStr = fsLit "h$castWord32ToFloat"++------------------------------ Double -------------------------------------------++hdDecodeDouble2IntStr :: FastString+hdDecodeDouble2IntStr = fsLit "h$decodeDouble2Int"++hdDecodeDoubleInt64Str :: FastString+hdDecodeDoubleInt64Str = fsLit "h$decodeDoubleInt64"++hdCastDoubleToWord64Str :: FastString+hdCastDoubleToWord64Str = fsLit "h$castDoubleToWord64"++hdCastWord64ToDoubleStr :: FastString+hdCastWord64ToDoubleStr = fsLit "h$castWord64ToDouble"++------------------------------ Word -------------------------------------------++hdReverseWordStr :: FastString+hdReverseWordStr = fsLit "h$reverseWord"++hdClz8Str+  , hdClz16Str+  , hdClz32Str+  , hdClz64Str+  , hdCtz8Str+  , hdCtz16Str+  , hdCtz32Str+  , hdCtz64Str :: FastString++hdClz8Str  = fsLit "h$clz8"+hdClz16Str = fsLit "h$clz16"+hdClz32Str = fsLit "h$clz32"+hdClz64Str = fsLit "h$clz64"+hdCtz8Str  = fsLit "h$ctz8"+hdCtz16Str = fsLit "h$ctz16"+hdCtz32Str = fsLit "h$ctz32"+hdCtz64Str = fsLit "h$ctz64"++hdBSwap64Str :: FastString+hdBSwap64Str = "h$bswap64"++hdPExit8Str+  , hdPExit16Str+  , hdPExit32Str+  , hdPExit64Str+  , hdPDep8Str+  , hdPDep16Str+  , hdPDep32Str+  , hdPDep64Str :: FastString++hdPExit8Str  = fsLit "h$pext8"+hdPExit16Str = fsLit "h$pext16"+hdPExit32Str = fsLit "h$pext32"+hdPExit64Str = fsLit "h$pext64"+hdPDep8Str   = fsLit "h$pdep8"+hdPDep16Str  = fsLit "h$pdep16"+hdPDep32Str  = fsLit "h$pdep32"+hdPDep64Str  = fsLit "h$pdep64"++hdPopCntTab :: JStgExpr+hdPopCntTab = global "h$popCntTab"++hdPopCnt32Str :: FastString+hdPopCnt32Str = fsLit "h$popCnt32"++hdPopCnt64Str :: FastString+hdPopCnt64Str = fsLit "h$popCnt64"++hdQuotRem2Word32Str :: FastString+hdQuotRem2Word32Str = fsLit "h$quotRem2Word32"++hdQuotRemWord32Str :: FastString+hdQuotRemWord32Str = fsLit "h$quotRemWord32"++hdRemWord32Str :: FastString+hdRemWord32Str = fsLit "h$remWord32"++hdQuotWord32Str :: FastString+hdQuotWord32Str = fsLit "h$quotWord32"++hdMul2Word32Str :: FastString+hdMul2Word32Str = fsLit "h$mul2Word32"++hdMulImulStr :: FastString+hdMulImulStr = fsLit "Math.imul"++hdWordAdd2 :: FastString+hdWordAdd2 = fsLit "h$wordAdd2"++hdHsPlusWord64Str :: FastString+hdHsPlusWord64Str = fsLit "h$hs_plusWord64"++hdHsMinusWord64Str :: FastString+hdHsMinusWord64Str = fsLit "h$hs_minusWord64"++hdHsTimesWord64Str :: FastString+hdHsTimesWord64Str = fsLit "h$hs_timesWord64"++hdHsQuotWord64Str :: FastString+hdHsQuotWord64Str = fsLit "h$hs_quotWord64"++hdHsRemWord64Str :: FastString+hdHsRemWord64Str = fsLit "h$hs_remWord64"++hdHsUncheckedShiftRWord64Str :: FastString+hdHsUncheckedShiftRWord64Str = fsLit "h$hs_uncheckedShiftRWord64"++hdHsUncheckedShiftLWord64Str :: FastString+hdHsUncheckedShiftLWord64Str = fsLit "h$hs_uncheckedShiftLWord64"++hdHsPlusInt64Str :: FastString+hdHsPlusInt64Str = fsLit "h$hs_plusInt64"++hdHsMinusInt64Str :: FastString+hdHsMinusInt64Str = fsLit "h$hs_minusInt64"++hdHsTimesInt64Str :: FastString+hdHsTimesInt64Str = fsLit "h$hs_timesInt64"++hdHsQuotInt64Str :: FastString+hdHsQuotInt64Str = fsLit "h$hs_quotInt64"++hdHsRemInt64Str :: FastString+hdHsRemInt64Str = fsLit "h$hs_remInt64"++hdHsUncheckedShiftLLInt64Str :: FastString+hdHsUncheckedShiftLLInt64Str = fsLit "h$hs_uncheckedShiftLLInt64"++hdHsUncheckedShiftRAInt64Str :: FastString+hdHsUncheckedShiftRAInt64Str = fsLit "h$hs_uncheckedShiftRAInt64"++hdHsUncheckedShiftRLInt64Str :: FastString+hdHsUncheckedShiftRLInt64Str = fsLit "h$hs_uncheckedShiftRLInt64"++hdHsTimesInt2Str :: FastString+hdHsTimesInt2Str = fsLit "h$hs_timesInt2"++------------------------------ Linker -------------------------------------------++hdEncodeModifiedUtf8Str :: FastString+hdEncodeModifiedUtf8Str = fsLit "h$encodeModifiedUtf8"++hdRawStringDataStr :: FastString+hdRawStringDataStr = fsLit "h$rawStringData"++hdPStr :: FastString+hdPStr = fsLit "h$p"++hdDStr :: FastString+hdDStr = fsLit "h$d"++hdDiStr :: FastString+hdDiStr = fsLit "h$di"++hdStcStr :: FastString+hdStcStr = fsLit "h$stc"++hdStlStr :: FastString+hdStlStr = fsLit "h$stl"++hdStiStr :: FastString+hdStiStr = fsLit "h$sti"++hdStrStr :: FastString+hdStrStr = fsLit "h$str"
compiler/GHC/StgToJS/Types.hs view
@@ -28,6 +28,8 @@ import GHC.JS.Make import GHC.JS.Ppr () -- expose Outputable instances to downstream modules +import GHC.StgToJS.Symbols+ import GHC.Stg.Syntax import GHC.Core.TyCon import GHC.Linker.Config@@ -45,10 +47,14 @@  import GHC.Unit.Module +import           Data.Array+import           Data.ByteString (ByteString)+import qualified Data.ByteString       as BS+import qualified Data.ByteString.Char8 as BSC+import           Data.Char (toUpper) import qualified Data.Map as M-import           Data.Set (Set)-import qualified Data.ByteString as BS import           Data.Monoid+import           Data.Set (Set) import           Data.Word  -- | A State monad over IO holding the generator state.@@ -98,9 +104,9 @@   , csLinkerConfig    :: !LinkerConfig -- ^ Emscripten linker   } --- | Information relevenat to code generation for closures.+-- | Closure info table data ClosureInfo = ClosureInfo-  { ciVar     :: Ident      -- ^ object being infod+  { ciVar     :: Ident      -- ^ entry code identifier: infotable fields are stored as properties of this function   , ciRegs    :: CIRegs     -- ^ size of the payload (in number of JS values)   , ciName    :: FastString -- ^ friendly name for printing   , ciLayout  :: CILayout   -- ^ heap/stack layout of the object@@ -278,9 +284,9 @@   toJExpr (IntLit i)            = toJExpr i   toJExpr NullLit               = null_   toJExpr (DoubleLit d)         = toJExpr (unSaneDouble d)-  toJExpr (StringLit t)         = app (mkFastString "h$str") [toJExpr t]-  toJExpr (BinLit b)            = app (mkFastString "h$rstr") [toJExpr (map toInteger (BS.unpack b))]-  toJExpr (LabelLit _isFun lbl) = var lbl+  toJExpr (StringLit t)         = app hdStrStr [toJExpr t]+  toJExpr (BinLit b)            = app hdRawStr [toJExpr (map toInteger (BS.unpack b))]+  toJExpr (LabelLit _isFun lbl) = global lbl  -- | A foreign reference to some JS code data ForeignJSRef = ForeignJSRef@@ -371,7 +377,7 @@   | Con         -- ^ The closure is a Constructor   | Blackhole   -- ^ The closure is a Blackhole   | StackFrame  -- ^ The closure is a stack frame-  deriving (Show, Eq, Ord, Enum, Bounded)+  deriving (Show, Eq, Ord, Enum, Bounded, Ix)  -- | Convert 'ClosureType' to an Int ctNum :: ClosureType -> Int@@ -381,6 +387,20 @@ ctNum Pap        = 3 ctNum Blackhole  = 5 ctNum StackFrame = -1++closureB :: ByteString+closureB = BSC.pack "_CLOSURE"++closureNames :: Array ClosureType Ident+closureNames = listArray (minBound, maxBound) [ name $ mk_names n+                                              | n <- enumFromTo minBound maxBound+                                              ]+  where+    mk_names :: ClosureType -> FastString+    mk_names nm = mkFastStringByteString+                  $  hdB+                  <> BSC.pack (map toUpper (show nm))+                  <> closureB  -- | Convert 'ClosureType' to a String ctJsName :: ClosureType -> String
compiler/GHC/SysTools/Terminal.hs view
@@ -17,16 +17,6 @@  import System.IO.Unsafe -#if defined(mingw32_HOST_OS) && !defined(WINAPI)-# if defined(i386_HOST_ARCH)-#  define WINAPI stdcall-# elif defined(x86_64_HOST_ARCH)-#  define WINAPI ccall-# else-#  error unknown architecture-# endif-#endif- -- | Does the controlling terminal support ANSI color sequences? -- This memoized to avoid thread-safety issues in ncurses (see #17922). stderrSupportsAnsiColors :: Bool@@ -84,10 +74,10 @@ setConsoleMode h mode = do   Win32.failIfFalse_ "SetConsoleMode" (c_SetConsoleMode h mode) -foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode+foreign import ccall unsafe "windows.h GetConsoleMode" c_GetConsoleMode   :: Win32.HANDLE -> Ptr Win32.DWORD -> IO Win32.BOOL -foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode+foreign import ccall unsafe "windows.h SetConsoleMode" c_SetConsoleMode   :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL  #endif
compiler/GHC/Tc/Errors/Ppr.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage {-# LANGUAGE InstanceSigs #-}@@ -35,7 +36,12 @@  import GHC.Prelude -import qualified Language.Haskell.TH as TH+import qualified GHC.Internal.TH.Syntax as TH+-- In stage1: import "ghc-boot-th-next" qualified GHC.Internal.TH.Syntax as TH+-- In stage2: import "ghc-boot-th"      qualified GHC.Internal.TH.Syntax as TH+--            which resolves to+--            import "ghc-internal"     qualified GHC.Internal.TH.Syntax as TH+import qualified GHC.Internal.TH.Ppr as TH  import GHC.Builtin.Names import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon, filterCTuple, pretendNameIsInScope )@@ -55,7 +61,7 @@ import GHC.Core.InstEnv import GHC.Core.TyCo.Rep (Type(..)) import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon,-                          pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType, pprForAll)+                          pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType) import GHC.Core.PatSyn ( patSynName, pprPatSynType ) import GHC.Core.Predicate import GHC.Core.Type@@ -70,15 +76,17 @@ import GHC.Tc.Types.BasicTypes import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin hiding ( Position(..) )+import GHC.Tc.Types.CtLoc import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType +import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module)) import GHC.Types.Error+import GHC.Types.Error.Codes import GHC.Types.Hint import GHC.Types.Hint.Ppr () -- Outputable GhcHint import GHC.Types.Basic-import GHC.Types.Error.Codes import GHC.Types.Id import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name@@ -248,6 +256,10 @@                 hang notAllowed 2 sole_msg           WildcardsNotAllowedAtAll ->             notAllowed+          WildcardBndrInForallTelescope ->+            notAllowed+          WildcardBndrInTyFamResultVar ->+            notAllowed       where         notAllowed, what, wildcard, how :: SDoc         notAllowed = what <+> quotes wildcard <+> how@@ -259,11 +271,19 @@           = text "Named wildcard"           | ExtraConstraintWildcardNotAllowed {} <- bad           = text "Extra-constraint wildcard"+          | WildcardBndrInForallTelescope {} <- bad+          = text "Wildcard binder"+          | WildcardBndrInTyFamResultVar {} <- bad+          = text "Wildcard binder"           | otherwise           = text "Wildcard"         how = case bad of           WildcardNotLastInConstraint             -> text "not allowed in a constraint"+          WildcardBndrInForallTelescope+            -> text "not allowed in a forall telescope"+          WildcardBndrInTyFamResultVar+            -> text "not allowed in a type family result"           _ -> text "not allowed"         constraint_hint_msg :: SDoc         constraint_hint_msg@@ -352,7 +372,7 @@     TcRnRecursivePatternSynonym binds       -> mkSimpleDecorated $             hang (text "Recursive pattern synonym definition with following bindings:")-               2 (vcat $ map pprLBind . bagToList $ binds)+               2 (vcat $ map pprLBind binds)           where             pprLoc loc = parens (text "defined at" <+> ppr loc)             pprLBind :: CollectPass GhcRn => GenLocated (EpAnn a) (HsBindLR GhcRn idR) -> SDoc@@ -545,13 +565,13 @@     TcRnLazyBangOnUnliftedType ty       -> mkSimpleDecorated $            text "Lazy flag has no effect on unlifted type" <+> quotes (ppr ty)-    TcRnMultipleDefaultDeclarations dup_things+    TcRnMultipleDefaultDeclarations cls dup_things       -> mkSimpleDecorated $-           hang (text "Multiple default declarations")+           hang (text "Multiple default declarations for class" <+> quotes (ppr cls))               2 (vcat (map pp dup_things))          where            pp :: LDefaultDecl GhcRn -> SDoc-           pp (L locn (DefaultDecl _ _))+           pp (L locn DefaultDecl {})              = text "here was another default declaration" <+> ppr (locA locn)     TcRnBadDefaultType ty deflt_clss       -> mkSimpleDecorated $@@ -592,6 +612,11 @@        $ formatExportItemError            (ppr export_item)            "attempts to export constructors or class methods that are not visible here"+    TcRnExportHiddenDefault export_item+      -> mkSimpleDecorated+       $ formatExportItemError+           (ppr export_item)+           "attempts to export a default class declaration that is not visible here"     TcRnDuplicateExport gre ie1 ie2       -> mkSimpleDecorated $            hsep [ quotes (ppr $ greName gre)@@ -733,7 +758,7 @@               what = text "type constructor" <+> quotes (ppr (RecSelData tc))               pat_syn_msg                 | any (\case { RecSelPatSyn {} -> True; _ -> False}) pars-                = text "NB: type-directed disambiguation is not supported for pattern synonym record fields."+                = note "Type-directed disambiguation is not supported for pattern synonym record fields"                 | otherwise                 = empty     TcRnStaticFormNotClosed name reason@@ -767,10 +792,11 @@                      , text "Defaulting to the DeriveAnyClass strategy"                        <+> text "for instantiating" <+> ppr cls                      ]-    TcRnNonUnaryTypeclassConstraint ct+    TcRnNonUnaryTypeclassConstraint ctxt ct       -> mkSimpleDecorated $            quotes (ppr ct)-           <+> text "is not a unary constraint, as expected by a deriving clause"+           <+> text "is not a unary constraint, as expected by"+           <+> pprUserTypeCtxt ctxt     TcRnPartialTypeSignatures _ theta       -> mkSimpleDecorated $            text "Found type wildcard" <+> quotes (char '_')@@ -793,9 +819,9 @@       -> mkDecorated            [ text "The" <+> quotes (text "~") <+> text "operator is out of scope." $$              text "Assuming it to stand for an equality constraint."-           , text "NB:" <+> (quotes (text "~") <+> text "used to be built-in syntax but now is a regular type operator" $$-                             text "exported from Data.Type.Equality and Prelude.") $$-             text "If you are using a custom Prelude, consider re-exporting it."+           , note $ quotes "~" <+> "used to be built-in syntax but now is a regular type operator" $$+                      "exported from Data.Type.Equality and Prelude." $$+                      "If you are using a custom Prelude, consider re-exporting it"            , text "This will become an error in a future GHC release." ]     TcRnTypeEqualityRequiresOperators       -> mkSimpleDecorated $@@ -858,7 +884,17 @@                      , text "in the following constraint" <> plural tidy_wanteds ])              2              (pprWithArising tidy_wanteds)-+    TcRnWarnClashingDefaultImports cls Nothing imports+      -> mkSimpleDecorated $+           hang (text "Clashing imported defaults for class" <+> quotes (ppr cls) <> colon)+              2 (vcat $ defaultTypesAndImport <$> NE.toList imports)+    TcRnWarnClashingDefaultImports cls (Just local) imports+      -> mkSimpleDecorated $+           sep [ hang (text "Imported defaults for class" <+> quotes (ppr cls) <> colon)+                    2 (vcat $ defaultTypesAndImport <$> NE.toList imports)+               , hang (text "are not subsumed by the local `default` declaration")+                    2 (parens $ pprWithCommas ppr local)+               ]      TcRnForeignImportPrimExtNotSet _decl       -> mkSimpleDecorated $@@ -955,13 +991,18 @@     TcRnIllegalDerivingItem hs_ty       -> mkSimpleDecorated $            text "Illegal deriving item" <+> quotes (ppr hs_ty)+    TcRnIllegalDefaultClass hs_ty+      -> mkSimpleDecorated $+           quotes (ppr hs_ty) <+> text "is not a class"+    TcRnIllegalNamedDefault hs_decl+      -> mkSimpleDecorated $ text "Illegal use of default class name:" <+> quotes (ppr hs_decl)     TcRnUnexpectedAnnotation ty bang       -> mkSimpleDecorated $            let err = case bang of-                 HsSrcBang _ SrcUnpack _           -> "UNPACK"-                 HsSrcBang _ SrcNoUnpack _         -> "NOUNPACK"-                 HsSrcBang _ NoSrcUnpack SrcLazy   -> "laziness"-                 HsSrcBang _ _ _                   -> "strictness"+                 HsBang SrcUnpack   _       -> "UNPACK"+                 HsBang SrcNoUnpack _       -> "NOUNPACK"+                 HsBang NoSrcUnpack SrcLazy -> "laziness"+                 HsBang _           _       -> "strictness"             in text "Unexpected" <+> text err <+> text "annotation:" <+> ppr ty $$                text err <+> text "annotation cannot appear nested inside a type"     TcRnIllegalRecordSyntax either_ty_ty@@ -1086,6 +1127,16 @@             , ppr pwarn_ctorig             , pprWarningTxtForMsg pragma_warning_msg          ]+    TcRnPragmaWarning+      { pragma_warning_info = PragmaWarningDefault{pwarn_class, pwarn_impmod}+      , pragma_warning_msg }+      -> mkSimpleDecorated $+        sep [ sep [ text "In the use of class"+                    <+> ppr pwarn_class+                    <+> text "defaults imported from"+                    <+> ppr pwarn_impmod <> colon ]+            , pprWarningTxtForMsg pragma_warning_msg+         ]     TcRnPragmaWarning {pragma_warning_info, pragma_warning_msg}       -> mkSimpleDecorated $         sep [ sep [ text "In the use of"@@ -1196,6 +1247,9 @@           -- Is the data con a "covert" GADT?  See Note [isCovertGadtDataCon]           -- in GHC.Core.DataCon           sneaky_eq_spec = isCovertGadtDataCon con+    TcRnOrPatBindsVariables bndrs -> mkSimpleDecorated $+      text "An or-pattern may not bind term or type variables such as"+        <+> quotedListWithOr (map ppr (NE.toList bndrs))     TcRnUnsatisfiedMinimalDef mindef       -> mkSimpleDecorated $         vcat [text "No explicit implementation for"@@ -1259,10 +1313,10 @@     TcRnIllformedTypeArgument e       -> mkSimpleDecorated $           hang (text "Ill-formed type argument:") 2 (ppr e)-    TcRnIllegalTypeExpr-      -> mkSimpleDecorated $-          text "Illegal type expression." $$-          text "A type expression must be used to instantiate a visible forall."+    TcRnIllegalTypeExpr syntax -> mkSimpleDecorated $+      vcat [ text "Illegal" <+> pprTypeSyntaxName syntax+           , text "Type syntax may only be used in a required type argument,"+           , text "i.e. to instantiate a visible forall." ]      TcRnCapturedTermName tv_name shadowed_term_names       -> mkSimpleDecorated $@@ -1299,27 +1353,24 @@       text "Orphan COMPLETE pragmas not supported" $$       text "A COMPLETE pragma must mention at least one data constructor" $$       text "or pattern synonym defined in the same module."-    TcRnEmptyCase ctxt reason -> mkSimpleDecorated $-      case reason of-        EmptyCaseWithoutFlag ->-          text "Empty list of alternatives in" <+> pp_ctxt-        EmptyCaseDisallowedCtxt ->-          text "Empty list of alternatives is not allowed in" <+> pp_ctxt-        EmptyCaseForall tvb ->-          vcat [ text "Empty list of alternatives in" <+> pp_ctxt-               , hang (text "checked against a forall-type:")-                      2 (pprForAll [tvb] <+> text "...")-               ]-        where-          pp_ctxt = case ctxt of-            CaseAlt                                -> text "case expression"-            LamAlt LamCase                         -> text "\\case expression"-            LamAlt LamCases                        -> text "\\cases expression"-            ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction"-            ArrowMatchCtxt (ArrowLamAlt LamCase)   -> text "\\case command"-            ArrowMatchCtxt (ArrowLamAlt LamCases)  -> text "\\cases command"-            ArrowMatchCtxt ArrowCaseAlt            -> text "case command"-            ctxt                                   -> text "(unexpected)" <+> pprMatchContextNoun ctxt+    TcRnEmptyCase ctxt -> mkSimpleDecorated message+      where+        pp_ctxt = case ctxt of+          CaseAlt                                -> text "case expression"+          LamAlt LamCase                         -> text "\\case expression"+          ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction"+          ArrowMatchCtxt (ArrowLamAlt LamCase)   -> text "\\case command"+          ArrowMatchCtxt ArrowCaseAlt            -> text "case command"+          _                                      -> text "(unexpected)"+                                                    <+> pprMatchContextNoun ctxt++        message = case ctxt of+          LamAlt LamCases -> lcases_msg <+> text "expression"+          ArrowMatchCtxt (ArrowLamAlt LamCases) -> lcases_msg <+> text "command"+          _ -> text "Empty list of alternatives in" <+> pp_ctxt++        lcases_msg =+          text "Empty list of alternatives is not allowed in \\cases"     TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $       text "accepting non-standard pattern guards" $$       nest 4 (interpp'SP guards)@@ -1411,9 +1462,16 @@            , interpp'SP errorVars ]     TcRnBadlyStaged reason bind_lvl use_lvl       -> mkSimpleDecorated $-         text "Stage error:" <+> pprStageCheckReason reason <+>-         hsep [text "is bound at stage" <+> ppr bind_lvl,-               text "but used at stage" <+> ppr use_lvl]+         vcat $+         [ text "Stage error:" <+> pprStageCheckReason reason <+>+           hsep [text "is bound at stage" <+> ppr bind_lvl,+                 text "but used at stage" <+> ppr use_lvl]+         ] +++         [ hsep [ text "Hint: quoting" <+> thBrackets (ppUnless (isValName n) "t") (ppr n)+                , text "or an enclosing expression would allow the quotation to be used in an earlier stage"+                ]+         | StageCheckSplice n <- [reason]+         ]     TcRnBadlyStagedType name bind_lvl use_lvl       -> mkSimpleDecorated $          text "Badly staged type:" <+> ppr name <+>@@ -1488,8 +1546,9 @@       text "You may define an abstract closed type family" $$       text "only in a .hs-boot file"     TcRnPartialFieldSelector fld -> mkSimpleDecorated $-      sep [text "Use of partial record field selector" <> colon,-           nest 2 $ quotes (ppr (occName fld))]+      vcat [ sep [ text "Definition of partial record field" <> colon+                 , nest 2 $ quotes (ppr (occName fld)) ]+           , text "Record selection and update using this field will be partial." ]     TcRnHasFieldResolvedIncomplete name -> mkSimpleDecorated $       text "The invocation of `getField` on the record field" <+> quotes (ppr name)       <+> text "may produce an error since it is not defined for all data constructors"@@ -1542,16 +1601,15 @@           | null inferred_tvs && null specified_tvs           = empty           | null inferred_tvs-          = hang (text "NB: Specified variables")-               2 (sep [pp_spec, text "always come first"])+          = note $ "Specified variables" <+> pp_spec <+> "always come first"           | null specified_tvs-          = hang (text "NB: Inferred variables")-               2 (sep [pp_inf, text "always come first"])+          = note inf_always_first           | otherwise-          = hang (text "NB: Inferred variables")-               2 (vcat [ sep [ pp_inf, text "always come first"]-                       , sep [text "then Specified variables", pp_spec]])+          = note $ inf_always_first $$+              "then specified variables" <+> pp_spec +        inf_always_first = "Inferred variables" <+> pp_inf $$ "always come first"+         pp_inf  = parens (text "namely:" <+> pprTyVars inferred_tvs)         pp_spec = parens (text "namely:" <+> pprTyVars specified_tvs)     TcRnTyFamResultDisabled tc_name tvb -> mkSimpleDecorated $@@ -1696,13 +1754,6 @@           (extra, msg) = case txt of             WarningTxt _ _ msg -> ("", msg)             DeprecatedTxt _ msg -> (" is deprecated", msg)-    TcRnCompatUnqualifiedImport decl-      -> mkSimpleDecorated $-         vcat-         [ text "To ensure compatibility with future core libraries changes"-         , text "imports to" <+> ppr (ideclName decl) <+> text "should be"-         , text "either qualified or have an explicit import list."-         ]     TcRnRedundantSourceImport mod_name       -> mkSimpleDecorated $          text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name)@@ -1855,6 +1906,10 @@       mkSimpleDecorated $         hang (text "Illegal invisible type variable binder:")            2 (ppr bndr)+    TcRnIllegalWildcardTyVarBndr bndr ->+      mkSimpleDecorated $+        hang (text "Illegal wildcard binder:")+           2 (ppr bndr)      TcRnInvalidInvisTyVarBndr name hs_bndr ->       mkSimpleDecorated $@@ -1862,9 +1917,9 @@                   2 (ppr hs_bndr)              , text "There is no matching forall-bound variable"              , text "in the standalone kind signature for" <+> quotes (ppr name) <> dot-             , text "NB." <+> vcat [-                text "Only" <+> quotes (text "forall a.") <+> text "-quantification matches invisible binders,",-                text "whereas" <+> quotes (text "forall {a}.") <+> text "and" <+> quotes (text "forall a ->") <+> text "do not."+             , note $ vcat [+                "Only" <+> quotes "forall a." <+> "-quantification matches invisible binders,",+                "whereas" <+> quotes "forall {a}." <+> "and" <+> quotes "forall a ->" <+> "do not"              ]]      TcRnDeprecatedInvisTyArgInConPat ->@@ -1940,6 +1995,9 @@     TcRnMisplacedInvisPat tp -> mkSimpleDecorated $       text "Invisible type pattern" <+> ppr tp <+> text "is not allowed here" +    TcRnUnexpectedTypeSyntaxInTerms syntax -> mkSimpleDecorated $+      text "Unexpected" <+> pprTypeSyntaxName syntax+   diagnosticReason :: TcRnMessage -> DiagnosticReason   diagnosticReason = \case     TcRnUnknownMessage m@@ -2111,6 +2169,8 @@       -> WarningWithFlag Opt_WarnMissingExportList     TcRnExportHiddenComponents{}       -> ErrorWithoutFlag+    TcRnExportHiddenDefault{}+      -> ErrorWithoutFlag     TcRnDuplicateExport{}       -> WarningWithFlag Opt_WarnDuplicateExports     TcRnExportedParentChildMismatch{}@@ -2200,6 +2260,8 @@       -> ErrorWithoutFlag     TcRnWarnDefaulting {}       -> WarningWithFlag Opt_WarnTypeDefaults+    TcRnWarnClashingDefaultImports {}+      -> WarningWithFlag Opt_WarnTypeDefaults     TcRnForeignImportPrimExtNotSet{}       -> ErrorWithoutFlag     TcRnForeignImportPrimSafeAnn{}@@ -2226,6 +2288,10 @@       -> ErrorWithoutFlag     TcRnIllegalDerivingItem{}       -> ErrorWithoutFlag+    TcRnIllegalDefaultClass{}+      -> ErrorWithoutFlag+    TcRnIllegalNamedDefault{}+      -> ErrorWithoutFlag     TcRnUnexpectedAnnotation{}       -> ErrorWithoutFlag     TcRnIllegalRecordSyntax{}@@ -2296,6 +2362,8 @@       -> ErrorWithoutFlag     TcRnIllegalNewtype{}       -> ErrorWithoutFlag+    TcRnOrPatBindsVariables{}+      -> ErrorWithoutFlag     TcRnUnsatisfiedMinimalDef{}       -> WarningWithFlag (Opt_WarnMissingMethods)     TcRnMisplacedInstSig{}@@ -2485,8 +2553,6 @@       -> ErrorWithoutFlag     TcRnDeprecatedModule _ txt       -> WarningWithCategory (warningTxtCategory txt)-    TcRnCompatUnqualifiedImport{}-      -> WarningWithFlag Opt_WarnCompatUnqualifiedImports     TcRnRedundantSourceImport{}       -> WarningWithoutFlag     TcRnImportLookup{}@@ -2546,6 +2612,8 @@       -> WarningWithFlag Opt_WarnMissingRoleAnnotations     TcRnIllegalInvisTyVarBndr{}       -> ErrorWithoutFlag+    TcRnIllegalWildcardTyVarBndr{}+      -> ErrorWithoutFlag     TcRnDeprecatedInvisTyArgInConPat {}       -> WarningWithFlag Opt_WarnDeprecatedTypeAbstractions     TcRnInvalidInvisTyVarBndr{}@@ -2578,6 +2646,8 @@       -> ErrorWithoutFlag     TcRnMisplacedInvisPat{}       -> ErrorWithoutFlag+    TcRnUnexpectedTypeSyntaxInTerms{}+      -> ErrorWithoutFlag    diagnosticHints = \case     TcRnUnknownMessage m@@ -2778,6 +2848,8 @@       -> noHints     TcRnExportHiddenComponents{}       -> noHints+    TcRnExportHiddenDefault{}+      -> noHints     TcRnDuplicateExport{}       -> noHints     TcRnExportedParentChildMismatch{}@@ -2848,6 +2920,8 @@       -> noHints     TcRnWarnDefaulting {}       -> noHints+    TcRnWarnClashingDefaultImports cls local imports+      -> suggestDefaultDeclaration cls (fold local) (cd_types <$> NE.toList imports)     TcRnForeignImportPrimExtNotSet{}       -> [suggestExtension LangExt.GHCForeignImportPrim]     TcRnForeignImportPrimSafeAnn{}@@ -2881,6 +2955,10 @@       -> noHints     TcRnIllegalDerivingItem{}       -> noHints+    TcRnIllegalDefaultClass{}+      -> noHints+    TcRnIllegalNamedDefault{}+      -> [suggestExtension LangExt.NamedDefaults]     TcRnUnexpectedAnnotation{}       -> noHints     TcRnIllegalRecordSyntax{}@@ -2954,6 +3032,8 @@       -> noHints     TcRnIllegalNewtype{}       -> noHints+    TcRnOrPatBindsVariables{}+      -> noHints     TcRnUnsatisfiedMinimalDef{}       -> noHints     TcRnMisplacedInstSig{}@@ -2991,11 +3071,10 @@       -> noHints     TcRnOrphanCompletePragma{}       -> noHints-    TcRnEmptyCase _ reason ->-      case reason of-        EmptyCaseWithoutFlag{}    -> [suggestExtension LangExt.EmptyCase]-        EmptyCaseDisallowedCtxt{} -> noHints-        EmptyCaseForall{}         -> noHints+    TcRnEmptyCase ctxt -> case ctxt of+      LamAlt LamCases -> noHints -- cases syntax doesn't support empty case.+      ArrowMatchCtxt (ArrowLamAlt LamCases) -> noHints+      _ -> [suggestExtension LangExt.EmptyCase]     TcRnNonStdGuards{}       -> [suggestExtension LangExt.PatternGuards]     TcRnDuplicateSigDecl{}@@ -3023,9 +3102,13 @@       _ -> [suggestExtension LangExt.DerivingStrategies]     TcRnIllegalMultipleDerivClauses{}       -> [suggestExtension LangExt.DerivingStrategies]-    TcRnNoDerivStratSpecified isDSEnabled -> if isDSEnabled-      then noHints-      else [suggestExtension LangExt.DerivingStrategies]+    TcRnNoDerivStratSpecified is_ds_enabled info -> do+      let explicit_strategy_hint = case info of+            TcRnNoDerivingClauseStrategySpecified assumed_derivings ->+              SuggestExplicitDerivingClauseStrategies assumed_derivings+            TcRnNoStandaloneDerivingStrategySpecified assumed_strategy deriv_sig ->+              SuggestExplicitStandaloneDerivingStrategy assumed_strategy deriv_sig+      explicit_strategy_hint : [suggestExtension LangExt.DerivingStrategies | not is_ds_enabled]     TcRnStupidThetaInGadt{}       -> noHints     TcRnShadowedTyVarNameInFamResult{}@@ -3150,8 +3233,6 @@       -> [SuggestSafeHaskell]     TcRnDeprecatedModule{}       -> noHints-    TcRnCompatUnqualifiedImport{}-      -> noHints     TcRnRedundantSourceImport{}       -> noHints     TcRnImportLookup (ImportLookupBad k _ is ie patsyns_enabled) ->@@ -3219,6 +3300,8 @@       -> noHints     TcRnIllegalInvisTyVarBndr{}       -> [suggestExtension LangExt.TypeAbstractions]+    TcRnIllegalWildcardTyVarBndr{}+      -> [suggestExtension LangExt.TypeAbstractions]     TcRnDeprecatedInvisTyArgInConPat{}       -> [suggestExtension LangExt.TypeAbstractions]     TcRnInvalidInvisTyVarBndr{}@@ -3251,9 +3334,15 @@       -> noHints     TcRnMisplacedInvisPat{}       -> noHints+    TcRnUnexpectedTypeSyntaxInTerms syntax+      -> [suggestExtension (typeSyntaxExtension syntax)]    diagnosticCode = constructorCode ++note :: SDoc -> SDoc+note note = "Note" <> colon <+> note <> dot+ -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", -- and so on.  The `and` stands for any `conjunction`, which is passed in. commafyWith :: SDoc -> [SDoc] -> [SDoc]@@ -3397,7 +3486,7 @@ format_frr_err ty   = (bullet <+> ppr tidy_ty <+> dcolon <+> ppr tidy_ki)   where-    (tidy_env, tidy_ty) = tidyOpenType emptyTidyEnv ty+    (tidy_env, tidy_ty) = tidyOpenTypeX emptyTidyEnv ty     tidy_ki             = tidyType tidy_env (typeKind ty)  pprField :: (FieldLabelString, TcType) -> SDoc@@ -4278,7 +4367,7 @@           _ -> Nothing -- Must be TupleRep [r1..rn]       | otherwise = Nothing -    starts_with_vowel (c:_) = c `elem` "AEIOU"+    starts_with_vowel (c:_) = c `elem` ("AEIOU" :: String)     starts_with_vowel []    = False  pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra)@@ -4589,13 +4678,10 @@  pprCoercibleMsg :: CoercibleMsg -> SDoc pprCoercibleMsg (UnknownRoles ty) =-  hang (text "NB: We cannot know what roles the parameters to" <+>-          quotes (ppr ty) <+> text "have;")-       2 (text "we must assume that the role is nominal")+  note $ "We cannot know what roles the parameters to" <+> quotes (ppr ty) <+> "have;" $$+           "we must assume that the role is nominal" pprCoercibleMsg (TyConIsAbstract tc) =-  hsep [ text "NB: The type constructor"-       , quotes (pprSourceTyCon tc)-       , text "is abstract" ]+  note $ "The type constructor" <+> quotes (pprSourceTyCon tc) <+> "is abstract" pprCoercibleMsg (OutOfScopeNewtypeConstructor tc dc) =   hang (text "The data constructor" <+> quotes (ppr $ dataConName dc))     2 (sep [ text "of newtype" <+> quotes (pprSourceTyCon tc)@@ -4657,12 +4743,11 @@       = text "The" <+> what <+> text "variable" <> plural tkvs         <+> pprQuotedList tkvs <+> isOrAre tkvs <+> text "ambiguous" pprAmbiguityInfo (NonInjectiveTyFam tc) =-  text "NB:" <+> quotes (ppr tc)-  <+> text "is a non-injective type family"+  note $ quotes (ppr tc) <+> text "is a non-injective type family"  pprSameOccInfo :: SameOccInfo -> SDoc pprSameOccInfo (SameOcc same_pkg n1 n2) =-  text "NB:" <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)+  note (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)   where     ppr_from same_pkg nm       | isGoodSrcSpan loc@@ -4938,25 +5023,14 @@ **********************************************************************-}  instance Outputable ImportError where-  ppr (MissingModule mod_name) =-    hsep-      [ text "NB: no module named"-      , quotes (ppr mod_name)-      , text "is imported."-      ]-  ppr  (ModulesDoNotExport mods occ_name)-    | mod NE.:| [] <- mods-    = hsep-        [ text "NB: the module"-        , quotes (ppr mod)-        , text "does not export"-        , quotes (ppr occ_name) <> dot ]-    | otherwise-    = hsep-        [ text "NB: neither"-        , quotedListWithNor (map ppr $ NE.toList mods)-        , text "export"-        , quotes (ppr occ_name) <> dot ]+  ppr err = note $ case err of+      MissingModule mod_name -> "No module named" <+> quoted mod_name <+> "is imported"+      ModulesDoNotExport mods occ_name+        | mod NE.:| [] <- mods -> "The module" <+> quoted mod <+> "does not export" <+> quoted occ_name+        | otherwise -> "Neither" <+> quotedListWithNor (map ppr $ NE.toList mods) <+> "export" <+> quoted occ_name+    where+      quoted :: Outputable a => a -> SDoc+      quoted = quotes . ppr  {- ********************************************************************* *                                                                      *@@ -5845,6 +5919,22 @@     doc_monad =       "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" +suggestDefaultDeclaration :: TyCon -> [Type] -> [[Type]] -> [GhcHint]+suggestDefaultDeclaration cls prefix seqs =+  [SuggestDefaultDeclaration cls $ supersequence (prefix : seqs)]+  where+    -- Not exactly the shortest possible supersequence, but it preserves+    -- the head sequence as the prefix of the result which is a requirement.+    supersequence :: [[Type]] -> [Type]+    supersequence [] = []+    supersequence ([] : seqs) = supersequence seqs+    supersequence ((x : xs) : seqs) =+      x : supersequence (xs : (dropHead x <$> seqs))+    dropHead x ys@(y : ys')+      | tcEqType x y = ys'+      | otherwise = ys+    dropHead _ [] = []+ -------------------------------------------------------------------------------- -- hs-boot mismatch errors @@ -5918,8 +6008,7 @@     else       text "The roles do not match." $$       if boot_or_sig == HsBoot-      then text "NB: roles on abstract types default to" <+>-           quotes (text "representational") <+> text "in hs-boot files."+      then note $ "Roles on abstract types default to" <+> quotes "representational" <+> "in hs-boot files"       else empty   TyConSynonymMismatch {} -> empty -- nothing interesting to say   TyConFlavourMismatch fam_flav1 fam_flav2 ->@@ -6795,7 +6884,7 @@ thSyntaxErrorHints :: THSyntaxError -> [GhcHint] thSyntaxErrorHints = \case   IllegalTHQuotes{}-    -> [suggestAnyExtension [LangExt.TemplateHaskell, LangExt.TemplateHaskellQuotes]]+    -> [suggestExtension LangExt.TemplateHaskellQuotes]   BadImplicitSplice {}     -> noHints -- NB: don't suggest TemplateHaskell                -- see comments on BadImplicitSplice in pprTHSyntaxError@@ -6875,7 +6964,13 @@   hang (text "Illegal nested use of type family" <+> quotes (ppr tc))     2 (text "in the arguments of the type-family application" <+> quotes (ppr rhs)) +-------------------------------------------------------------------------------- +defaultTypesAndImport :: ClassDefaults -> SDoc+defaultTypesAndImport ClassDefaults{cd_types, cd_module = Just cdm} =+  hang (parens $ pprWithCommas ppr cd_types)+     2 (text "imported from" <+> ppr cdm)+defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types)  -------------------------------------------------------------------------------- @@ -6895,3 +6990,9 @@   ZonkerCannotDefaultConcrete {} -> ErrorWithoutFlag  --------------------------------------------------------------------------------++pprTypeSyntaxName :: TypeSyntax -> SDoc+pprTypeSyntaxName TypeKeywordSyntax     = "keyword" <+> quotes "type"+pprTypeSyntaxName ForallTelescopeSyntax = "forall telescope"+pprTypeSyntaxName ContextArrowSyntax    = "context arrow (=>)"+pprTypeSyntaxName FunctionArrowSyntax   = "function type arrow (->)"
compiler/GHC/Tc/Errors/Types.hs view
@@ -53,6 +53,7 @@   , Exported(..)   , HsDocContext(..)   , FixedRuntimeRepErrorInfo(..)+  , TcRnNoDerivStratSpecifiedInfo(..)    , ErrorItem(..), errorItemOrigin, errorItemEqRel, errorItemPred, errorItemCtLoc @@ -103,7 +104,6 @@   , DisabledClassExtension(..)   , TyFamsDisabledReason(..)   , TypeApplication(..)-  , BadEmptyCaseReason(..)   , HsTypeOrSigType(..)   , HsTyVarBndrExistentialFlag(..)   , TySynCycleTyCons@@ -117,6 +117,8 @@   , NonCanonicalDefinition(..)   , NonCanonical_Monoid(..)   , NonCanonical_Monad(..)+  , TypeSyntax(..)+  , typeSyntaxExtension      -- * Errors for hs-boot and signature files   , BadBootDecls(..)@@ -168,6 +170,7 @@ import GHC.Prelude  import GHC.Hs+ import GHC.Tc.Errors.Types.PromotionErr import GHC.Tc.Errors.Hole.FitTypes (HoleFit) import GHC.Tc.Types.Constraint@@ -175,26 +178,36 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol)                            , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing                            , FixedRuntimeRepOrigin(..), InstanceWhat )+import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin, SubGoalDepth ) import GHC.Tc.Types.Rank (Rank)+import GHC.Tc.Types.TH+import GHC.Tc.Types.BasicTypes import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType,                             PatersonCondFailure, PatersonCondFailureContext)+ import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Avail-import GHC.Types.Hint (UntickedPromotedThing(..))+import GHC.Types.Hint (UntickedPromotedThing(..), AssumedDerivingStrategy(..)) import GHC.Types.ForeignCall (CLabelString) import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name (NamedThing(..), Name, OccName, getSrcLoc, getSrcSpan) import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader+import GHC.Types.Name.Env (NameEnv) import GHC.Types.SourceFile (HsBootOrSig(..)) import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar, Specificity) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet)+import GHC.Types.DefaultEnv (ClassDefaults)+ import GHC.Unit.Types (Module)-import GHC.Utils.Outputable+import GHC.Unit.State (UnitState)+import GHC.Unit.Module.Warnings (WarningCategory, WarningTxt)+import GHC.Unit.Module.ModIface (ModIface)+ import GHC.Core.Class (Class, ClassMinimalDef, ClassOpItem, ClassATItem) import GHC.Core.Coercion (Coercion) import GHC.Core.Coercion.Axiom (CoAxBranch)@@ -205,11 +218,12 @@ import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate (EqRel, predTypeEqRel) import GHC.Core.TyCon (TyCon, Role, FamTyConFlav, AlgTyConRhs)-import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag, ForAllTyBinder)-+import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag) import GHC.Driver.Backend (Backend)-import GHC.Unit.State (UnitState)++import GHC.Utils.Outputable import GHC.Utils.Misc (filterOut)+ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) import GHC.Data.Pair@@ -219,15 +233,11 @@  import qualified Data.List.NonEmpty as NE import           Data.Typeable (Typeable)-import GHC.Unit.Module.Warnings (WarningCategory, WarningTxt)-import qualified Language.Haskell.TH.Syntax as TH+import qualified GHC.Internal.TH.Syntax as TH+import Data.Map.Strict (Map)  import GHC.Generics ( Generic )-import GHC.Types.Name.Env (NameEnv) import GHC.Iface.Errors.Types-import GHC.Unit.Module.ModIface (ModIface)-import GHC.Tc.Types.TH-import GHC.Tc.Types.BasicTypes   @@ -1452,16 +1462,29 @@   TcRnLazyBangOnUnliftedType :: !Type -> TcRnMessage    {-| TcRnMultipleDefaultDeclarations is an error that occurs when a module has-      more than one default declaration.+      more than one default declaration for the same class.        Example:-      default (Integer, Int)+      default (Integer, Int)  -- implicitly applies to Num       default (Double, Float) -- 2nd default declaration not allowed       Text cases: module/mod58   -}-  TcRnMultipleDefaultDeclarations :: [LDefaultDecl GhcRn] -> TcRnMessage+  TcRnMultipleDefaultDeclarations :: TyCon -> [LDefaultDecl GhcRn] -> TcRnMessage +  {-| TcRnWarnClashingDefaultImports is a warning that occurs when a module imports+      more than one default declaration for the same class, and they are not all+      subsumed by one of them nor by a local `default` declaration.++      See Note [Named default declarations] in GHC.Tc.Gen.Default++     Test cases: default/Import07.hs+  -}+  TcRnWarnClashingDefaultImports :: TyCon -- ^ class+                                 -> Maybe [Type] -- ^ locally declared defaults+                                 -> NE.NonEmpty ClassDefaults -- ^ imported defaults+                                 -> TcRnMessage+   {-| TcRnBadDefaultType is an error that occurs when a type used in a default       declaration does not have an instance for any of the applicable classes. @@ -1471,7 +1494,7 @@       Test cases: typecheck/should_fail/T11974b   -}-  TcRnBadDefaultType :: Type -> [Class] -> TcRnMessage+  TcRnBadDefaultType :: Type -> [TyCon] -> TcRnMessage    {-| TcRnPatSynBundledWithNonDataCon is an error that occurs when a module's       export list bundles a pattern synonym with a type that is not a proper@@ -1555,6 +1578,15 @@   -}   TcRnExportHiddenComponents :: IE GhcPs -> TcRnMessage +  {-| TcRnExportHiddenDefault is an error that occurs when an export contains+      a class default (with language extension NamedDefaults) that is not visible.++      Example(s): None++     Test cases: default/fail06.hs+  -}+  TcRnExportHiddenDefault :: IE GhcPs -> TcRnMessage+   {-| TcRnDuplicateExport is a warning (controlled by -Wduplicate-exports) that occurs       when an identifier appears in an export list more than once. @@ -1800,7 +1832,7 @@                  deriving/should_fail/drvfail009                  deriving/should_fail/drvfail006   -}-  TcRnNonUnaryTypeclassConstraint :: !(LHsSigType GhcRn) -> TcRnMessage+  TcRnNonUnaryTypeclassConstraint :: !UserTypeCtxt -> !(LHsSigType GhcRn) -> TcRnMessage    {-| TcRnPartialTypeSignatures is a warning (controlled by -Wpartial-type-signatures)       that occurs when a wildcard '_' is found in place of a type in a signature or a@@ -2198,6 +2230,26 @@   -}   TcRnIllegalDerivingItem :: !(LHsSigType GhcRn) -> TcRnMessage +  {-| TcRnIllegalDefaultClass is an error for when something other than a type class+     appears in a default declaration after the keyword.++     Example(s):+     default Integer (Int)++    Test cases: default/fail01+  -}+  TcRnIllegalDefaultClass :: !(LHsSigType GhcRn) -> TcRnMessage++  {-| TcRnIllegalNamedDefault is an error for specifying an explicit default class name+     without @-XNamedDefaults@.++     Example(s):+     default Num (Integer)++    Test cases: default/fail02+  -}+  TcRnIllegalNamedDefault :: !(LDefaultDecl GhcRn) -> TcRnMessage+   {-| TcRnUnexpectedAnnotation indicates the erroroneous use of an annotation such      as strictness, laziness, or unpacking. @@ -2209,7 +2261,7 @@                 typecheck/should_fail/T7210                 rename/should_fail/T22478b   -}-  TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsSrcBang -> TcRnMessage+  TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsBang -> TcRnMessage    {-| TcRnIllegalRecordSyntax is an error indicating an illegal use of record syntax. @@ -2767,7 +2819,17 @@   -}   TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage -  {-| TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance+  {-| TcRnOrPatBindsVariables is an error that happens when an+     or-pattern binds term or type variables, e.g. (A @x; B y).++     Test case:+     testsuite/tests/typecheck/should_fail/Or3+  -}+  TcRnOrPatBindsVariables+    :: NE.NonEmpty (IdP GhcRn) -- ^ List of binders+    -> TcRnMessage++  {- | TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance        is missing methods that are required by the minimal definition.         Example:@@ -3007,27 +3069,13 @@       a case expression with an empty list of alternatives without       enabling the EmptyCase extension. -     Example for EmptyCaseWithoutFlag:--       {-# LANGUAGE NoEmptyCase #-}-       f :: Void -> a-       f = \case {}    -- extension not enabled--     Example for EmptyCaseDisallowedCtxt:--       f = \cases {}   -- multi-case requires n>0 alternatives--     Example for EmptyCaseForall:+     Example(s): -       f :: forall (xs :: Type) -> ()-       f = \case {}    -- can't match on a type argument+       case () of       Test cases: rename/should_fail/RnEmptyCaseFail-                 typecheck/should_fail/T25004   -}-  TcRnEmptyCase :: !HsMatchContextRn-                -> !BadEmptyCaseReason-                -> TcRnMessage+  TcRnEmptyCase :: HsMatchContextRn -> TcRnMessage    {-| TcRnNonStdGuards is a warning thrown when a user uses       non-standard guards (e.g. patterns in guards) without@@ -3127,6 +3175,21 @@     :: !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)     -> TcRnMessage +  {-| 'TcRnIllegalWildcardTyVarBndr' is an error that occurs+      when a wildcard binder is used in a type declaration+      without enabling the @TypeAbstractions@ extension.++      Example:+        {-# LANGUAGE NoTypeAbstractions #-}         -- extension disabled+        type Const a _ = a+                     ^++      Test case: T23501_fail_ext+  -}+  TcRnIllegalWildcardTyVarBndr+    :: !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)+    -> TcRnMessage+   {-| 'TcRnInvalidInvisTyVarBndr' is an error that occurs       when an invisible type variable binder has no corresponding       @forall k.@ quantifier in the standalone kind signature.@@ -3271,20 +3334,22 @@   -}   TcRnIllegalMultipleDerivClauses :: TcRnMessage -  {-| TcRnNoDerivStratSpecified is a warning implied by -Wmissing-deriving-strategies-      and triggered by deriving clause without specified deriving strategy.--      Example:+  {-| TcRnNoDerivStratSpecified is a warning implied by+      -Wmissing-deriving-strategies and triggered by deriving without+      mentioning a strategy. -        data T = T-          deriving Eq+      See 'TcRnNoDerivStratSpecifiedInfo' cases for examples. -      Test cases: rename/should_compile/T15798a-                  rename/should_compile/T15798b-                  rename/should_compile/T15798c+      Test cases: deriving/should_compile/T15798a+                  deriving/should_compile/T15798b+                  deriving/should_compile/T15798c+                  deriving/should_compile/T24955a+                  deriving/should_compile/T24955b+                  deriving/should_compile/T24955c   -}   TcRnNoDerivStratSpecified-    :: Bool -- True if DerivingStrategies is enabled+    :: Bool -- ^ True if DerivingStrategies is enabled+    -> TcRnNoDerivStratSpecifiedInfo     -> TcRnMessage    {-| TcRnStupidThetaInGadt is an error triggered by data contexts in GADT-style@@ -3505,7 +3570,7 @@   -}   TcRnAbstractClosedTyFamDecl :: TcRnMessage -  {-| TcRnPartialFieldSelector is a warning indicating that a record selector+  {-| TcRnPartialFieldSelector is a warning indicating that a record field     was not defined for all constructors of a data type.      Test cases:@@ -3835,16 +3900,6 @@                        -> !(WarningTxt GhcRn) -- ^ The pragma data                        -> TcRnMessage -  {-| TcRnCompatUnqualifiedImport is a warning indicating that a special-    module (right now only Data.List) was imported unqualified without-    import list, for compatibility reasons.--    Test cases:-      T17244A-  -}-  TcRnCompatUnqualifiedImport :: !(ImportDecl GhcPs) -- ^ The import-                              -> TcRnMessage-   {-| TcRnRedundantSourceImport is a warning indicating that a {-# SOURCE #-}     import was used when there is no import cycle. @@ -4191,20 +4246,28 @@   -}   TcRnIllformedTypeArgument :: !(LHsExpr GhcRn) -> TcRnMessage -  {-| TcRnIllegalTypeExpr is an error raised when an expression constructed-      with the @type@ keyword occurs in a position that does not correspond-      to a required type argument (visible forall).+  {- TcRnIllegalTypeExpr is an error raised when an expression constructed with+     type syntax (@type@, @->@, @=>@, @forall@) occurs in a position that+     doesn't correspond to required type argument (visible forall). -      Example:+     Examples: -        xtop = type Int                  -- not a function argument-        xarg = length (type Int)         -- `length` does not expect a required type argument+        -- Not a function argument:+        xtop1 = type Int+        xtop2 = (Int -> Int)+        xtop3 = (forall a. a)+        xtop4 = ((Show Int, Eq Bool) => Unit) -      Test cases:+        -- The function does not expect a type argument:+        xarg1 = length (type Int)+        xarg2 = show (Int -> Int)++     Test cases:         T22326_fail_app         T22326_fail_top+        T24159_type_syntax_tc_fail   -}-  TcRnIllegalTypeExpr :: TcRnMessage+  TcRnIllegalTypeExpr :: TypeSyntax -> TcRnMessage    {-| TcRnInvalidDefaultedTyVar is an error raised when a       defaulting plugin proposes to default a type variable that is@@ -4316,10 +4379,22 @@           $(invisP (varT (newName "blah"))) <- aciton1           ... -     Test cases:+     Test cases: T24557a T24557b T24557c T24557d    -}   TcRnMisplacedInvisPat :: HsTyPat GhcPs -> TcRnMessage++  {- TcRnUnexpectedTypeSyntaxInTerms is an error that occurs+     when type syntax is used in terms without -XRequiredTypeArguments+     extension enabled++     Examples:++       idVis (forall a. forall b -> (a ~ Int, b ~ Bool) => a -> b)++    Test cases: T24159_type_syntax_rn_fail+  -}+  TcRnUnexpectedTypeSyntaxInTerms :: TypeSyntax -> TcRnMessage   deriving Generic  ----@@ -4664,6 +4739,10 @@       SoleExtraConstraintWildcardAllowed   | WildcardsNotAllowedAtAll +  -- See Note [Wildcard binders in disallowed contexts] in GHC.Hs.Type+  | WildcardBndrInForallTelescope+  | WildcardBndrInTyFamResultVar+ -- | Whether a sole extra-constraint wildcard is allowed, -- e.g. @_ => ..@ as opposed to @( .., _ ) => ..@. data SoleExtraConstraintWildcardAllowed@@ -5937,6 +6016,8 @@                         , pwarn_impmod :: ModuleName }   | PragmaWarningInstance { pwarn_dfunid :: DFunId                           , pwarn_ctorig :: CtOrigin }+  | PragmaWarningDefault { pwarn_class :: TyCon+                         , pwarn_impmod :: ModuleName }   -- | The context for an "empty statement group" error.@@ -6099,12 +6180,6 @@   | TypeApplicationInPattern !(HsConPatTyArg GhcPs)   deriving Generic --- | Why was the empty case rejected?-data BadEmptyCaseReason-  = EmptyCaseWithoutFlag-  | EmptyCaseDisallowedCtxt-  | EmptyCaseForall ForAllTyBinder- -- | Either `HsType p` or `HsSigType p`. -- -- Used for reporting errors in `TcRnIllegalKind`.@@ -6752,3 +6827,63 @@   | NotSimpleUnliftedType   | NotBoxedKindAny   deriving Generic++data TcRnNoDerivStratSpecifiedInfo where+  {-| 'TcRnNoDerivStratSpecified TcRnNoDerivingClauseStrategySpecified' is+       a warning implied by -Wmissing-deriving-strategies and triggered by a+       deriving clause without a specified deriving strategy.++      Example:++        newtype T = T Int+          deriving (Eq, Ord, Show)++      Here we would suggest fixing the deriving clause to:++        deriving stock (Show)+        deriving newtype (Eq, Ord)++      Test cases: deriving/should_compile/T15798a+                  deriving/should_compile/T15798c+                  deriving/should_compile/T24955a+                  deriving/should_compile/T24955b+   -}+  TcRnNoDerivingClauseStrategySpecified+    :: Map AssumedDerivingStrategy [LHsSigType GhcRn]+    -> TcRnNoDerivStratSpecifiedInfo++  {-| 'TcRnNoDerivStratSpecified TcRnNoStandaloneDerivingStrategySpecified' is+       a warning implied by -Wmissing-deriving-strategies and triggered by a+       standalone deriving declaration without a specified deriving strategy.++      Example:++        data T a = T a+        deriving instance Show a => Show (T a)++      Here we would suggest fixing the instance to:++        deriving stock instance Show a => Show (T a)++      Test cases: deriving/should_compile/T15798b+                  deriving/should_compile/T24955c+   -}+  TcRnNoStandaloneDerivingStrategySpecified+    :: AssumedDerivingStrategy+    -> LHsSigWcType GhcRn -- ^ The instance signature (e.g @Show a => Show (T a)@)+    -> TcRnNoDerivStratSpecifiedInfo++-- | Label for syntax that may occur in terms (expressions) only as part of a+--   required type argument.+data TypeSyntax+  = TypeKeywordSyntax      -- ^ @type t@+  | ContextArrowSyntax     -- ^ @ctx => t@+  | FunctionArrowSyntax    -- ^ @t1 -> t2@+  | ForallTelescopeSyntax  -- ^ @forall tvs. t@+  deriving Generic++typeSyntaxExtension :: TypeSyntax -> LangExt.Extension+typeSyntaxExtension TypeKeywordSyntax     = LangExt.ExplicitNamespaces+typeSyntaxExtension ContextArrowSyntax    = LangExt.RequiredTypeArguments+typeSyntaxExtension FunctionArrowSyntax   = LangExt.RequiredTypeArguments+typeSyntaxExtension ForallTelescopeSyntax = LangExt.RequiredTypeArguments
compiler/GHC/Tc/Solver/InertSet.hs view
@@ -56,6 +56,7 @@  import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin+import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin, ctLocSpan, ctLocLevel ) import GHC.Tc.Solver.Types import GHC.Tc.Utils.TcType @@ -133,10 +134,17 @@   E.g. a CIrredCan can be a hetero-kinded (t1 ~ t2), which may become   homo-kinded when kicked out, and hence we want to prioritise it. -Among the equalities we prioritise ones with an empty rewriter set;-see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, wrinkle (W1).+Further refinements: +* Among the equalities we prioritise ones with an empty rewriter set;+  see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, wrinkle (W1). +* Among equalities with an empty rewriter set, we prioritise nominal equalities.+   * They have more rewriting power, so doing them first is better.+   * Prioritising them ameliorates the incompleteness of newtype+     solving: see (Ex2) in Note [Decomposing newtype equalities] in+     GHC.Tc.Solver.Equality.+ Note [Prioritise class equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prioritise equalities in the solver (see selectWorkItem). But class@@ -168,12 +176,14 @@  -- See Note [WorkList priorities] data WorkList-  = WL { wl_eqs     :: [Ct]  -- CEqCan, CDictCan, CIrredCan-                             -- Given and Wanted-                       -- Contains both equality constraints and their-                       -- class-level variants (a~b) and (a~~b);-                       -- See Note [Prioritise equalities]-                       -- See Note [Prioritise class equalities]+  = WL { wl_eqs_N :: [Ct]  -- /Nominal/ equalities (s ~#N t), (s ~ t), (s ~~ t)+                           -- with empty rewriter set+       , wl_eqs_X :: [Ct]  -- CEqCan, CDictCan, CIrredCan+                           -- with empty rewriter set+           -- All other equalities: contains both equality constraints and+           -- their class-level variants (a~b) and (a~~b);+           -- See Note [Prioritise equalities]+           -- See Note [Prioritise class equalities]         , wl_rw_eqs  :: [Ct]  -- Like wl_eqs, but ones that have a non-empty                              -- rewriter set; or, more precisely, did when@@ -182,49 +192,70 @@          -- see Note [Prioritise Wanteds with empty RewriterSet]          -- in GHC.Tc.Types.Constraint for more details. -       , wl_rest    :: [Ct]+       , wl_rest :: [Ct]         , wl_implics :: Bag Implication  -- See Note [Residual implications]     }  appendWorkList :: WorkList -> WorkList -> WorkList appendWorkList-    (WL { wl_eqs = eqs1, wl_rw_eqs = rw_eqs1+    (WL { wl_eqs_N = eqs1_N, wl_eqs_X = eqs1_X, wl_rw_eqs = rw_eqs1         , wl_rest = rest1, wl_implics = implics1 })-    (WL { wl_eqs = eqs2, wl_rw_eqs = rw_eqs2+    (WL { wl_eqs_N = eqs2_N, wl_eqs_X = eqs2_X, wl_rw_eqs = rw_eqs2         , wl_rest = rest2, wl_implics = implics2 })-   = WL { wl_eqs     = eqs1     ++ eqs2+   = WL { wl_eqs_N   = eqs1_N   ++ eqs2_N+        , wl_eqs_X   = eqs1_X   ++ eqs2_X         , wl_rw_eqs  = rw_eqs1  ++ rw_eqs2         , wl_rest    = rest1    ++ rest2         , wl_implics = implics1 `unionBags`   implics2 }  workListSize :: WorkList -> Int-workListSize (WL { wl_eqs = eqs, wl_rw_eqs = rw_eqs, wl_rest = rest })-  = length eqs + length rw_eqs + length rest+workListSize (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs, wl_rest = rest })+  = length eqs_N + length eqs_X + length rw_eqs + length rest  extendWorkListEq :: RewriterSet -> Ct -> WorkList -> WorkList-extendWorkListEq rewriters ct wl+extendWorkListEq rewriters ct+    wl@(WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs })   | isEmptyRewriterSet rewriters      -- A wanted that has not been rewritten     -- isEmptyRewriterSet: see Note [Prioritise Wanteds with empty RewriterSet]     --                         in GHC.Tc.Types.Constraint-  = wl { wl_eqs = ct : wl_eqs wl }+  = if isNomEqPred (ctPred ct)+    then wl { wl_eqs_N = ct : eqs_N }+    else wl { wl_eqs_X = ct : eqs_X }+   | otherwise-  = wl { wl_rw_eqs = ct : wl_rw_eqs wl }+  = wl { wl_rw_eqs = ct : rw_eqs }  extendWorkListEqs :: RewriterSet -> Bag Ct -> WorkList -> WorkList -- Add [eq1,...,eqn] to the work-list -- They all have the same rewriter set -- The constraints will be solved in left-to-right order:---   see Note [Work-list ordering] in GHC.Tc.Solved.Equality-extendWorkListEqs rewriters eqs wl+--   see Note [Work-list ordering] in GHC.Tc.Solver.Equality+--+-- Precondition: new_eqs is non-empty+extendWorkListEqs rewriters new_eqs+    wl@(WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs })   | isEmptyRewriterSet rewriters     -- isEmptyRewriterSet: see Note [Prioritise Wanteds with empty RewriterSet]     --                         in GHC.Tc.Types.Constraint-  = wl { wl_eqs = foldr (:) (wl_eqs wl) eqs }-         -- The foldr just appends wl_eqs to the bag of eqs+  = case partitionBag is_nominal new_eqs of+       (new_eqs_N, new_eqs_X)+          | isEmptyBag new_eqs_N -> wl { wl_eqs_X = new_eqs_X `push_on_front` eqs_X }+          | isEmptyBag new_eqs_X -> wl { wl_eqs_N = new_eqs_N `push_on_front` eqs_N }+          | otherwise            -> wl { wl_eqs_N = new_eqs_N `push_on_front` eqs_N+                                       , wl_eqs_X = new_eqs_X `push_on_front` eqs_X }+          -- These isEmptyBag tests are just trying+          -- to avoid creating unnecessary thunks+   | otherwise-  = wl { wl_rw_eqs = foldr (:) (wl_rw_eqs wl) eqs }+  = wl { wl_rw_eqs = new_eqs `push_on_front` rw_eqs }+  where+    push_on_front :: Bag Ct -> [Ct] -> [Ct]+    -- push_on_front puts the new equlities on the front of the queue+    push_on_front new_eqs eqs = foldr (:) eqs new_eqs +    is_nominal ct = isNomEqPred (ctPred ct)+ extendWorkListNonEq :: Ct -> WorkList -> WorkList -- Extension by non equality extendWorkListNonEq ct wl = wl { wl_rest = ct : wl_rest wl }@@ -255,26 +286,33 @@ extendWorkListCts cts wl = foldr extendWorkListCt wl cts  isEmptyWorkList :: WorkList -> Bool-isEmptyWorkList (WL { wl_eqs = eqs, wl_rest = rest, wl_implics = implics })-  = null eqs && null rest && isEmptyBag implics+isEmptyWorkList (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X+                    , wl_rest = rest, wl_implics = implics })+  = null eqs_N && null eqs_X && null rest && isEmptyBag implics  emptyWorkList :: WorkList-emptyWorkList = WL { wl_eqs  = [], wl_rw_eqs = [], wl_rest = [], wl_implics = emptyBag }+emptyWorkList = WL { wl_eqs_N = [], wl_eqs_X = []+                   , wl_rw_eqs = [], wl_rest = [], wl_implics = emptyBag }  selectWorkItem :: WorkList -> Maybe (Ct, WorkList) -- See Note [Prioritise equalities]-selectWorkItem wl@(WL { wl_eqs = eqs, wl_rw_eqs = rw_eqs, wl_rest = rest })-  | ct:cts <- eqs    = Just (ct, wl { wl_eqs    = cts })+selectWorkItem wl@(WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X+                      , wl_rw_eqs = rw_eqs, wl_rest = rest })+  | ct:cts <- eqs_N  = Just (ct, wl { wl_eqs_N  = cts })+  | ct:cts <- eqs_X  = Just (ct, wl { wl_eqs_X  = cts })   | ct:cts <- rw_eqs = Just (ct, wl { wl_rw_eqs = cts })   | ct:cts <- rest   = Just (ct, wl { wl_rest   = cts })   | otherwise        = Nothing  -- Pretty printing instance Outputable WorkList where-  ppr (WL { wl_eqs = eqs, wl_rw_eqs = rw_eqs, wl_rest = rest, wl_implics = implics })+  ppr (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs+          , wl_rest = rest, wl_implics = implics })    = text "WL" <+> (braces $-     vcat [ ppUnless (null eqs) $-            text "Eqs =" <+> vcat (map ppr eqs)+     vcat [ ppUnless (null eqs_N) $+            text "Eqs_N =" <+> vcat (map ppr eqs_N)+          , ppUnless (null eqs_X) $+            text "Eqs_X =" <+> vcat (map ppr eqs_X)           , ppUnless (null rw_eqs) $             text "RwEqs =" <+> vcat (map ppr rw_eqs)           , ppUnless (null rest) $@@ -610,11 +648,16 @@ Exactly which constraints should trigger (UNTOUCHABLE), and hence should update inert_given_eq_lvl? -* We do /not/ need to worry about let-bound skolems, such ast+(TGE1) We do /not/ need to worry about let-bound skolems, such as      forall[2] a. a ~ [b] => blah-  See Note [Let-bound skolems]+  See Note [Let-bound skolems] and the isOuterTyVar tests in `updGivenEqs` -* Consider an implication+(TGE2) However, solely to support better error messages (see Note [HasGivenEqs] in+   GHC.Tc.Types.Constraint) we also track these "local" equalities in the+   boolean inert_given_eqs field.  This field is used only subsequntly (see+   `getHasGivenEqs`), to set the ic_given_eqs field to LocalGivenEqs.++(TGE3) Consider an implication       forall[2]. beta[1] => alpha[1] ~ Int   where beta is a unification variable that has already been unified   to () in an outer scope.  Then alpha[1] is perfectly touchable and@@ -622,65 +665,67 @@   an equality, we should canonicalise first, rather than just looking at   the /original/ givens (#8644). - * However, we must take account of *potential* equalities. Consider the+(TGE4) However, we must take account of *potential* equalities. Consider the    same example again, but this time we have /not/ yet unified beta:       forall[2] beta[1] => ...blah...     Because beta might turn into an equality, updGivenEqs conservatively    treats it as a potential equality, and updates inert_give_eq_lvl - * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z?--   That Given cannot affect the Wanted, because the Given is entirely-   *local*: it mentions only skolems bound in the very same-   implication. Such equalities need not make alpha untouchable. (Test-   case typecheck/should_compile/LocalGivenEqs has a real-life-   motivating example, with some detailed commentary.)-   Hence the 'mentionsOuterVar' test in updGivenEqs.--   However, solely to support better error messages-   (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track-   these "local" equalities in the boolean inert_given_eqs field.-   This field is used only to set the ic_given_eqs field to LocalGivenEqs;-   see the function getHasGivenEqs.--   Here is a simpler case that triggers this behaviour:--     data T where-       MkT :: F a ~ G b => a -> b -> T--     f (MkT _ _) = True--   Because of this behaviour around local equality givens, we can infer the-   type of f. This is typecheck/should_compile/LocalGivenEqs2.-- * We need not look at the equality relation involved (nominal vs+(TGE5) We should not look at the equality relation involved (nominal vs    representational), because representational equalities can still    imply nominal ones. For example, if (G a ~R G b) and G's argument's    role is nominal, then we can deduce a ~N b. +Historical note: prior to #24938 we also ignored Given equalities that+did not mention an "outer" type variable.  But that is wrong, as #24938+showed. Another example is immortalised in test LocalGivenEqs2+   data T where+      MkT :: F a ~ G b => a -> b -> T+   f (MkT _ _) = True+We should not infer the type for `f`; let-bound-skolems does not apply.+ Note [Let-bound skolems] ~~~~~~~~~~~~~~~~~~~~~~~~ If   * the inert set contains a canonical Given CEqCan (a ~ ty) and  * 'a' is a skolem bound in this very implication,  then:-a) The Given is pretty much a let-binding, like-      f :: (a ~ b->c) => a -> a-   Here the equality constraint is like saying-      let a = b->c in ...-   It is not adding any new, local equality  information,-   and hence can be ignored by has_given_eqs+   a) The Given is pretty much a let-binding, like+         f :: (a ~ b->c) => a -> a+      Here the equality constraint is like saying+         let a = b->c in ...+      It is not adding any new, local equality  information,+      and hence can be ignored by has_given_eqs -b) 'a' will have been completely substituted out in the inert set,-   so we can safely discard it.+   b) 'a' will have been completely substituted out in the inert set,+      so we can safely discard it.  For an example, see #9211. -See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure-that the right variable is on the left of the equality when both are-tyvars.+The actual test is in `isLetBoundSkolemCt` +Wrinkles:++(LBS1) See GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure+       that the correct variable is on the left of the equality when both are+       tyvars.++(LBS2) We also want this to work for+            forall a. [G] F b ~ a   (CEqCt with TyFamLHS)+   Here the Given will have a TyFamLHS, with the skolem-bound tyvar on the RHS.+   See tests T24938a, and LocalGivenEqs.++(LBS3) Happily (LBS2) also makes cycle-breakers work. Suppose we have+            forall a. [G] (F a) Int ~ a+  where F has arity 1, and `a` is the locally-bound skolem.  Then, as+  Note [Type equality cycles] explains, we split into+           [G] F a ~ cbv, [G] cbv Int ~ a+  where `cbv` is the cycle breaker variable.  But cbv has the same level+  as `a`, so `isOuterTyVar` (called in `isLetBoundSkolemCt`) will return False.++  This actually matters occasionally: see test LocalGivenEqs.+ You might wonder whether the skolem really needs to be bound "in the very same implication" as the equality constraint. Consider this (c.f. #15009):@@ -704,6 +749,18 @@ Now, unify alpha := a.  Now we are stuck with an unsolved alpha~Int! So we must treat alpha as untouchable under the forall[2] implication. +Possible future improvements.  The current test just looks to see whether one+side of an equality is a locally-bound skolem.  But actually we could, in+theory, do better: if one side (or both sides, actually) of an equality+ineluctably mentions a local skolem, then the equality cannot possibly impact+types outside of the implication (because doing to would cause those types to be+ill-scoped). The problem is the "ineluctably": this means that no expansion,+other solving, etc., could possibly get rid of the variable. This is hard,+perhaps impossible, to know for sure, especially when we think about type family+interactions. (And it's a user-visible property so we don't want it to be hard+to predict.) So we keep the existing check, looking for one lone variable,+because we're sure that variable isn't going anywhere.+ Note [Detailed InertCans Invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The InertCans represents a collection of constraints with the following properties:@@ -729,7 +786,11 @@  Note [inert_eqs: the inert equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Definition [Can-rewrite relation]+Our main invariant:+   the EqCts in inert_eqs should be a+        terminating generalised substitution++-------------- Definition [Can-rewrite relation] -------------- A "can-rewrite" relation between flavours, written f1 >= f2, is a binary relation with the following properties @@ -741,47 +802,70 @@ Lemma (L0). If f1 >= f then f1 >= f1 Proof.      By property (R2), with f1=f2 -Definition [Generalised substitution]+--------- Definition [Generalised substitution] --------------- A "generalised substitution" S is a set of triples (lhs -f-> t), where-  lhs is a type variable or an exactly-saturated type family application-    (that is, lhs is a CanEqLHS)-  t is a type-  f is a flavour+  - lhs is a type variable or an exactly-saturated type family application+                  (that is, lhs is a CanEqLHS)+  - t is a type+  - f is a flavour+ such that+   (WF1) if (lhs1 -f1-> t1) in S            (lhs2 -f2-> t2) in S         then (f1 >= f2) implies that lhs1 does not appear within lhs2+   (WF2) if (lhs -f-> t) is in S, then t /= lhs -Definition [Applying a generalised substitution]-If S is a generalised substitution-   S(f,t0) = t,  if (t0 -fs-> t) in S, and fs >= f-           = apply S to components of t0, otherwise-See also Note [Flavours with roles].+  (WF3) No LHS in S is rewritable in an RHS in S,+        in the argument of a type family application (F ty1..tyn)+        where F heads a LHS in S -Theorem: S(f,t0) is well defined as a function.-Proof: Suppose (lhs -f1-> t1) and (lhs -f2-> t2) are both in S,-               and  f1 >= f and f2 >= f-       Then by (R2) f1 >= f2 or f2 >= f1, which contradicts (WF1)+--------- Definition [Applying a generalised substitution] ----------+If S is a generalised substitution+   S(f,lhs)      = rhs,             if (lhs -fs-> rhs) in S, and fs >= f+   S(f,T t1..tn) = T S(f1,t1)..S(fn,tn)+   S(f,t1 t2)    = S(f,t1) S(f_N,t2)+   S(f,t)        = t+Here f1..fn are obtained from f and T using the roles of T, and f_N is+the nominal version of f.  See Note [Flavours with roles].  Notation: repeated application.   S^0(f,t)     = t   S^(n+1)(f,t) = S(f, S^n(t))+  S*(f,t) is the result of applying S until you reach a fixpoint -Definition: terminating generalised substitution+---------  Definition [Terminating generalised substitution] --------- A generalised substitution S is *terminating* iff -  (IG1) there is an n such that-        for every f,t, S^n(f,t) = S^(n+1)(f,t)+  (IG1) for every f,t, there is an n such that+             S^n(f,t) = S^(n+1)(f,t)  By (IG1) we define S*(f,t) to be the result of exahaustively applying S(f,_) to t.+--------- End of definitions ------------------------------------ -------------------------------------------------------------------------------Our main invariant:-   the EqCts in inert_eqs should be a terminating generalised substitution------------------------------------------------------------------------------ +Rationale for (WF1)-(WF3)+-------------------------+* (WF1) guarantees that S is well-defined /as a function/;+  see Theorem (S is a function)++   Theorem (S is a function): S(f,t0) is well defined as a function.+   Proof: Suppose (lhs -f1-> t1) and (lhs -f2-> t2) are both in S,+               and  f1 >= f and f2 >= f+          Then by (R2) f1 >= f2 or f2 >= f1, which contradicts (WF1)+   Note: this argument isn't quite right.  WF1 ensures that lhs1 does+   not appear inside lhs2, and that guarantees confluence. But I can't quite+   see how to make that argument precise.++* (WF2) is a bit trivial.  It means that if S is terminating, so that+  S^(n+1)(f,t) = S^n(f,t), then there is no LHS of S in S^n(f,t).  We+  never get a silly infinite sequence a -> a -> a -> a  .... which is+  technically a fixed point but would still go on for ever.++* (WF3) is need for the termination proof.+ Note that termination is not the same as idempotence.  To apply S to a type, you may have to apply it recursively.  But termination does guarantee that this recursive use will terminate.@@ -801,12 +885,7 @@  Note [Rewritable] ~~~~~~~~~~~~~~~~~-This Note defines what it means for a type variable or type family application-(that is, a CanEqLHS) to be rewritable in a type. This definition is used-by the anyRewritableXXX family of functions and is meant to model the actual-behaviour in GHC.Tc.Solver.Rewrite.--Ignoring roles (for now): A CanEqLHS lhs is *rewritable* in a type t if the+Definition. A CanEqLHS lhs is *rewritable* in a type t if the lhs tree appears as a subtree within t without traversing any of the following components of t:   * coercions (whether they appear in casts CastTy or as arguments CoercionTy)@@ -814,294 +893,308 @@ The check for rewritability *does* look in kinds of the bound variable of a ForAllTy. -Goal: If lhs is not rewritable in t, then t is a fixpoint of the generalised-substitution containing only {lhs -f*-> t'}, where f* is a flavour such that f* >= f-for all f.- The reason for this definition is that the rewriter does not rewrite in coercions or variables' kinds. In turn, the rewriter does not need to rewrite there because those places are never used for controlling the behaviour of the solver: these places are not used in matching instances or in decomposing equalities. -There is one exception to the claim that non-rewritable parts of the tree do-not affect the solver: we sometimes do an occurs-check to decide e.g. how to-orient an equality. (See the comments on-GHC.Tc.Solver.Equality.canEqTyVarFunEq.) Accordingly, the presence of a-variable in a kind or coercion just might influence the solver. Here is an-example:+This definition is used by the anyRewritableXXX family of functions and is meant+to model the actual behaviour in GHC.Tc.Solver.Rewrite. -  type family Const x y where-    Const x y = x+Goal: If lhs is not rewritable in t, then t is a fixpoint of the generalised+substitution containing only {lhs -f*-> t'}, where f* is a flavour such that f* >= f+for all f. -  AxConst :: forall x y. Const x y ~# x+Wrinkles -  alpha :: Const Type Nat-  [W] alpha ~ Int |> (sym (AxConst Type alpha) ;;-                      AxConst Type alpha ;;-                      sym (AxConst Type Nat))+* Taking roles into account: we must consider a rewrite at a given role. That is,+  a rewrite arises from some equality, and that equality has a role associated+  with it. As we traverse a type, we track what role we are allowed to rewrite with. -The cast is clearly ludicrous (it ties together a cast and its symmetric version),-but we can't quite rule it out. (See (EQ1) from-Note [Respecting definitional equality] in GHC.Core.TyCo.Rep to see why we need-the Const Type Nat bit.) And yet this cast will (quite rightly) prevent alpha-from unifying with the RHS. I (Richard E) don't have an example of where this-problem can arise from a Haskell program, but we don't have an air-tight argument-for why the definition of *rewritable* given here is correct.+  For example, suppose we have an inert [G] b ~R# Int. Then b is rewritable in+  Maybe b but not in F b, where F is a type function. This role-aware logic is+  present in both the anyRewritableXXX functions and in the rewriter.+  See also Note [anyRewritableTyVar must be role-aware] in GHC.Tc.Utils.TcType. -Taking roles into account: we must consider a rewrite at a given role. That is,-a rewrite arises from some equality, and that equality has a role associated-with it. As we traverse a type, we track what role we are allowed to rewrite with.+* There is one exception to the claim that non-rewritable parts of the tree do+  not affect the solver: we sometimes do an occurs-check to decide e.g. how to+  orient an equality. (See the comments on GHC.Tc.Solver.Equality.canEqTyVarFunEq.)+  Accordingly, the presence of a variable in a kind or coercion just might+  influence the solver. Here is an example: -For example, suppose we have an inert [G] b ~R# Int. Then b is rewritable in-Maybe b but not in F b, where F is a type function. This role-aware logic is-present in both the anyRewritableXXX functions and in the rewriter.-See also Note [anyRewritableTyVar must be role-aware] in GHC.Tc.Utils.TcType.+    type family Const x y where+      Const x y = x +    AxConst :: forall x y. Const x y ~# x++    alpha :: Const Type Nat+    [W] alpha ~ Int |> (sym (AxConst Type alpha) ;;+                        AxConst Type alpha ;;+                        sym (AxConst Type Nat))++  The cast is clearly ludicrous (it ties together a cast and its symmetric+  version), but we can't quite rule it out. (See (EQ1) from Note [Respecting+  definitional equality] in GHC.Core.TyCo.Rep to see why we need the Const Type+  Nat bit.) And yet this cast will (quite rightly) prevent alpha from unifying+  with the RHS. I (Richard E) don't have an example of where this problem can+  arise from a Haskell program, but we don't have an air-tight argument for why+  the definition of *rewritable* given here is correct.+ Note [Extending the inert equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Main Theorem [Stability under extension]-   Suppose we have a "work item"-       lhs -fw-> t-   and a terminating generalised substitution S,-   THEN the extended substitution T = S+(lhs -fw-> t)-        is a terminating generalised substitution-   PROVIDED-      (T1) S(fw,lhs) = lhs   -- LHS of work-item is a fixpoint of S(fw,_)-      (T2) S(fw,t)   = t     -- RHS of work-item is a fixpoint of S(fw,_)-      (T3) lhs not in t      -- No occurs check in the work item-          -- If lhs is a type family application, we require only that-          -- lhs is not *rewritable* in t. See Note [Rewritable] and-          -- Note [EqCt occurs check] in GHC.Tc.Types.Constraint.+   GIVEN a "work item" [lhs_w -fw-> rhs_w]+         and a terminating generalised substitution S, -      AND, for every (lhs1 -fs-> s) in S:-           (K0) not (fw >= fs)-                Reason: suppose we kick out (lhs1 -fs-> s),-                        and add (lhs -fw-> t) to the inert set.-                        The latter can't rewrite the former,-                        so the kick-out achieved nothing+   SUCH THAT+      (T1) S(fw,lhs_w) = lhs_w   -- LHS of work-item is a fixpoint of S(fw,_)+      (T2) S(fw,rhs_w) = rhs_w   -- RHS of work-item is a fixpoint of S(fw,_)+      (T3) lhs_w not in rhs_w    -- No occurs check in the work item+             -- If lhs is a type family application, we require only that+             -- lhs is not *rewritable* in rhs_w. See Note [Rewritable] and+             -- Note [EqCt occurs check] in GHC.Tc.Types.Constraint.+      (T4) no [lhs_s -fs-> rhs_s] in S meets [The KickOut Criteria]+           (i.e. we already kicked any such items out!) -              -- From here, we can assume fw >= fs-           OR (K4) lhs1 is a tyvar AND fs >= fw+   THEN the extended substitution T = S+(lhs_w -fw-> rhs_w)+        is a terminating generalised substitution -           OR { (K1) lhs is not rewritable in lhs1. See Note [Rewritable].-                     Reason: if fw >= fs, WF1 says we can't have both-                             lhs0 -fw-> t  and  F lhs0 -fs-> s+How do we establish these conditions? -                AND (K2): guarantees termination of the new substitution-                    {  (K2a) not (fs >= fs)-                    OR (K2b) lhs not in s }+  * (T1) and (T2) are guaranteed by exhaustively rewriting the work-item+    with S(fw,_). -                AND (K3) See Note [K3: completeness of solving]-                    { (K3a) If the role of fs is nominal: s /= lhs-                      (K3b) If the role of fs is representational:-                            s is not of form (lhs t1 .. tn) } }+  * (T3) is guaranteed by an occurs-check on the work item.+    This is done during canonicalisation, in checkTypeEq; invariant+    (TyEq:OC) of CEqCan. See also Note [EqCt occurs check] in GHC.Tc.Types.Constraint. +  * (T4) is established by GHC.Tc.Solver.Monad.kickOutRewritable.  If the inert+    set contains a triple that meets the KickOut Criteria, we kick it out and+    add it to the work list for later re-examination.  See+    Note [The KickOut Criteria] -Conditions (T1-T3) are established by the canonicaliser-Conditions (K1-K3) are established by GHC.Tc.Solver.Monad.kickOutRewritable+Theorem: T (defined in "THEN" above) is a generalised substitution;+  that is, it satisfies (WF1)-(WF3)+Proof:+  (WF1) Suppose we are adding [lhs_w -fw-> rhs_w], and [lhs_s -fs-> rhs_s] is in S.+        Then:+          - by (T1)  if fs>=fw, lhs_s does not occur within lhs_w.+          - by (KK1) if fw>=fs, lhs_w is not rewritable in lhs_s, or we'd have+            kicked out the stable constraint. -The idea is that-* T1 and T2 are guaranteed by exhaustively rewriting the work-item-  with S(fw,_).+  (WF2) is directly guaranteed by (T3) -* T3 is guaranteed by an occurs-check on the work item.-  This is done during canonicalisation, in checkTypeEq; invariant-  (TyEq:OC) of CEqCan. See also Note [EqCt occurs check] in GHC.Tc.Types.Constraint.+  (WF3) No lhs_s in S is rewritable in rhs_w at all, because of (T2)+        And (KK2) guarantees that lhs_w is not rewritable under a type+        family in rhs_s -* (K1-3) are the "kick-out" criteria.  (As stated, they are really the-  "keep" criteria.) If the current inert S contains a triple that does-  not satisfy (K1-3), then we remove it from S by "kicking it out",-  and re-processing it.+Note [The KickOut Criteria]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Kicking out is a Bad Thing:+* It means we have to re-process a constraint.  The less we kick out, the better.+* In the limit, kicking can lead to non-termination: imagine that we /always/+  kick out the entire inert set!+* Because (mid 2024) we don't support sharing in constraints, excessive kicking out+  can lead to exponentially big constraints (#24984). -* Note that kicking out is a Bad Thing, because it means we have to-  re-process a constraint.  The less we kick out, the better.-  TODO: Make sure that kicking out really *is* a Bad Thing. We've assumed-  this but haven't done the empirical study to check.+So we seek to do as little kicking out as possible.  For example, consider this,+which happens a lot: -* Assume we have  G>=G, G>=W and that's all.  Then, when performing-  a unification we add a new given  a -G-> ty.  But doing so does NOT require-  us to kick out an inert wanted that mentions a, because of (K2a).  This-  is a common case, hence good not to kick out. See also (K2a) below.+   Inert:  g1: a ~ Maybe b+   Work:   g2: b ~ Int -* Lemma (L1): The conditions of the Main Theorem imply that there is no-              (lhs -fs-> t) in S, s.t.  (fs >= fw).-  Proof. Suppose the contrary (fs >= fw).  Then because of (T1),-  S(fw,lhs)=lhs.  But since fs>=fw, S(fw,lhs) = t, hence t=lhs.  But now we-  have (lhs -fs-> lhs) in S, which contradicts (WF2).+We do /not/ kick out g1 when adding g2.  The new substitution S' = {g1,g2} is still+/terminating/ but it is not /idmempotent/.  To apply S' to, say, (Tree a), we may+need to apply it twice:  Tree a --> Tree (Maybe b) --> Tree (Maybe Int) -* The extended substitution satisfies (WF1) and (WF2)-  - (K1) plus (L1) guarantee that the extended substitution satisfies (WF1).-  - (T3) guarantees (WF2).+Here are the KickOut Criteria: -* (K2) and (K4) are about termination.  Intuitively, any infinite chain S^0(f,t),-  S^1(f,t), S^2(f,t).... must pass through the new work item infinitely-  often, since the substitution without the work item is terminating; and must-  pass through at least one of the triples in S infinitely often.+    When adding [lhs_w -fw-> rhs_w] to a well-formed terminating substitution S,+    element [lhs_s -fs-> rhs_s] in S meets the KickOut Criteria if: -  - (K2a): if not(fs>=fs) then there is no f that fs can rewrite (fs>=f)-    (this is Lemma (L0)), and hence this triple never plays a role in application S(f,t).-    It is always safe to extend S with such a triple.+    (KK0) fw >= fs    AND   any of (KK1), (KK2) or (KK3) hold -    (NB: we could strengthen K1) in this way too, but see K3.+    * (KK1: satisfy WF1) `lhs_w` is rewritable in `lhs_s`. -  - (K2b): if lhs not in s, we have no further opportunity to apply the-    work item+    * (KK2: termination) `lhs_w` is rewritable in `rhs_s` in these positions:+        If not(fs>=fw)+        then (KK2a) anywhere+        else (KK2b) look only in the argument of type family applications,+                    whose type family heads some LHS in `S` -  - (K4): See Note [K4]+    * (KK3: completeness)+      If not(fs >= fw)   -- If fs can rewrite fw, kick-out is redundant/harmful+      * (KK3a) If the role of `fs` is Nominal:+           kick out if `rhs_s = lhs_w`+      * (KK3b) If the role of `fs` is Representational:+           kick out if `rhs_s` is of form `(lhs_w t1 .. tn)` -* Lemma (L3). Suppose we have f* such that, for all f, f* >= f. Then-  if we are adding lhs -fw-> t (where T1, T2, and T3 hold), we will keep a -f*-> s.-  Proof. K4 holds; thus, we keep.+Rationale -Key lemma to make it watertight.-  Under the conditions of the Main Theorem,-  forall f st fw >= f, a is not in S^k(f,t), for any k+* (KK0) kick out only if `fw` can rewrite `fs`.+  Reason: suppose we kick out (lhs1 -fs-> s), and add (lhs -fw-> t) to the ineart+  set. The latter can't rewrite the former, so the kick-out achieved nothing -Also, consider roles more carefully. See Note [Flavours with roles]+* (KK1) `lhs_w` is rewritable in `lhs_s`.+  Reason: needed to guarantee (WF1).  See Theorem: T is well formed -Note [K4]-~~~~~~~~~-K4 is a "keep" condition of Note [Extending the inert equalities].-Here is the scenario:+* (KK2) see Note [KK2: termination of the extended substitution] -* We are considering adding (lhs -fw-> t) to the inert set S.-* S already has (lhs1 -fs-> s).-* We know S(fw, lhs) = lhs, S(fw, t) = t, and lhs is not rewritable in t.-  See Note [Rewritable]. These are (T1), (T2), and (T3).-* We further know fw >= fs. (If not, then we short-circuit via (K0).)+* (KK3) see Note [KK3: completeness of solving] -K4 says that we may keep lhs1 -fs-> s in S if:-  lhs1 is a tyvar AND fs >= fw+The above story is a bit vague wrt roles, but the code is not.+See Note [Flavours with roles] -Why K4 guarantees termination:-  * If fs >= fw, we know a is not rewritable in t, because of (T2).-  * We further know lhs /= a, because of (T1).-  * Accordingly, a use of the new inert item lhs -fw-> t cannot create the conditions-    for a use of a -fs-> s (precisely because t does not mention a), and hence,-    the extended substitution (with lhs -fw-> t in it) is a terminating-    generalised substitution.+Note [KK2: termination of the extended substitution]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Proving termination of the extended substitution T is surprisingly tricky. -Recall that the termination generalised substitution includes only mappings that-pass an occurs check. This is (T3). At one point, we worried that the-argument here would fail if s mentioned a, but (T3) rules out this possibility.-Put another way: the terminating generalised substitution considers only the inert_eqs,-not other parts of the inert set (such as the irreds).+* Reason for (KK2a).  Consider+      Work:  [G] b ~ a+      Inert: [W] a ~ b+  If we don't kick out the inert, then we get a loop on e.g. [W] a ~ Int.+  But if both were Wanted we really should not kick out (the substitution does not+  have to be idempotent). So we only look everywhere for the `lhs_w` if+  not (fs>=fw), that is the inert item cannot rewrite the work item.  So in the+  above example we will kick out; but if both were Wanted we won't. -Can we liberalise K4? No.+* Reason for (KK2b).  Consider the case where (fs >= fw)+      Work:  [G] a ~ Int+      Inert: [G] F Int ~ F a+  If we just added the work item, the substitution would loop on type (F Int).+  So we must kick out the inert item, even though (fs>=fw). (KK2b) does this+  by looking for lhs_w under type family applications in rhs_s. -Why we cannot drop the (fs >= fw) condition:-  * Suppose not (fs >= fw). It might be the case that t mentions a, and this-    can cause a loop. Example:+  (KK2b) makes kick-out less aggressive by looking only under type-family applications,+  in the case where (fs >= fw), and that made a /huge/ difference to #24944. -      Work:  [G] b ~ a-      Inert: [W] a ~ b+Tricky examples in: #19042, #17672, #24984. The last (#24984) is particular subtle: -    (where G >= G, G >= W, and W >= W)-    If we don't kick out the inert, then we get a loop on e.g. [W] a ~ Int.+  Inert:   [W] g1: F a0 ~ F a1+           [W] g2: F a2 ~ F a1+           [W] g3: F a3 ~ F a1 -  * Note that the above example is different if the inert is a Given G, because-    (T1) won't hold.+Now we add [W] g4: F a1 ~ F a7.  Should we kick out g1,g2,g3?  No!  The+substitution doesn't need to be idempotent, merely terminating.  And in #24984+it turned out that we kept adding one new constraint and kicking out all the+previous inert ones (and that rewriting led to exponentially big constraints due+to lack of contraint sharing.)  So we only want to look /under/ type family applications. -Why we cannot drop the tyvar condition:-  * Presume fs >= fw. Thus, F tys is not rewritable in t, because of (T2).-  * Can the use of lhs -fw-> t create the conditions for a use of F tys -fs-> s?-    Yes! This can happen if t appears within tys.+The proof is hard. We start by ignoring flavours. Suppose that:+* We are adding [lhs_w -fw-> rhs_w] to a well-formed, terminating substitution S.+* None of the constraints in S meet the KickOut Criteria.+* Define T = S+[lhs_w -fw-> rhs_w]+* `f` is an arbitrary flavour -    Here is an example:+Lemma 1: for any lhs_s in S, T*(f,lhs_s) terminates.+  Proof.+  * We know that r1 = S*(f,lhs_s) terminates.+  * Moreover, we know there are no occurrences of lhs_w under a type family (which+    is the head of a LHS) in r1 (KK2)+(WF3).  We need (WF3) because you might wonder+    what if rhs_s is (F a), and [a --> lhs_w] was in S.  But (WF3) prevents that.+  * Define r2 = r1{rhs_w/lhs_w}.  We know that rhs_w has no occurrences of any lhs in S,+    nor of lhs_w.+  * Since any occurrence of lhs_w does not occur under a type family, the substitution+    won't make any F t1..tn ~ s in S match.+  * So r2 is a fixed point of T. -      Work:  [G] a ~ Int-      Inert: [G] F Int ~ F a+Lemma 2: T*(f,lhs_w) teminates.+  Proof: no occurrences of any LHS in rhs_w. -    Now, if we have [W] F a ~ Bool, we will rewrite ad infinitum on the left-hand-    side. The key reason why K2b works in the tyvar case is that tyvars are atomic:-    if the right-hand side of an equality does not mention a variable a, then it-    cannot allow an equality with an LHS of a to fire. This is not the case for-    type family applications.+Theorem. For any type r, T*(r) terminates.+  Proof:+  1. Consider any sub-term of r, which is a LHS of T.+     - Rewrite it with T*; this terminates (Lemma 1).+     - Do this simultaneously to all sub-terms that match a LHS of T, yielding r1.+  2. Could this new r1 have a sub-term that is an LHS of T?  Yes, but only if r has a+     sub-term F w, and w rewrote in Step 1 to w' and F w' matches a LHS in T.+  3. Very well: apply step 1 again, but note that /doing so consumes one of the family+     applications in the original r/.+  4. After Step 1 either we have reached a fixed point, or we repeat Step 1 consuming at+     least one family application of r.+  5. There are only a finite number of family applications in r, so this process terminates. -Bottom line: K4 can keep only inerts with tyvars on the left. Put differently,-K4 will never prevent an inert with a type family on the left from being kicked-out.+Example: -Consequence: We never kick out a Given/Nominal equality with a tyvar on the left.-This is Lemma (L3) of Note [Extending the inert equalities]. It is good because-it means we can effectively model the mutable filling of metavariables with-Given/Nominal equalities. That is: it should be the case that we could rewrite-our solver never to fill in a metavariable; instead, it would "solve" a wanted-like alpha ~ Int by turning it into a Given, allowing it to be used in rewriting.-We would want the solver to behave the same whether it uses metavariables or-Givens. And (L3) says that no Given/Nominals over tyvars are ever kicked out,-just like we never unfill a metavariable. Nice.+Inert set:   gs : F Int ~ b+Work item:   gw : b ~ Int -Getting this wrong (that is, allowing K4 to apply to situations with the type-family on the left) led to #19042. (At that point, K4 was known as K2b.)+F (F (F b)) --[gw]--> F (F (F Int)) --[gs]--> F (F b)+            --[gw]--> F (F Int)     --[gs]--> F b+            --[gw]--> F Int         --[gs]--> b+            --[gw]--> Int -Originally, this condition was part of K2, but #17672 suggests it should be-a top-level K condition.+Notice that each iteration of Step 1 strips off one of the layers of F, all+of which were in the original r. -Note [K3: completeness of solving]+The argument is even more tricky when flavours are involved, and we have not+fleshed it out in detail.++Note [KK3: completeness of solving] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-(K3) is not necessary for the extended substitution-to be terminating.  In fact K1 could be made stronger by saying+(KK3) is not necessary for the extended substitution+to be terminating.  In fact (KK0) could be made stronger by saying    ... then (not (fw >= fs) or not (fs >= fs))-But it's not enough for S to be terminating; we also want completeness.+But it's not enough for S to be /terminating/; we also want /completeness/. That is, we want to be able to solve all soluble wanted equalities. Suppose we have-    work-item   b -G-> a    inert-item  a -W-> b- Assuming (G >= W) but not (W >= W), this fulfills all the conditions, so we could extend the inerts, thus:-    inert-items   b -G-> a                  a -W-> b- But if we kicked-out the inert item, we'd get-    work-item     a -W-> b    inert-item    b -G-> a  Then rewrite the work-item gives us (a -W-> a), which is soluble via Refl.-So we add one more clause to the kick-out criteria+So we add one more clause (KK3) to the kick-out criteria: -Another way to understand (K3) is that we treat an inert item-        a -f-> b-in the same way as-        b -f-> a-So if we kick out one, we should kick out the other.  The orientation-is somewhat accidental.+    * (KK3: completeness)+      If not(fs >= fw)   (KK3a)+      * (KK3b) If the role of `fs` is Nominal:+           kick out if `rhs_s = lhs_w`+      * (KK3c) If the role of `fs` is Representational:+           kick out if `rhs_s` is of form `(lhs_w t1 .. tn)` -When considering roles, we also need the second clause (K3b). Consider+Wrinkles: -  work-item    c -G/N-> a-  inert-item   a -W/R-> b c+* (KK3a) All this can only happen if the work-item can rewrite the inert+  one, /but not vice versa/; that is not(fs >= fw).  It is useless to kick+  out if (fs >= fw) becuase then the work-item is already fully rewritten+  by the inert item.  And too much kick-out is positively harmful.+  (Historical example #14363.) -The work-item doesn't get rewritten by the inert, because (>=) doesn't hold.-But we don't kick out the inert item because not (W/R >= W/R).  So we just-add the work item. But then, consider if we hit the following:+* (KK3b) addresses teh main example above for KK3. Another way to understand+  (KK3b) is that we treat an inert item+        a -f-> b+  in the same way as+        b -f-> a+  So if we kick out one, we should kick out the other.  The orientation+  is somewhat accidental. -  work-item    b -G/N-> Id-  inert-items  a -W/R-> b c-               c -G/N-> a-where-  newtype Id x = Id x+* (KK3c) When considering roles, we also need the second clause (KK3b). Consider+      work-item    c -G/N-> a+      inert-item   a -W/R-> b c+  The work-item doesn't get rewritten by the inert, because (>=) doesn't hold.+  But we don't kick out the inert item because not (W/R >= W/R).  So we just+  add the work item. But then, consider if we hit the following:+      work-item    b -G/N-> Id+      inert-items  a -W/R-> b c+                 c -G/N-> a+    where+      newtype Id x = Id x -For similar reasons, if we only had (K3a), we wouldn't kick the-representational inert out. And then, we'd miss solving the inert, which-now reduced to reflexivity.+  For similar reasons, if we only had (KK3a), we wouldn't kick the+  representational inert out. And then, we'd miss solving the inert, which now+  reduced to reflexivity. -The solution here is to kick out representational inerts whenever the-lhs of a work item is "exposed", where exposed means being at the-head of the top-level application chain (lhs t1 .. tn).  See-is_can_eq_lhs_head. This is encoded in (K3b).+  The solution here is to kick out representational inerts whenever the lhs of a+  work item is "exposed", where exposed means being at the head of the top-level+  application chain (lhs t1 .. tn).  See head_is_new_lhs. This is encoded in+  (KK3c)). -Beware: if we make this test succeed too often, we kick out too much,-and the solver might loop.  Consider (#14363)-  work item:   [G] a ~R f b-  inert item:  [G] b ~R f a-In GHC 8.2 the completeness tests more aggressive, and kicked out-the inert item; but no rewriting happened and there was an infinite-loop.  All we need is to have the tyvar at the head.  Note [Flavours with roles] ~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1386,8 +1479,8 @@   where     pred = ctEvPred ev     match_non_eq irred-      | irredCtPred irred `tcEqTypeNoKindCheck` pred = Left (irred, NotSwapped)-      | otherwise                                    = Right irred+      | irredCtPred irred `tcEqType` pred = Left (irred, NotSwapped)+      | otherwise                         = Right irred      match_eq eq_rel1 lty1 rty1 irred       | EqPred eq_rel2 lty2 rty2 <- classifyPredType (irredCtPred irred)@@ -1398,9 +1491,9 @@       = Right irred      match_eq_help lty1 rty1 lty2 rty2-      | lty1 `tcEqTypeNoKindCheck` lty2, rty1 `tcEqTypeNoKindCheck` rty2+      | lty1 `tcEqType` lty2, rty1 `tcEqType` rty2       = Just NotSwapped-      | lty1 `tcEqTypeNoKindCheck` rty2, rty1 `tcEqTypeNoKindCheck` lty2+      | lty1 `tcEqType` rty2, rty1 `tcEqType` lty2       = Just IsSwapped       | otherwise       = Nothing@@ -1430,33 +1523,38 @@ -- if the constraint is a given equality that should prevent -- filling in an outer unification variable. -- See Note [Tracking Given equalities]-updGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl })+--+-- Precondition: Ct is either CEqCan or CIrredCan+updGivenEqs tclvl ct inerts   | not (isGivenCt ct) = inerts-  | not_equality ct    = inerts -- See Note [Let-bound skolems]-  | otherwise          = inerts { inert_given_eq_lvl = ge_lvl'-                                , inert_given_eqs    = True }-  where-    ge_lvl' | mentionsOuterVar tclvl (ctEvidence ct)-              -- Includes things like (c a), which *might* be an equality-            = tclvl-            | otherwise-            = ge_lvl -    not_equality :: Ct -> Bool-    -- True <=> definitely not an equality of any kind-    --          except for a let-bound skolem, which doesn't count-    --          See Note [Let-bound skolems]-    -- NB: no need to spot the boxed CDictCan (a ~ b) because its-    --     superclass (a ~# b) will be a CEqCan-    not_equality (CEqCan (EqCt { eq_lhs = TyVarLHS tv })) = not (isOuterTyVar tclvl tv)-    not_equality (CDictCan {})                            = True-    not_equality _                                        = False+  -- See Note [Let-bound skolems]+  | isLetBoundSkolemCt tclvl ct = inerts { inert_given_eqs = True } +  -- At this point we are left with a constraint that either+  -- is an equality (F a ~ ty), or /might/ be, like (c a)+  | otherwise = inerts { inert_given_eq_lvl = tclvl+                       , inert_given_eqs    = True }++isLetBoundSkolemCt :: TcLevel -> Ct -> Bool+-- See Note [Let-bound skolems]+isLetBoundSkolemCt tclvl (CEqCan (EqCt { eq_lhs = lhs, eq_rhs = rhs }))+  = case lhs of+      TyVarLHS tv -> not (isOuterTyVar tclvl tv)+      TyFamLHS {} -> case getTyVar_maybe rhs of+                       Just tv -> not (isOuterTyVar tclvl tv)+                       Nothing -> False+isLetBoundSkolemCt _ _ = False+ data KickOutSpec -- See Note [KickOutSpec]   = KOAfterUnify  TcTyVarSet   -- We have unified these tyvars   | KOAfterAdding CanEqLHS     -- We are adding to the inert set a canonical equality                                -- constraint with this LHS +instance Outputable KickOutSpec where+  ppr (KOAfterUnify tvs)  = text "KOAfterUnify" <> ppr tvs+  ppr (KOAfterAdding lhs) = text "KOAfterAdding" <> parens (ppr lhs)+ {- Note [KickOutSpec] ~~~~~~~~~~~~~~~~~~~~~~ KickOutSpec explains why we are kicking out.@@ -1470,6 +1568,9 @@ * The code is far more perspicuous -} +data WhereToLook = LookEverywhere | LookOnlyUnderFamApps+                   deriving( Eq )+ kickOutRewritableLHS :: KickOutSpec -> CtFlavourRole -> InertCans -> (Cts, InertCans) -- See Note [kickOutRewritable] kickOutRewritableLHS ko_spec new_fr@(_, new_role)@@ -1495,8 +1596,8 @@      (tv_eqs_out, tv_eqs_in) = partitionInertEqs kick_out_eq tv_eqs     (feqs_out,   feqs_in)   = partitionFunEqs   kick_out_eq funeqmap-    (dicts_out,  dicts_in)  = partitionDicts    (kick_out_ct . CDictCan) dictmap-    (irs_out,    irs_in)    = partitionBag      (kick_out_ct . CIrredCan) irreds+    (dicts_out,  dicts_in)  = partitionDicts    kick_out_dict dictmap+    (irs_out,    irs_in)    = partitionBag      kick_out_irred irreds       -- Kick out even insolubles: See Note [Rewrite insolubles]       -- Of course we must kick out irreducibles like (c a), in case       -- we can rewrite 'c' to something more useful@@ -1512,81 +1613,95 @@        = ([], old_insts)     kick_out_qci qci       | let ev = qci_ev qci-      , fr_can_rewrite_ty NomEq (ctEvPred (qci_ev qci))+      , fr_can_rewrite_ty LookEverywhere NomEq (ctEvPred (qci_ev qci))       = Left (mkNonCanonical ev)       | otherwise       = Right qci -    fr_tv_can_rewrite_ty :: (TyVar -> Bool) -> EqRel -> Type -> Bool-    fr_tv_can_rewrite_ty ok_tv role ty+    fr_tv_can_rewrite_ty :: WhereToLook -> (TyVar -> Bool) -> EqRel -> Type -> Bool+    fr_tv_can_rewrite_ty where_to_look check_tv role ty       = anyRewritableTyVar role can_rewrite ty       where-        can_rewrite :: EqRel -> TyVar -> Bool-        can_rewrite old_role tv = new_role `eqCanRewrite` old_role && ok_tv tv+        can_rewrite :: UnderFam -> EqRel -> TyVar -> Bool+        can_rewrite is_under_famapp old_role tv+           = (where_to_look == LookEverywhere || is_under_famapp) &&+             new_role `eqCanRewrite` old_role && check_tv tv -    fr_tf_can_rewrite_ty :: TyCon -> [TcType] -> EqRel -> Type -> Bool-    fr_tf_can_rewrite_ty new_tf new_tf_args role ty+    fr_tf_can_rewrite_ty :: WhereToLook -> TyCon -> [TcType] -> EqRel -> Type -> Bool+    fr_tf_can_rewrite_ty where_to_look new_tf new_tf_args role ty       = anyRewritableTyFamApp role can_rewrite ty       where-        can_rewrite :: EqRel -> TyCon -> [TcType] -> Bool-        can_rewrite old_role old_tf old_tf_args-          = new_role `eqCanRewrite` old_role &&+        can_rewrite :: UnderFam -> EqRel -> TyCon -> [TcType] -> Bool+        can_rewrite is_under_famapp old_role old_tf old_tf_args+          = (where_to_look == LookEverywhere || is_under_famapp) &&+            new_role `eqCanRewrite` old_role &&             tcEqTyConApps new_tf new_tf_args old_tf old_tf_args               -- it's possible for old_tf_args to have too many. This is fine;               -- we'll only check what we need to. -    {-# INLINE fr_can_rewrite_ty #-}   -- Perform case analysis on ko_spec only once-    fr_can_rewrite_ty :: EqRel -> Type -> Bool-    fr_can_rewrite_ty = case ko_spec of  -- See Note [KickOutSpec]-      KOAfterUnify tvs                    -> fr_tv_can_rewrite_ty (`elemVarSet` tvs)-      KOAfterAdding (TyVarLHS tv)         -> fr_tv_can_rewrite_ty (== tv)-      KOAfterAdding (TyFamLHS tf tf_args) -> fr_tf_can_rewrite_ty tf tf_args +    fr_can_rewrite_ty :: WhereToLook -> EqRel -> Type -> Bool+    -- UnderFam = True <=> look only under type-family applications+    fr_can_rewrite_ty uf = case ko_spec of  -- See Note [KickOutSpec]+      KOAfterUnify tvs                    -> fr_tv_can_rewrite_ty uf (`elemVarSet` tvs)+      KOAfterAdding (TyVarLHS tv)         -> fr_tv_can_rewrite_ty uf (== tv)+      KOAfterAdding (TyFamLHS tf tf_args) -> fr_tf_can_rewrite_ty uf tf tf_args+     fr_may_rewrite :: CtFlavourRole -> Bool     fr_may_rewrite fs = new_fr `eqCanRewriteFR` fs         -- Can the new item rewrite the inert item? -    kick_out_ct :: Ct -> Bool+    kick_out_dict :: DictCt -> Bool     -- Kick it out if the new CEqCan can rewrite the inert one     -- See Note [kickOutRewritable]-    kick_out_ct ct = fr_may_rewrite fs && fr_can_rewrite_ty role (ctPred ct)+    kick_out_dict (DictCt { di_tys = tys, di_ev = ev })+      =  fr_may_rewrite (ctEvFlavour ev, NomEq)+      && any (fr_can_rewrite_ty LookEverywhere NomEq) tys++    kick_out_irred :: IrredCt -> Bool+    kick_out_irred (IrredCt { ir_ev = ev })+      =  fr_may_rewrite (ctEvFlavour ev, eq_rel)+      && fr_can_rewrite_ty LookEverywhere eq_rel pred       where-        fs@(_,role) = ctFlavourRole ct+       pred   = ctEvPred ev+       eq_rel = predTypeEqRel pred      -- Implements criteria K1-K3 in Note [Extending the inert equalities]     kick_out_eq :: EqCt -> Bool     kick_out_eq (EqCt { eq_lhs = lhs, eq_rhs = rhs_ty                       , eq_ev = ev, eq_eq_rel = eq_rel })++      -- (KK0) Keep it in the inert set if the new thing can't rewrite it       | not (fr_may_rewrite fs)-      = False  -- (K0) Keep it in the inert set if the new thing can't rewrite it+      = False        -- Below here (fr_may_rewrite fs) is True -      | TyVarLHS _ <- lhs-      , fs `eqCanRewriteFR` new_fr-      = False  -- (K4) Keep it in the inert set if the LHS is a tyvar and-               -- it can rewrite the work item. See Note [K4]--      | fr_can_rewrite_ty eq_rel (canEqLHSType lhs)-      = True   -- (K1)+      -- (KK1)+      | fr_can_rewrite_ty LookEverywhere eq_rel (canEqLHSType lhs)+      = True   -- (KK1)          -- The above check redundantly checks the role & flavour,          -- but it's very convenient -      | kick_out_for_inertness    = True   -- (K2)-      | kick_out_for_completeness = True   -- (K3)-      | otherwise                 = False+      -- (KK2)+      | let where_to_look | fs_can_rewrite_fr = LookOnlyUnderFamApps+                          | otherwise         = LookEverywhere+      , fr_can_rewrite_ty where_to_look eq_rel rhs_ty+      = True +      -- (KK3)+      | not fs_can_rewrite_fr                    -- (KK3a)+      , case eq_rel of+              NomEq  -> is_new_lhs      rhs_ty   -- (KK3b)+              ReprEq -> head_is_new_lhs rhs_ty   -- (KK3c)+      = True++      | otherwise = False+       where+        fs_can_rewrite_fr = fs `eqCanRewriteFR` new_fr         fs = (ctEvFlavour ev, eq_rel)-        kick_out_for_inertness-          =    (fs `eqCanRewriteFR` fs)           -- (K2a)-            && fr_can_rewrite_ty eq_rel rhs_ty    -- (K2b) -        kick_out_for_completeness  -- (K3) and Note [K3: completeness of solving]-          = case eq_rel of-              NomEq  -> is_new_lhs      rhs_ty   -- (K3a)-              ReprEq -> head_is_new_lhs rhs_ty   -- (K3b)-     is_new_lhs :: Type -> Bool     is_new_lhs = case ko_spec of   -- See Note [KickOutSpec]           KOAfterUnify tvs  -> is_tyvar_ty_for tvs@@ -1695,11 +1810,6 @@ *                                                                      * ********************************************************************* -} -mentionsOuterVar :: TcLevel -> CtEvidence -> Bool-mentionsOuterVar tclvl ev-  = anyFreeVarsOfType (isOuterTyVar tclvl) $-    ctEvPred ev- isOuterTyVar :: TcLevel -> TyCoVar -> Bool -- True of a type variable that comes from a -- shallower level than the ambient level (tclvl)@@ -2091,7 +2201,7 @@   -- From here on both are Given   -- See Note [Replacement vs keeping] -  | lvl_i == lvl_w+  | lvl_i `sameDepthAs` lvl_w   = same_level_strategy    | otherwise   -- Both are Given, levels differ@@ -2116,8 +2226,8 @@      is_wsc_orig_w = isWantedSuperclassOrigin orig_w       different_level_strategy  -- Both Given-       | isIPLikePred pred = if lvl_w > lvl_i then KeepWork  else KeepInert-       | otherwise         = if lvl_w > lvl_i then KeepInert else KeepWork+       | isIPLikePred pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork  else KeepInert+       | otherwise         = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork        -- See Note [Replacement vs keeping] part (1)        -- For the isIPLikePred case see Note [Shadowing of implicit parameters]        --                               in GHC.Tc.Solver.Dict
compiler/GHC/Tc/Solver/Types.hs view
@@ -24,6 +24,7 @@  import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin+import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin ) import GHC.Tc.Utils.TcType  import GHC.Types.Unique@@ -166,7 +167,7 @@     IP "callStack" CallStack   See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -* We canonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by+* We cannonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by   pushing the call-site info on the stack, and changing the CtOrigin   to record that has been done.    Bind:  s1 = pushCallStack <site-info> s2
compiler/GHC/Tc/Types.hs view
@@ -43,6 +43,8 @@         -- Renamer types         ErrCtxt,         ImportAvails(..), emptyImportAvails, plusImportAvails,+        ImportUserSpec(..),+        ImpUserList(..),         mkModDeps,          -- Typechecker types@@ -117,6 +119,7 @@  import GHC.Tc.Utils.TcType import GHC.Tc.Types.Constraint+import GHC.Tc.Types.CtLoc( CtLoc ) import GHC.Tc.Types.Evidence import GHC.Tc.Types.TH import GHC.Tc.Types.TcRef@@ -135,6 +138,7 @@ import GHC.Core.FamInstEnv import GHC.Core.Predicate +import GHC.Types.DefaultEnv ( DefaultEnv ) import GHC.Types.Fixity.Env import GHC.Types.Annotations import GHC.Types.CompleteMatch@@ -174,12 +178,37 @@  import Data.Set      ( Set ) import qualified Data.Set as S+import qualified Data.Map as M import Data.Dynamic  ( Dynamic ) import Data.Map ( Map ) import Data.Typeable ( TypeRep ) import Data.Maybe    ( mapMaybe ) +-- | The import specification as written by the user, including+-- the list of explicitly imported names. Used in 'ModIface' to+-- allow GHCi to reconstruct the top level environment on demand.+--+-- This is distinct from 'ImportSpec' because we don't want to store+-- the list of explicitly imported names along with each 'GRE'+--+-- We don't want to store the entire GlobalRdrEnv for modules that+-- are imported without explicit export lists, as these may grow+-- to be very large. However, GlobalRdrEnvs which are the result+-- of explicit import lists are typically quite small.+--+-- Why do we not store something like (Maybe (ImportListInterpretation, [IE GhcPs]) in such a case?+-- Because we don't want to store source syntax including annotations in+-- interface files.+data ImportUserSpec+  = ImpUserSpec { ius_decl :: !ImpDeclSpec+                , ius_imports :: !ImpUserList+                } +data ImpUserList+  = ImpUserAll -- ^ no user import list+  | ImpUserExplicit !GlobalRdrEnv+  | ImpUserEverythingBut !NameSet+ -- | A 'NameShape' is a substitution on 'Name's that can be used -- to refine the identities of a hole while we are renaming interfaces -- (see "GHC.Iface.Rename").  Specifically, a 'NameShape' for@@ -293,9 +322,8 @@        -- See Note [Rewriter CtLoc] in GHC.Tc.Solver.Rewrite.        , re_flavour :: !CtFlavour        , re_eq_rel  :: !EqRel-       -- ^ At what role are we rewriting?-       ---       -- See Note [Rewriter EqRels] in GHC.Tc.Solver.Rewrite+          -- ^ At what role are we rewriting?+          -- See Note [Rewriter EqRels] in GHC.Tc.Solver.Rewrite         , re_rewriters :: !(TcRef RewriterSet)  -- ^ See Note [Wanteds rewrite Wanteds]        }@@ -441,8 +469,8 @@           -- ^ What kind of module (regular Haskell, hs-boot, hsig)          tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming-        tcg_default :: Maybe [Type],-          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl+        tcg_default         :: DefaultEnv,     -- ^ All class defaults in scope in the module+        tcg_default_exports :: DefaultEnv,     -- ^ All class defaults exported from the module          tcg_fix_env :: FixityEnv,      -- ^ Just for things in this module @@ -505,6 +533,12 @@           --      (mkIfaceTc, as well as in "GHC.Driver.Main")           --    - To create the Dependencies field in interface (mkDependencies) ++          -- This field tracks the user-written imports of a module, so they can be+          -- recorded in an interface file in order to reconstruct the top-level environment+          -- if necessary for GHCi.+        tcg_import_decls :: ![ImportUserSpec],+           -- These three fields track unused bindings and imports           -- See Note [Tracking unused binding and imports]         tcg_dus       :: DefUses,@@ -889,7 +923,7 @@       -- perf/compiler/MultiLayerModules  emptyImportAvails :: ImportAvails-emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,+emptyImportAvails = ImportAvails { imp_mods          = M.empty,                                    imp_direct_dep_mods = emptyInstalledModuleEnv,                                    imp_dep_direct_pkgs = S.empty,                                    imp_sig_mods      = [],@@ -920,7 +954,7 @@                   imp_sig_mods = sig_mods2,                   imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,                   imp_orphs = orphs2, imp_finsts = finsts2 })-  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,+  = ImportAvails { imp_mods          = M.unionWith (++) mods1 mods2,                    imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2,                    imp_dep_direct_pkgs      = ddpkgs1 `S.union` ddpkgs2,                    imp_trust_pkgs    = tpkgs1 `S.union` tpkgs2,
compiler/GHC/Tc/Types/BasicTypes.hs view
@@ -24,6 +24,9 @@  import GHC.Prelude +import GHC.Tc.Types.Origin( UserTypeCtxt )+import GHC.Tc.Utils.TcType+ import GHC.Types.Id import GHC.Types.Basic import GHC.Types.Var@@ -32,8 +35,6 @@ import GHC.Types.TyThing import GHC.Types.Name.Env import GHC.Types.Name.Set-import GHC.Tc.Types.Origin-import GHC.Tc.Utils.TcType  import GHC.Hs.Extension ( GhcRn )
compiler/GHC/Tc/Types/Constraint.hs view
@@ -22,10 +22,11 @@         mkNonCanonical, mkGivens,         tyCoVarsOfCt, tyCoVarsOfCts,         tyCoVarsOfCtList, tyCoVarsOfCtsList,+        boundOccNamesOfWC,          -- Particular forms of constraint         EqCt(..),    eqCtEvidence, eqCtLHS,-        DictCt(..),  dictCtEvidence,+        DictCt(..),  dictCtEvidence, dictCtPred,         IrredCt(..), irredCtEvidence, mkIrredCt, ctIrredCt, irredCtPred,          -- QCInst@@ -65,13 +66,6 @@         ImplicStatus(..), isInsolubleStatus, isSolvedStatus,         UserGiven, getUserGivensFromImplics,         HasGivenEqs(..), checkImplicationInvariants,-        SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,-        bumpSubGoalDepth, subGoalDepthExceeded,-        CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,-        ctLocTypeOrKind_maybe,-        ctLocDepth, bumpCtLocDepth, isGivenLoc,-        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,-        pprCtLoc, adjustCtLoc, adjustCtLocTyConBinder,          -- CtLocEnv         CtLocEnv(..), setCtLocEnvLoc, setCtLocEnvLvl, getCtLocEnvLoc, getCtLocEnvLvl, ctLocEnvInGeneratedCode,@@ -82,8 +76,7 @@         ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,         ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,         ctEvRewriters, ctEvUnique, tcEvDestUnique,-        mkKindEqLoc, toKindLoc, toInvisibleLoc, mkGivenLoc,-        ctEvRole, setCtEvPredType, setCtEvLoc,+        ctEvRewriteRole, ctEvRewriteEqRel, setCtEvPredType, setCtEvLoc,         tyCoVarsOfCtEvList, tyCoVarsOfCtEv, tyCoVarsOfCtEvsList,          -- RewriterSet@@ -117,7 +110,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin-import GHC.Tc.Types.CtLocEnv+import GHC.Tc.Types.CtLoc  import GHC.Core @@ -125,11 +118,9 @@ import GHC.Utils.FV import GHC.Types.Var.Set import GHC.Builtin.Names-import GHC.Types.Basic import GHC.Types.Unique.Set  import GHC.Utils.Outputable-import GHC.Types.SrcLoc import GHC.Data.Bag import GHC.Utils.Misc import GHC.Utils.Panic@@ -224,6 +215,9 @@ dictCtEvidence :: DictCt -> CtEvidence dictCtEvidence = di_ev +dictCtPred :: DictCt -> TcPredType+dictCtPred (DictCt { di_cls = cls, di_tys = tys }) = mkClassPred cls tys+ instance Outputable DictCt where   ppr dict = ppr (CDictCan dict) @@ -847,6 +841,20 @@ ************************************************************************ -} +---------------- Getting bound tyvars -------------------------+boundOccNamesOfWC :: WantedConstraints -> [OccName]+-- Return the OccNames of skolem-bound type variables+-- We could recurse into types, and get the forall-bound ones too,+-- but I'm going wait until that is needed+-- See Note [tidyAvoiding] in GHC.Core.TyCo.Tidy+boundOccNamesOfWC wc = bagToList (go_wc wc)+  where+    go_wc (WC { wc_impl = implics })+      = concatMapBag go_implic implics+    go_implic (Implic { ic_skols = tvs, ic_wanted = wc })+      = listToBag (map getOccName tvs) `unionBags` go_wc wc++ ---------------- Getting free tyvars -------------------------  -- | Returns free variables of constraints as a non-deterministic set@@ -950,9 +958,6 @@ tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV tyCoFVsOfBag tvs_of = foldr (unionFV . tvs_of) emptyFV -isGivenLoc :: CtLoc -> Bool-isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)- {- ************************************************************************ *                                                                      *@@ -1841,7 +1846,7 @@      check_details :: TcTyVar -> TcTyVarDetails -> Maybe SDoc     check_details tv (SkolemTv tv_skol_info tv_lvl _)-      | not (tv_lvl == lvl)+      | not (tv_lvl `sameDepthAs` lvl)       = Just (vcat [ ppr tv <+> text "has level" <+> ppr tv_lvl                    , text "ic_lvl" <+> ppr lvl ])       | not (skol_info `checkSkolInfoAnon` skol_info_anon)@@ -1980,7 +1985,7 @@ of `eqType`.)  The safest thing is simply to keep `ctev_evar`/`ctev_dest` in sync-with `ctev_pref`, as stated in `Note [CtEvidence invariants]`.+with `ctev_pred`, as stated in `Note [CtEvidence invariants]`.  Note [Bind new Givens immediately] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -2006,6 +2011,18 @@  So a Given has EvVar inside it rather than (as previously) an EvTerm. +Note [The rewrite-role of a constraint]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The rewrite-role of a constraint says what can rewrite that constraint:++* If the rewrite-role = Nominal, only a nominal equality can rewrite it++* If the rewrite-rule = Representational, either a nominal or+  representational equality can rewrit it.++Notice that the constraint may itself not be an equality at all.+For example, the rewrite-role of (Eq [a]) is Nominal; only nominal+equalities can rewrite it. -}  -- | A place for type-checking evidence to go after it is generated.@@ -2045,13 +2062,20 @@ ctEvOrigin = ctLocOrigin . ctEvLoc  -- | Get the equality relation relevant for a 'CtEvidence'-ctEvEqRel :: CtEvidence -> EqRel+ctEvEqRel :: HasDebugCallStack => CtEvidence -> EqRel ctEvEqRel = predTypeEqRel . ctEvPred --- | Get the role relevant for a 'CtEvidence'-ctEvRole :: CtEvidence -> Role-ctEvRole = eqRelRole . ctEvEqRel+-- | Get the rewrite-role relevant for a 'CtEvidence'+-- See Note [The rewrite-role of a constraint]+ctEvRewriteRole :: HasDebugCallStack => CtEvidence -> Role+ctEvRewriteRole = eqRelRole . ctEvRewriteEqRel +ctEvRewriteEqRel :: CtEvidence -> EqRel+-- ^ Return the rewrite-role of an abitrary CtEvidence+-- See Note [The rewrite-role of a constraint]+-- We return ReprEq for (a ~R# b) and NomEq for all other preds+ctEvRewriteEqRel = predTypeEqRel . ctEvPred+ ctEvTerm :: CtEvidence -> EvTerm ctEvTerm ev = EvExpr (ctEvExpr ev) @@ -2061,7 +2085,7 @@ -- return an empty set. ctEvRewriters :: CtEvidence -> RewriterSet ctEvRewriters (CtWanted { ctev_rewriters = rewriters }) = rewriters-ctEvRewriters _other                                    = emptyRewriterSet+ctEvRewriters (CtGiven {})                              = emptyRewriterSet  ctEvExpr :: HasDebugCallStack => CtEvidence -> EvExpr ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ })@@ -2203,8 +2227,8 @@ type CtFlavourRole = (CtFlavour, EqRel)  -- | Extract the flavour, role, and boxity from a 'CtEvidence'-ctEvFlavourRole :: CtEvidence -> CtFlavourRole-ctEvFlavourRole ev = (ctEvFlavour ev, ctEvEqRel ev)+ctEvFlavourRole :: HasDebugCallStack => CtEvidence -> CtFlavourRole+ctEvFlavourRole ev = (ctEvFlavour ev, ctEvRewriteEqRel ev)  -- | Extract the flavour and role from a 'Ct' eqCtFlavourRole :: EqCt -> CtFlavourRole@@ -2216,8 +2240,8 @@   = (ctEvFlavour ev, NomEq)  -- | Extract the flavour and role from a 'Ct'-ctFlavourRole :: Ct -> CtFlavourRole--- Uses short-cuts to role for special cases+ctFlavourRole :: HasDebugCallStack => Ct -> CtFlavourRole+-- Uses short-cuts for the Role field, for special cases ctFlavourRole (CDictCan di_ct) = dictCtFlavourRole di_ct ctFlavourRole (CEqCan eq_ct)   = eqCtFlavourRole eq_ct ctFlavourRole ct               = ctEvFlavourRole (ctEvidence ct)@@ -2452,175 +2476,3 @@ eqCanRewriteFR (Wanted, r1)    (Wanted, r2)     = eqCanRewrite r1 r2 eqCanRewriteFR (Wanted, _)     (Given, _)       = False -{--************************************************************************-*                                                                      *-            SubGoalDepth-*                                                                      *-************************************************************************--Note [SubGoalDepth]-~~~~~~~~~~~~~~~~~~~-The 'SubGoalDepth' takes care of stopping the constraint solver from looping.--The counter starts at zero and increases. It includes dictionary constraints,-equality simplification, and type family reduction. (Why combine these? Because-it's actually quite easy to mistake one for another, in sufficiently involved-scenarios, like ConstraintKinds.)--The flag -freduction-depth=n fixes the maximum level.--* The counter includes the depth of type class instance declarations.  Example:-     [W] d{7} : Eq [Int]-  That is d's dictionary-constraint depth is 7.  If we use the instance-     $dfEqList :: Eq a => Eq [a]-  to simplify it, we get-     d{7} = $dfEqList d'{8}-  where d'{8} : Eq Int, and d' has depth 8.--  For civilised (decidable) instance declarations, each increase of-  depth removes a type constructor from the type, so the depth never-  gets big; i.e. is bounded by the structural depth of the type.--* The counter also increments when resolving-equalities involving type functions. Example:-  Assume we have a wanted at depth 7:-    [W] d{7} : F () ~ a-  If there is a type function equation "F () = Int", this would be rewritten to-    [W] d{8} : Int ~ a-  and remembered as having depth 8.--  Again, without UndecidableInstances, this counter is bounded, but without it-  can resolve things ad infinitum. Hence there is a maximum level.--* Lastly, every time an equality is rewritten, the counter increases. Again,-  rewriting an equality constraint normally makes progress, but it's possible-  the "progress" is just the reduction of an infinitely-reducing type family.-  Hence we need to track the rewrites.--When compiling a program requires a greater depth, then GHC recommends turning-off this check entirely by setting -freduction-depth=0. This is because the-exact number that works is highly variable, and is likely to change even between-minor releases. Because this check is solely to prevent infinite compilation-times, it seems safe to disable it when a user has ascertained that their program-doesn't loop at the type level.---}---- | See Note [SubGoalDepth]-newtype SubGoalDepth = SubGoalDepth Int-  deriving (Eq, Ord, Outputable)--initialSubGoalDepth :: SubGoalDepth-initialSubGoalDepth = SubGoalDepth 0--bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth-bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)--maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth-maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)--subGoalDepthExceeded :: IntWithInf -> SubGoalDepth -> Bool-subGoalDepthExceeded reductionDepth (SubGoalDepth d)-  = mkIntWithInf d > reductionDepth--{--************************************************************************-*                                                                      *-            CtLoc-*                                                                      *-************************************************************************--The 'CtLoc' gives information about where a constraint came from.-This is important for decent error message reporting because-dictionaries don't appear in the original source code.---}--data CtLoc = CtLoc { ctl_origin   :: CtOrigin-                   , ctl_env      :: CtLocEnv -- Everything we need to know about-                                              -- the context this Ct arose in.-                   , ctl_t_or_k   :: Maybe TypeOrKind  -- OK if we're not sure-                   , ctl_depth    :: !SubGoalDepth }--mkKindEqLoc :: TcType -> TcType   -- original *types* being compared-            -> CtLoc -> CtLoc-mkKindEqLoc s1 s2 ctloc-  | CtLoc { ctl_t_or_k = t_or_k, ctl_origin = origin } <- ctloc-  = ctloc { ctl_origin = KindEqOrigin s1 s2 origin t_or_k-          , ctl_t_or_k = Just KindLevel }--adjustCtLocTyConBinder :: TyConBinder -> CtLoc -> CtLoc--- Adjust the CtLoc when decomposing a type constructor-adjustCtLocTyConBinder tc_bndr loc-  = adjustCtLoc is_vis is_kind loc-  where-    is_vis  = isVisibleTyConBinder tc_bndr-    is_kind = isNamedTyConBinder tc_bndr--adjustCtLoc :: Bool    -- True <=> A visible argument-            -> Bool    -- True <=> A kind argument-            -> CtLoc -> CtLoc--- Adjust the CtLoc when decomposing a type constructor, application, etc-adjustCtLoc is_vis is_kind loc-  = loc2-  where-    loc1 | is_kind   = toKindLoc loc-         | otherwise = loc-    loc2 | is_vis    = loc1-         | otherwise = toInvisibleLoc loc1---- | Take a CtLoc and moves it to the kind level-toKindLoc :: CtLoc -> CtLoc-toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }--toInvisibleLoc :: CtLoc -> CtLoc-toInvisibleLoc loc = updateCtLocOrigin loc toInvisibleOrigin--mkGivenLoc :: TcLevel -> SkolemInfoAnon -> CtLocEnv -> CtLoc-mkGivenLoc tclvl skol_info env-  = CtLoc { ctl_origin   = GivenOrigin skol_info-          , ctl_env      = setCtLocEnvLvl env tclvl-          , ctl_t_or_k   = Nothing    -- this only matters for error msgs-          , ctl_depth    = initialSubGoalDepth }--ctLocEnv :: CtLoc -> CtLocEnv-ctLocEnv = ctl_env--ctLocLevel :: CtLoc -> TcLevel-ctLocLevel loc = getCtLocEnvLvl (ctLocEnv loc)--ctLocDepth :: CtLoc -> SubGoalDepth-ctLocDepth = ctl_depth--ctLocOrigin :: CtLoc -> CtOrigin-ctLocOrigin = ctl_origin--ctLocSpan :: CtLoc -> RealSrcSpan-ctLocSpan (CtLoc { ctl_env = lcl}) = getCtLocEnvLoc lcl--ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind-ctLocTypeOrKind_maybe = ctl_t_or_k--setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc-setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (setCtLocRealLoc lcl loc)--bumpCtLocDepth :: CtLoc -> CtLoc-bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }--setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc-setCtLocOrigin ctl orig = ctl { ctl_origin = orig }--updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc-updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd-  = ctl { ctl_origin = upd orig }--setCtLocEnv :: CtLoc -> CtLocEnv -> CtLoc-setCtLocEnv ctl env = ctl { ctl_env = env }--pprCtLoc :: CtLoc -> SDoc--- "arising from ... at ..."--- Not an instance of Outputable because of the "arising from" prefix-pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})-  = sep [ pprCtOrigin o-        , text "at" <+> ppr (getCtLocEnvLoc lcl)]
+ compiler/GHC/Tc/Types/CtLoc.hs view
@@ -0,0 +1,260 @@+module GHC.Tc.Types.CtLoc (++  -- * CtLoc+  CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,+  ctLocTypeOrKind_maybe, toInvisibleLoc,+  ctLocDepth, bumpCtLocDepth, isGivenLoc, mkGivenLoc, mkKindEqLoc,+  setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,+  pprCtLoc, adjustCtLoc, adjustCtLocTyConBinder,++  -- * CtLocEnv+  CtLocEnv(..),+  getCtLocEnvLoc, setCtLocEnvLoc, setCtLocRealLoc,+  getCtLocEnvLvl, setCtLocEnvLvl,+  ctLocEnvInGeneratedCode,++  -- * SubGoalDepth+  SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,+  bumpSubGoalDepth, subGoalDepthExceeded++  ) where++import GHC.Prelude++import GHC.Tc.Types.BasicTypes+import GHC.Tc.Types.ErrCtxt+import GHC.Tc.Types.Origin++import GHC.Tc.Utils.TcType++import GHC.Types.SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Basic( IntWithInf, mkIntWithInf, TypeOrKind(..) )++import GHC.Core.TyCon( TyConBinder, isVisibleTyConBinder, isNamedTyConBinder )++import GHC.Utils.Outputable+++{- *********************************************************************+*                                                                      *+            SubGoalDepth+*                                                                      *+********************************************************************* -}++{- Note [SubGoalDepth]+~~~~~~~~~~~~~~~~~~~~~~+The 'SubGoalDepth' takes care of stopping the constraint solver from looping.++The counter starts at zero and increases. It includes dictionary constraints,+equality simplification, and type family reduction. (Why combine these? Because+it's actually quite easy to mistake one for another, in sufficiently involved+scenarios, like ConstraintKinds.)++The flag -freduction-depth=n fixes the maximum level.++* The counter includes the depth of type class instance declarations.  Example:+     [W] d{7} : Eq [Int]+  That is d's dictionary-constraint depth is 7.  If we use the instance+     $dfEqList :: Eq a => Eq [a]+  to simplify it, we get+     d{7} = $dfEqList d'{8}+  where d'{8} : Eq Int, and d' has depth 8.++  For civilised (decidable) instance declarations, each increase of+  depth removes a type constructor from the type, so the depth never+  gets big; i.e. is bounded by the structural depth of the type.++* The counter also increments when resolving+equalities involving type functions. Example:+  Assume we have a wanted at depth 7:+    [W] d{7} : F () ~ a+  If there is a type function equation "F () = Int", this would be rewritten to+    [W] d{8} : Int ~ a+  and remembered as having depth 8.++  Again, without UndecidableInstances, this counter is bounded, but without it+  can resolve things ad infinitum. Hence there is a maximum level.++* Lastly, every time an equality is rewritten, the counter increases. Again,+  rewriting an equality constraint normally makes progress, but it's possible+  the "progress" is just the reduction of an infinitely-reducing type family.+  Hence we need to track the rewrites.++When compiling a program requires a greater depth, then GHC recommends turning+off this check entirely by setting -freduction-depth=0. This is because the+exact number that works is highly variable, and is likely to change even between+minor releases. Because this check is solely to prevent infinite compilation+times, it seems safe to disable it when a user has ascertained that their program+doesn't loop at the type level.++-}++-- | See Note [SubGoalDepth]+newtype SubGoalDepth = SubGoalDepth Int+  deriving (Eq, Ord, Outputable)++initialSubGoalDepth :: SubGoalDepth+initialSubGoalDepth = SubGoalDepth 0++bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth+bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)++maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth+maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)++subGoalDepthExceeded :: IntWithInf -> SubGoalDepth -> Bool+subGoalDepthExceeded reductionDepth (SubGoalDepth d)+  = mkIntWithInf d > reductionDepth+++{- *********************************************************************+*                                                                      *+            CtLoc+*                                                                      *+************************************************************************++The 'CtLoc' gives information about where a constraint came from.+This is important for decent error message reporting because+dictionaries don't appear in the original source code.++-}++data CtLoc = CtLoc { ctl_origin   :: CtOrigin+                   , ctl_env      :: CtLocEnv -- Everything we need to know about+                                              -- the context this Ct arose in.+                   , ctl_t_or_k   :: Maybe TypeOrKind  -- OK if we're not sure+                   , ctl_depth    :: !SubGoalDepth }++mkKindEqLoc :: TcType -> TcType   -- original *types* being compared+            -> CtLoc -> CtLoc+mkKindEqLoc s1 s2 ctloc+  | CtLoc { ctl_t_or_k = t_or_k, ctl_origin = origin } <- ctloc+  = ctloc { ctl_origin = KindEqOrigin s1 s2 origin t_or_k+          , ctl_t_or_k = Just KindLevel }++adjustCtLocTyConBinder :: TyConBinder -> CtLoc -> CtLoc+-- Adjust the CtLoc when decomposing a type constructor+adjustCtLocTyConBinder tc_bndr loc+  = adjustCtLoc is_vis is_kind loc+  where+    is_vis  = isVisibleTyConBinder tc_bndr+    is_kind = isNamedTyConBinder tc_bndr++adjustCtLoc :: Bool    -- True <=> A visible argument+            -> Bool    -- True <=> A kind argument+            -> CtLoc -> CtLoc+-- Adjust the CtLoc when decomposing a type constructor, application, etc+adjustCtLoc is_vis is_kind loc+  = loc2+  where+    loc1 | is_kind   = toKindLoc loc+         | otherwise = loc+    loc2 | is_vis    = loc1+         | otherwise = toInvisibleLoc loc1++-- | Take a CtLoc and moves it to the kind level+toKindLoc :: CtLoc -> CtLoc+toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }++toInvisibleLoc :: CtLoc -> CtLoc+toInvisibleLoc loc = updateCtLocOrigin loc toInvisibleOrigin++mkGivenLoc :: TcLevel -> SkolemInfoAnon -> CtLocEnv -> CtLoc+mkGivenLoc tclvl skol_info env+  = CtLoc { ctl_origin   = GivenOrigin skol_info+          , ctl_env      = setCtLocEnvLvl env tclvl+          , ctl_t_or_k   = Nothing    -- this only matters for error msgs+          , ctl_depth    = initialSubGoalDepth }++ctLocEnv :: CtLoc -> CtLocEnv+ctLocEnv = ctl_env++ctLocLevel :: CtLoc -> TcLevel+ctLocLevel loc = getCtLocEnvLvl (ctLocEnv loc)++ctLocDepth :: CtLoc -> SubGoalDepth+ctLocDepth = ctl_depth++ctLocOrigin :: CtLoc -> CtOrigin+ctLocOrigin = ctl_origin++ctLocSpan :: CtLoc -> RealSrcSpan+ctLocSpan (CtLoc { ctl_env = lcl}) = getCtLocEnvLoc lcl++ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind+ctLocTypeOrKind_maybe = ctl_t_or_k++setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc+setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (setCtLocRealLoc lcl loc)++bumpCtLocDepth :: CtLoc -> CtLoc+bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }++setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc+setCtLocOrigin ctl orig = ctl { ctl_origin = orig }++updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc+updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd+  = ctl { ctl_origin = upd orig }++setCtLocEnv :: CtLoc -> CtLocEnv -> CtLoc+setCtLocEnv ctl env = ctl { ctl_env = env }++isGivenLoc :: CtLoc -> Bool+isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)++pprCtLoc :: CtLoc -> SDoc+-- "arising from ... at ..."+-- Not an instance of Outputable because of the "arising from" prefix+pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})+  = sep [ pprCtOrigin o+        , text "at" <+> ppr (getCtLocEnvLoc lcl)]+++{- *********************************************************************+*                                                                      *+            CtLocEnv+*                                                                      *+********************************************************************* -}++-- | Local typechecker environment for a constraint.+--+-- Used to restore the environment of a constraint+-- when reporting errors, see `setCtLocM`.+--+-- See also 'TcLclCtxt'.+data CtLocEnv = CtLocEnv { ctl_ctxt :: ![ErrCtxt]+                         , ctl_loc :: !RealSrcSpan+                         , ctl_bndrs :: !TcBinderStack+                         , ctl_tclvl :: !TcLevel+                         , ctl_in_gen_code :: !Bool+                         , ctl_rdr :: !LocalRdrEnv }+++getCtLocEnvLoc :: CtLocEnv -> RealSrcSpan+getCtLocEnvLoc = ctl_loc++getCtLocEnvLvl :: CtLocEnv -> TcLevel+getCtLocEnvLvl = ctl_tclvl++setCtLocEnvLvl :: CtLocEnv -> TcLevel -> CtLocEnv+setCtLocEnvLvl env lvl = env { ctl_tclvl = lvl }++setCtLocRealLoc :: CtLocEnv -> RealSrcSpan -> CtLocEnv+setCtLocRealLoc env ss = env { ctl_loc = ss }++setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv+-- See Note [Error contexts in generated code]+-- for the ctl_in_gen_code manipulation+setCtLocEnvLoc env (RealSrcSpan loc _)+  = env { ctl_loc = loc, ctl_in_gen_code = False }++setCtLocEnvLoc env loc@(UnhelpfulSpan _)+  | isGeneratedSrcSpan loc+  = env { ctl_in_gen_code = True }+  | otherwise+  = env++ctLocEnvInGeneratedCode :: CtLocEnv -> Bool+ctLocEnvInGeneratedCode = ctl_in_gen_code
− compiler/GHC/Tc/Types/CtLocEnv.hs 
@@ -1,60 +0,0 @@-module GHC.Tc.Types.CtLocEnv (-    CtLocEnv(..)-  , getCtLocEnvLoc-  , getCtLocEnvLvl-  , setCtLocEnvLvl-  , setCtLocRealLoc-  , setCtLocEnvLoc-  , ctLocEnvInGeneratedCode-  ) where--import GHC.Prelude--import GHC.Types.SrcLoc-import GHC.Types.Name.Reader--import GHC.Tc.Types.BasicTypes-import GHC.Tc.Utils.TcType-import GHC.Tc.Types.ErrCtxt----- | Local typechecker environment for a constraint.------ Used to restore the environment of a constraint--- when reporting errors, see `setCtLocM`.------ See also 'TcLclCtxt'.-data CtLocEnv = CtLocEnv { ctl_ctxt :: ![ErrCtxt]-                         , ctl_loc :: !RealSrcSpan-                         , ctl_bndrs :: !TcBinderStack-                         , ctl_tclvl :: !TcLevel-                         , ctl_in_gen_code :: !Bool-                         , ctl_rdr :: !LocalRdrEnv }---getCtLocEnvLoc :: CtLocEnv -> RealSrcSpan-getCtLocEnvLoc = ctl_loc--getCtLocEnvLvl :: CtLocEnv -> TcLevel-getCtLocEnvLvl = ctl_tclvl--setCtLocEnvLvl :: CtLocEnv -> TcLevel -> CtLocEnv-setCtLocEnvLvl env lvl = env { ctl_tclvl = lvl }--setCtLocRealLoc :: CtLocEnv -> RealSrcSpan -> CtLocEnv-setCtLocRealLoc env ss = env { ctl_loc = ss }--setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv--- See Note [Error contexts in generated code]--- for the ctl_in_gen_code manipulation-setCtLocEnvLoc env (RealSrcSpan loc _)-  = env { ctl_loc = loc, ctl_in_gen_code = False }--setCtLocEnvLoc env loc@(UnhelpfulSpan _)-  | isGeneratedSrcSpan loc-  = env { ctl_in_gen_code = True }-  | otherwise-  = env--ctLocEnvInGeneratedCode :: CtLocEnv -> Bool-ctLocEnvInGeneratedCode = ctl_in_gen_code
compiler/GHC/Tc/Types/Evidence.hs view
@@ -39,7 +39,7 @@    -- * TcCoercion   TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole,-  TcMCoercion, TcMCoercionN, TcMCoercionR,+  TcMCoercion, TcMCoercionN, TcMCoercionR, MultiplicityCheckCoercions,   Role(..), LeftOrRight(..), pickLR,   maybeSymCo,   unwrapIP, wrapIP,@@ -70,7 +70,7 @@ import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs   ( exprSomeFreeVars )-import GHC.Core.InstEnv ( Canonical )+import GHC.Core.InstEnv ( CanonicalEvidence(..) )  import GHC.Utils.Misc import GHC.Utils.Panic@@ -110,6 +110,11 @@ type TcMCoercionN = MCoercionN  -- nominal type TcMCoercionR = MCoercionR  -- representational +type MultiplicityCheckCoercions = [TcCoercion]+-- Coercions which must all be reflexivity after zonking.+-- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.++ -- | If a 'SwapFlag' is 'IsSwapped', flip the orientation of a coercion maybeSymCo :: SwapFlag -> TcCoercion -> TcCoercion maybeSymCo IsSwapped  co = mkSymCo co@@ -174,7 +179,7 @@    | WpMultCoercion Coercion     -- Require that a Coercion be reflexive; otherwise,                                 -- error in the desugarer. See GHC.Tc.Utils.Unify-                                -- Note [Wrapper returned from tcSubMult]+                                -- Note [Coercions returned from tcSubMult]   deriving Data.Data  -- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data@@ -466,7 +471,7 @@ data EvBindInfo   = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver     }-  | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence]+  | EvBindWanted { ebi_canonical :: CanonicalEvidence -- See Note [Desugaring non-canonical evidence]     }  -----------------@@ -480,7 +485,7 @@ evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind+mkWantedEvBind :: EvVar -> CanonicalEvidence -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm }  -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm
compiler/GHC/Tc/Types/Origin.hs view
@@ -77,6 +77,7 @@ import GHC.Utils.Panic import GHC.Stack import GHC.Utils.Monad+import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Types.Unique import GHC.Types.Unique.Supply @@ -131,7 +132,7 @@   | RuleSigCtxt FastString Name    -- LHS of a RULE forall                         --    RULE "foo" forall (x :: a -> a). f (Just x) = ...   | ForSigCtxt Name     -- Foreign import or export signature-  | DefaultDeclCtxt     -- Types in a default declaration+  | DefaultDeclCtxt     -- Class or types in a default declaration   | InstDeclCtxt Bool   -- An instance declaration                         --    True:  stand-alone deriving                         --    False: vanilla instance declaration@@ -204,7 +205,7 @@ pprUserTypeCtxt (TySynCtxt c)     = text "the RHS of the type synonym" <+> quotes (ppr c) pprUserTypeCtxt PatSigCtxt        = text "a pattern type signature" pprUserTypeCtxt (ForSigCtxt n)    = text "the foreign declaration for" <+> quotes (ppr n)-pprUserTypeCtxt DefaultDeclCtxt   = text "a type in a `default' declaration"+pprUserTypeCtxt DefaultDeclCtxt   = text "a `default' declaration" pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration" pprUserTypeCtxt (InstDeclCtxt True)  = text "a stand-alone deriving instance declaration" pprUserTypeCtxt SpecInstCtxt      = text "a SPECIALISE instance pragma"@@ -327,10 +328,10 @@ -- -- We're hoping to be able to get rid of this entirely, but for the moment -- it's still needed.-unkSkol :: HasCallStack => SkolemInfo+unkSkol :: HasDebugCallStack => SkolemInfo unkSkol = SkolemInfo (mkUniqueGrimily 0) unkSkolAnon -unkSkolAnon :: HasCallStack => SkolemInfoAnon+unkSkolAnon :: HasDebugCallStack => SkolemInfoAnon unkSkolAnon = UnkSkol callStack  -- | Wrap up the origin of a skolem type variable with a new 'Unique',@@ -446,9 +447,9 @@ * Typically a'' will have a nice pretty name like "a", but the point is   that the foral-bound variables of the signature we report line up with   the instantiated skolems lying  around in other types.-+-} -************************************************************************+{- ********************************************************************* *                                                                      *             CtOrigin *                                                                      *@@ -622,6 +623,7 @@       ClsInst -- ^ The declared typeclass instance    | NonLinearPatternOrigin NonLinearPatternReason (LPat GhcRn)+  | OmittedFieldOrigin (Maybe FieldLabel)   | UsageEnvironmentOf Name    | CycleBreakerOrigin@@ -716,8 +718,7 @@ exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (field_label $ unLoc $ dfoLabel f) exprCtOrigin (HsUnboundVar {})    = Shouldn'tHappenOrigin "unbound variable"-exprCtOrigin (HsRecSel _ f)       = OccurrenceOfRecSel (unLoc $ foLabel f)-exprCtOrigin (HsOverLabel _ _ l)  = OverLabelOrigin l+exprCtOrigin (HsOverLabel _ l)  = OverLabelOrigin l exprCtOrigin (ExplicitList {})    = ListOrigin exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip exprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit@@ -750,10 +751,14 @@ exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression" exprCtOrigin (HsEmbTy {})        = Shouldn'tHappenOrigin "type expression"+exprCtOrigin (HsForAll {})       = Shouldn'tHappenOrigin "forall telescope"    -- See Note [Types in terms]+exprCtOrigin (HsQual {})         = Shouldn'tHappenOrigin "constraint context"  -- See Note [Types in terms]+exprCtOrigin (HsFunArr {})       = Shouldn'tHappenOrigin "function arrow"      -- See Note [Types in terms] exprCtOrigin (XExpr (ExpandedThingRn thing _)) | OrigExpr a <- thing = exprCtOrigin a                                                | OrigStmt _ <- thing = DoOrigin                                                | OrigPat p  <- thing = DoPatOrigin p exprCtOrigin (XExpr (PopErrCtxt {})) = Shouldn'tHappenOrigin "PopErrCtxt"+exprCtOrigin (XExpr (HsRecSelRn f))  = OccurrenceOfRecSel (foExt f)  -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin@@ -895,7 +900,7 @@   = ctoHerald <+> pprCtO simple_origin  -- | Short one-liners-pprCtO :: HasCallStack => CtOrigin -> SDoc+pprCtO :: HasDebugCallStack => CtOrigin -> SDoc pprCtO (OccurrenceOf name)   = hsep [text "a use of", quotes (ppr name)] pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] pprCtO AppOrigin             = text "an application"@@ -932,6 +937,8 @@ pprCtO IfThenElseOrigin      = text "an if-then-else expression" pprCtO StaticOrigin          = text "a static form" pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)]+pprCtO (OmittedFieldOrigin Nothing) = text "an omitted anonymous field"+pprCtO (OmittedFieldOrigin (Just fl)) = hsep [text "omitted field" <+> quotes (ppr fl)] pprCtO BracketOrigin         = text "a quotation bracket"  -- These ones are handled by pprCtOrigin, but we nevertheless sometimes@@ -960,12 +967,13 @@ pprCtO (ImpedanceMatching {})       = text "combining required constraints" pprCtO (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)] -pprNonLinearPatternReason :: HasCallStack => NonLinearPatternReason -> SDoc+pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc pprNonLinearPatternReason LazyPatternReason = parens (text "non-variable lazy pattern aren't linear") pprNonLinearPatternReason GeneralisedPatternReason = parens (text "non-variable pattern bindings that have been generalised aren't linear") pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms aren't linear") pprNonLinearPatternReason ViewPatternReason = parens (text "view patterns aren't linear") pprNonLinearPatternReason OtherPatternReason = empty+  {- ********************************************************************* *                                                                      *
compiler/GHC/Tc/Types/Origin.hs-boot view
@@ -1,7 +1,7 @@ module GHC.Tc.Types.Origin where  import GHC.Prelude.Basic ( Int, Maybe )-import GHC.Stack ( HasCallStack )+import GHC.Utils.Misc ( HasDebugCallStack ) import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type )  data SkolemInfoAnon@@ -16,4 +16,4 @@ mkFRRUnboxedTuple :: Int -> FixedRuntimeRepContext mkFRRUnboxedSum :: Maybe Int -> FixedRuntimeRepContext -unkSkol :: HasCallStack => SkolemInfo+unkSkol :: HasDebugCallStack => SkolemInfo
compiler/GHC/Tc/Types/TH.hs view
@@ -13,7 +13,7 @@   ) where  import GHCi.RemoteTypes-import qualified Language.Haskell.TH as TH+import qualified GHC.Internal.TH.Syntax as TH import GHC.Tc.Types.Evidence import GHC.Utils.Outputable import GHC.Prelude
compiler/GHC/Tc/Utils/TcType.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections       #-}+{-# LANGUAGE MagicHash           #-}+{-# LANGUAGE MultiWayIf          #-}  {- (c) The University of Glasgow 2006@@ -27,7 +29,7 @@   TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder,   TcTyCon, MonoTcTyCon, PolyTcTyCon, TcTyConBinder, KnotTied, -  ExpType(..), InferResult(..),+  ExpType(..), ExpKind, InferResult(..),   ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR,   ExpRhoType,   mkCheckExpType,@@ -55,6 +57,7 @@   ConcreteTyVars, noConcreteTyVars,   isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo,   isFlexi, isIndirect, isRuntimeUnkSkol,+  isQLInstTyVar, isRuntimeUnkTyVar,   metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe,   isTouchableMetaTyVar, isPromotableMetaTyVar,   findDupTyVarTvs, mkTyVarNamePairs,@@ -94,7 +97,7 @@    -- Re-exported from GHC.Core.TyCo.Compare   -- mainly just for back-compat reasons-  eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX,+  eqType, eqTypes, nonDetCmpType, eqTypeX,   pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, mayLookIdentical,   tcEqTyConApps, eqForAllVis, eqVarBndrs, @@ -117,7 +120,7 @@    -- * Finding "exact" (non-dead) type variables   exactTyCoVarsOfType, exactTyCoVarsOfTypes,-  anyRewritableTyVar, anyRewritableTyFamApp,+  anyRewritableTyVar, anyRewritableTyFamApp, UnderFam,    ---------------------------------   -- Patersons sizes@@ -431,8 +434,14 @@ type ExpSigmaTypeFRR = ExpTypeFRR   -- TODO: consider making this a newtype. -type ExpRhoType      = ExpType+type ExpRhoType = ExpType+      -- Invariant: if -XDeepSubsumption is on,+      --            and we are checking (i.e. the ExpRhoType is (Check rho)),+      --            then the `rho` is deeply skolemised +-- | Like 'ExpType', but on kind level+type ExpKind = ExpType+ instance Outputable ExpType where   ppr (Check ty) = text "Check" <> braces (ppr ty)   ppr (Infer ir) = ppr ir@@ -606,7 +615,7 @@            , mtv_ref   :: IORef MetaDetails            , mtv_tclvl :: TcLevel }  -- See Note [TcLevel invariants] -vanillaSkolemTvUnk :: HasCallStack => TcTyVarDetails+vanillaSkolemTvUnk :: HasDebugCallStack => TcTyVarDetails vanillaSkolemTvUnk = SkolemTv unkSkol topTcLevel False  instance Outputable TcTyVarDetails where@@ -672,9 +681,8 @@  -- | A mapping from skolem type variable 'Name' to concreteness information, ----- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head.+-- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete. type ConcreteTyVars = NameEnv ConcreteTvOrigin- -- | The 'Id' has no outer forall'd type variables which must be instantiated -- to concrete types. noConcreteTyVars :: ConcreteTyVars@@ -686,9 +694,11 @@ *                                                                      * ********************************************************************* -} -newtype TcLevel = TcLevel Int deriving( Eq, Ord )+data TcLevel = TcLevel {-# UNPACK #-} !Int+             | QLInstVar   -- See Note [TcLevel invariants] for what this Int is   -- See also Note [TcLevel assignment]+  -- See also Note [The QLInstVar TcLevel]  {- Note [TcLevel invariants]@@ -723,15 +733,36 @@ The level of a MetaTyVar also governs its untouchability.  See Note [Unification preconditions] in GHC.Tc.Utils.Unify. +  -- See also Note [The QLInstVar TcLevel]+ Note [TcLevel assignment] ~~~~~~~~~~~~~~~~~~~~~~~~~ We arrange the TcLevels like this -   0   Top level-   1   First-level implication constraints-   2   Second-level implication constraints+   0          Top level+   1          First-level implication constraints+   2          Second-level implication constraints    ...etc...+   QLInstVar  The level for QuickLook instantiation variables+              See Note [The QLInstVar TcLevel] +Note [The QLInstVar TcLevel]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+QuickLook instantiation variables are identified by having a TcLevel+of QLInstVar.  See Note [Quick Look overview] in GHC.Tc.Gen.App.++The QLInstVar level behaves like infinity: it is greater than any+other TcLevel.  See `strictlyDeeperThan` and friends in this module.+That ensures that we never unify an ordinary unification variable+with a QL instantiation variable, e.g.+      alpha[tau:3] := Maybe beta[tau:qlinstvar]+(This is an immediate consequence of our general rule that we never+unify a variable with a type mentioning deeper variables; the skolem+escape check.)++QL instantation variables are eventually turned into ordinary unificaiton+variables; see (QL3) in Note [Quick Look overview].+ Note [GivenInv] ~~~~~~~~~~~~~~~ Invariant (GivenInv) is not essential, but it is easy to guarantee, and@@ -781,10 +812,18 @@ -}  maxTcLevel :: TcLevel -> TcLevel -> TcLevel-maxTcLevel (TcLevel a) (TcLevel b) = TcLevel (a `max` b)+maxTcLevel (TcLevel a) (TcLevel b)+  | a > b      = TcLevel a+  | otherwise  = TcLevel b+maxTcLevel _ _ = QLInstVar  minTcLevel :: TcLevel -> TcLevel -> TcLevel-minTcLevel (TcLevel a) (TcLevel b) = TcLevel (a `min` b)+minTcLevel tcla@(TcLevel a) tclb@(TcLevel b)+  | a < b                              = tcla+  | otherwise                          = tclb+minTcLevel tcla@(TcLevel {}) QLInstVar = tcla+minTcLevel QLInstVar tclb@(TcLevel {}) = tclb+minTcLevel QLInstVar QLInstVar         = QLInstVar  topTcLevel :: TcLevel -- See Note [TcLevel assignment]@@ -792,29 +831,39 @@  isTopTcLevel :: TcLevel -> Bool isTopTcLevel (TcLevel 0) = True-isTopTcLevel _           = False+isTopTcLevel _            = False  pushTcLevel :: TcLevel -> TcLevel -- See Note [TcLevel assignment] pushTcLevel (TcLevel us) = TcLevel (us + 1)+pushTcLevel QLInstVar    = QLInstVar  strictlyDeeperThan :: TcLevel -> TcLevel -> Bool+-- See Note [The QLInstVar TcLevel] strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl)   = tv_tclvl > ctxt_tclvl+strictlyDeeperThan QLInstVar (TcLevel {})  = True+strictlyDeeperThan _ _                     = False  deeperThanOrSame :: TcLevel -> TcLevel -> Bool+-- See Note [The QLInstVar TcLevel] deeperThanOrSame (TcLevel tv_tclvl) (TcLevel ctxt_tclvl)   = tv_tclvl >= ctxt_tclvl+deeperThanOrSame (TcLevel {}) QLInstVar  = False+deeperThanOrSame QLInstVar    _           = True  sameDepthAs :: TcLevel -> TcLevel -> Bool sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)-  = ctxt_tclvl == tv_tclvl   -- NB: invariant ctxt_tclvl >= tv_tclvl-                             --     So <= would be equivalent+  = ctxt_tclvl == tv_tclvl+    -- NB: invariant ctxt_tclvl >= tv_tclvl+    --     So <= would be equivalent+sameDepthAs QLInstVar QLInstVar = True+sameDepthAs _         _         = False  checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool -- Checks (WantedInv) from Note [TcLevel invariants]-checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)-  = ctxt_tclvl >= tv_tclvl+checkTcLevelInvariant ctxt_tclvl tv_tclvl+  = ctxt_tclvl `deeperThanOrSame` tv_tclvl  -- Returns topTcLevel for non-TcTyVars tcTyVarLevel :: TcTyVar -> TcLevel@@ -837,7 +886,8 @@       | otherwise = lvl  instance Outputable TcLevel where-  ppr (TcLevel us) = ppr us+  ppr (TcLevel n) = ppr n+  ppr QLInstVar   = text "qlinst"  {- ********************************************************************* *                                                                      *@@ -945,10 +995,11 @@ -- ^ Check that a type does not contain any type family applications. isTyFamFree = null . tcTyFamInsts +type UnderFam = Bool   -- True <=> we are in the argument of a type family application+ any_rewritable :: EqRel   -- Ambient role-               -> (EqRel -> TcTyVar -> Bool)           -- check tyvar-               -> (EqRel -> TyCon -> [TcType] -> Bool) -- check type family-               -> (TyCon -> Bool)                      -- expand type synonym?+               -> (UnderFam -> EqRel -> TcTyVar -> Bool)           -- Check tyvar+               -> (UnderFam -> EqRel -> TyCon -> [TcType] -> Bool) -- Check type family application                -> TcType -> Bool -- Checks every tyvar and tyconapp (not including FunTys) within a type, -- ORing the results of the predicates above together@@ -961,66 +1012,79 @@ -- -- See Note [Rewritable] in GHC.Tc.Solver.InertSet for a specification for this function. {-# INLINE any_rewritable #-} -- this allows specialization of predicates-any_rewritable role tv_pred tc_pred should_expand-  = go role emptyVarSet+any_rewritable role tv_pred tc_pred ty+  = go False emptyVarSet role ty   where-    go_tv rl bvs tv | tv `elemVarSet` bvs = False-                    | otherwise           = tv_pred rl tv+    go_tv uf bvs rl tv | tv `elemVarSet` bvs = False+                       | otherwise           = tv_pred uf rl tv -    go rl bvs ty@(TyConApp tc tys)+    go :: UnderFam -> VarSet -> EqRel -> TcType -> Bool+    go under_fam bvs rl (TyConApp tc tys)++      -- Expand synonyms, unless (a) we are at Nominal role and (b) the synonym+      -- is type-family-free; then it suffices just to look at the args       | isTypeSynonymTyCon tc-      , should_expand tc-      , Just ty' <- coreView ty   -- should always match-      = go rl bvs ty'+      , case rl of { NomEq -> not (isFamFreeTyCon tc); ReprEq -> True }+      , Just ty' <- expandSynTyConApp_maybe tc tys+      = go under_fam bvs rl ty' -      | tc_pred rl tc tys-      = True+      -- Check if we are going under a type family application+      | case rl of+           NomEq  -> isTypeFamilyTyCon tc+           ReprEq -> isFamilyTyCon     tc+      = if | tc_pred under_fam rl tc tys -> True+           | otherwise                   -> go_fam under_fam (tyConArity tc) bvs tys        | otherwise-      = go_tc rl bvs tc tys+      = go_tc under_fam bvs rl tc tys -    go rl bvs (TyVarTy tv)       = go_tv rl bvs tv-    go _ _     (LitTy {})        = False-    go rl bvs (AppTy fun arg)    = go rl bvs fun || go NomEq bvs arg-    go rl bvs (FunTy _ w arg res)  = go NomEq bvs arg_rep || go NomEq bvs res_rep ||-                                     go rl bvs arg || go rl bvs res || go NomEq bvs w+    go uf bvs rl (TyVarTy tv)        = go_tv uf bvs rl tv+    go _  _    _ (LitTy {})          = False+    go uf bvs rl (AppTy fun arg)     = go uf bvs rl fun || go uf bvs NomEq arg+    go uf bvs rl (FunTy _ w arg res) = go uf bvs NomEq arg_rep || go uf bvs NomEq res_rep ||+                                       go uf bvs rl arg || go uf bvs rl res || go uf bvs NomEq w       where arg_rep = getRuntimeRep arg -- forgetting these causes #17024             res_rep = getRuntimeRep res-    go rl bvs (ForAllTy tv ty)   = go rl (bvs `extendVarSet` binderVar tv) ty-    go rl bvs (CastTy ty _)      = go rl bvs ty-    go _  _   (CoercionTy _)     = False+    go uf bvs rl (ForAllTy tv ty)   = go uf (bvs `extendVarSet` binderVar tv) rl ty+    go uf bvs rl (CastTy ty _)      = go uf bvs rl ty+    go _  _   _  (CoercionTy _)     = False -    go_tc NomEq  bvs _  tys = any (go NomEq bvs) tys-    go_tc ReprEq bvs tc tys = any (go_arg bvs)-                              (tyConRoleListRepresentational tc `zip` tys)+    go_tc :: UnderFam -> VarSet -> EqRel -> TyCon -> [TcType] -> Bool+    go_tc uf bvs NomEq  _  tys = any (go uf bvs NomEq) tys+    go_tc uf bvs ReprEq tc tys = any2 (go_arg uf bvs) tys (tyConRoleListRepresentational tc) -    go_arg bvs (Nominal,          ty) = go NomEq  bvs ty-    go_arg bvs (Representational, ty) = go ReprEq bvs ty-    go_arg _   (Phantom,          _)  = False  -- We never rewrite with phantoms+    go_arg uf bvs ty Nominal          = go uf bvs NomEq ty+    go_arg uf bvs ty Representational = go uf bvs ReprEq ty+    go_arg _   _  _  Phantom          = False  -- We never rewrite with phantoms +    -- For a type-family or data-family application (F t1 .. tn), all arguments+    --   have Nominal role (whether in F's arity or, if over-saturated, beyond it)+    -- Switch on under_fam for arguments <= arity+    go_fam uf 0 bvs tys      = any (go uf bvs NomEq) tys   -- Like AppTy+    go_fam _  _ _   []       = False+    go_fam uf n bvs (ty:tys) = go True bvs NomEq ty || go_fam uf (n-1) bvs tys+                               -- True <=> switch on under_fam+ anyRewritableTyVar :: EqRel    -- Ambient role-                   -> (EqRel -> TcTyVar -> Bool)  -- check tyvar+                   -> (UnderFam -> EqRel -> TcTyVar -> Bool)  -- check tyvar                    -> TcType -> Bool -- See Note [Rewritable] in GHC.Tc.Solver.InertSet for a specification for this function.-anyRewritableTyVar role pred-  = any_rewritable role pred-      (\ _ _ _ -> False) -- no special check for tyconapps-                         -- (this False is ORed with other results, so it-                         --  really means "do nothing special"; the arguments-                         --   are still inspected)-      (\ _ -> False)     -- don't expand synonyms-    -- NB: No need to expand synonyms, because we can find-    -- all free variables of a synonym by looking at its-    -- arguments+anyRewritableTyVar role check_tv+  = any_rewritable role+      check_tv+      (\ _ _ _ _ -> False) -- No special check for tyconapps+                           -- (this False is ORed with other results,+                           --  so it really means "do nothing special";+                           --  the arguments are still inspected)  anyRewritableTyFamApp :: EqRel   -- Ambient role-                      -> (EqRel -> TyCon -> [TcType] -> Bool) -- check tyconapp-                          -- should return True only for type family applications+                      -> (UnderFam -> EqRel -> TyCon -> [TcType] -> Bool)+                         -- Check a type-family application                       -> TcType -> Bool   -- always ignores casts & coercions -- See Note [Rewritable] in GHC.Tc.Solver.InertSet for a specification for this function. anyRewritableTyFamApp role check_tyconapp-  = any_rewritable role (\ _ _ -> False) check_tyconapp (not . isFamFreeTyCon)+  = any_rewritable role (\ _ _ _ -> False) check_tyconapp  {- Note [anyRewritableTyVar must be role-aware] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1169,6 +1233,18 @@         _             -> False   | otherwise = False +isQLInstTyVar :: TcTyVar -> Bool+isQLInstTyVar tv+  = case tcTyVarDetails tv of+      MetaTv { mtv_tclvl = QLInstVar } -> True+      _                                -> False++isRuntimeUnkTyVar :: TcTyVar -> Bool+isRuntimeUnkTyVar tv+  = case tcTyVarDetails tv of+      MetaTv { mtv_info = RuntimeUnkTv } -> True+      _                                  -> False+ isCycleBreakerTyVar tv   | isTyVar tv -- See Note [Coercion variables in free variable lists]   , MetaTv { mtv_info = CycleBreakerTv } <- tcTyVarDetails tv@@ -1908,10 +1984,7 @@   isRhoTy :: TcType -> Bool   -- True of TcRhoTypes; see Note [TcRhoType]-isRhoTy (ForAllTy (Bndr _ af) _)     = isVisibleForAllTyFlag af-isRhoTy (FunTy { ft_af = af })       = isVisibleFunArg af-isRhoTy ty | Just ty' <- coreView ty = isRhoTy ty'-isRhoTy _                            = True+isRhoTy ty = not (isSigmaTy ty)  -- | Like 'isRhoTy', but also says 'True' for 'Infer' types isRhoExpTy :: ExpType -> Bool
compiler/GHC/Tc/Utils/TcType.hs-boot view
@@ -1,16 +1,16 @@ module GHC.Tc.Utils.TcType where import GHC.Utils.Outputable( SDoc )+import GHC.Utils.Misc( HasDebugCallStack ) import GHC.Prelude ( Bool ) import {-# SOURCE #-} GHC.Types.Var ( TcTyVar ) import {-# SOURCE #-} GHC.Tc.Types.Origin ( FixedRuntimeRepOrigin ) import GHC.Types.Name.Env ( NameEnv )-import GHC.Stack  data MetaDetails  data TcTyVarDetails pprTcTyVarDetails :: TcTyVarDetails -> SDoc-vanillaSkolemTvUnk :: HasCallStack => TcTyVarDetails+vanillaSkolemTvUnk :: HasDebugCallStack => TcTyVarDetails isMetaTyVar :: TcTyVar -> Bool isTyConableTyVar :: TcTyVar -> Bool
compiler/GHC/Tc/Zonk/Monad.hs view
@@ -9,7 +9,7 @@ module GHC.Tc.Zonk.Monad   ( -- * The 'ZonkM' monad, a stripped down 'TcM' for zonking     ZonkM(ZonkM,runZonkM)-  , ZonkGblEnv(..), getZonkGblEnv+  , ZonkGblEnv(..), getZonkGblEnv, getZonkTcLevel     -- ** Logging within 'ZonkM'   , traceZonk@@ -96,6 +96,9 @@ getZonkGblEnv :: ZonkM ZonkGblEnv getZonkGblEnv = ZonkM return {-# INLINE getZonkGblEnv #-}++getZonkTcLevel :: ZonkM TcLevel+getZonkTcLevel = ZonkM (\env -> return (zge_tc_level env))  -- | Same as 'traceTc', but for the 'ZonkM' monad. traceZonk :: String -> SDoc -> ZonkM ()
compiler/GHC/Types/Avail.hs view
@@ -1,5 +1,7 @@  {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE PatternSynonyms #-} -- -- (c) The University of Glasgow --@@ -19,6 +21,8 @@     filterAvail,     filterAvails,     nubAvails,+    sortAvails,+    DetOrdAvails(DetOrdAvails, DefinitelyDeterministicAvails)   ) where  import GHC.Prelude@@ -36,7 +40,7 @@ import Control.DeepSeq import Data.Data ( Data ) import Data.Functor.Classes ( liftCompare )-import Data.List ( find )+import Data.List ( find, sortBy ) import qualified Data.Semigroup as S  -- -----------------------------------------------------------------------------@@ -64,6 +68,20 @@ -- | A collection of 'AvailInfo' - several things that are \"available\" type Avails = [AvailInfo] +-- | Occurrences of Avails in interface files must be deterministically ordered+-- to guarantee interface file determinism.+--+-- We guarantee a deterministic order by either using the order explicitly+-- given by the user (e.g. in an explicit constructor export list) or instead+-- by sorting the avails with 'sortAvails'.+newtype DetOrdAvails = DefinitelyDeterministicAvails Avails+  deriving newtype (Binary, Outputable, NFData)++-- | It's always safe to match on 'DetOrdAvails'+pattern DetOrdAvails :: Avails -> DetOrdAvails+pattern DetOrdAvails x <- DefinitelyDeterministicAvails x+{-# COMPLETE DetOrdAvails #-}+ {- Note [Representing pattern synonym fields in AvailInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Record pattern synonym fields cannot be represented using AvailTC like fields of@@ -130,6 +148,20 @@ availSubordinateNames avail@(AvailTC _ ns)   | availExportsDecl avail = tail ns   | otherwise              = ns++-- | Sort 'Avails'/'AvailInfo's+sortAvails :: Avails -> DetOrdAvails+sortAvails = DefinitelyDeterministicAvails . sortBy stableAvailCmp . map sort_subs+  where+    sort_subs :: AvailInfo -> AvailInfo+    sort_subs (Avail n) = Avail n+    sort_subs (AvailTC n []) = AvailTC n []+    sort_subs (AvailTC n (m:ms))+       | n == m+       = AvailTC n (m:sortBy stableNameCmp ms)+       | otherwise+       = AvailTC n (sortBy stableNameCmp (m:ms))+       -- Maintain the AvailTC Invariant  -- ----------------------------------------------------------------------------- -- Utility
compiler/GHC/Types/Basic.hs view
@@ -80,7 +80,7 @@         EP(..),          DefMethSpec(..),-        SwapFlag(..), flipSwap, unSwap, isSwapped,+        SwapFlag(..), flipSwap, unSwap, notSwapped, isSwapped, pickSwap,          CompilerPhase(..), PhaseNum, beginPhase, nextPhase, laterPhase, @@ -148,7 +148,7 @@ ********************************************************************* -}  data LeftOrRight = CLeft | CRight-                 deriving( Eq, Data )+                 deriving( Eq, Data, Ord )  pickLR :: LeftOrRight -> (a,a) -> a pickLR CLeft  (l,_) = l@@ -456,6 +456,7 @@ data SwapFlag   = NotSwapped  -- Args are: actual,   expected   | IsSwapped   -- Args are: expected, actual+  deriving( Eq )  instance Outputable SwapFlag where   ppr IsSwapped  = text "Is-swapped"@@ -469,6 +470,14 @@ isSwapped IsSwapped  = True isSwapped NotSwapped = False +notSwapped :: SwapFlag -> Bool+notSwapped NotSwapped = True+notSwapped IsSwapped  = False++pickSwap :: SwapFlag -> a -> a -> a+pickSwap NotSwapped a _ = a+pickSwap IsSwapped  _ b = b+ unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b unSwap NotSwapped f a b = f a b unSwap IsSwapped  f a b = f b a@@ -752,14 +761,7 @@ -- instance. See Note [Safe Haskell isSafeOverlap] in GHC.Core.InstEnv for a -- explanation of the `isSafeOverlap` field. ----- - 'GHC.Parser.Annotation.AnnKeywordId' :---      'GHC.Parser.Annotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or---                              @'\{-\# OVERLAPPING'@ or---                              @'\{-\# OVERLAPS'@ or---                              @'\{-\# INCOHERENT'@,---      'GHC.Parser.Annotation.AnnClose' @`\#-\}`@, --- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation" data OverlapFlag = OverlapFlag   { overlapMode   :: OverlapMode   , isSafeOverlap :: Bool@@ -1010,7 +1012,7 @@   = BoxedTuple   | UnboxedTuple   | ConstraintTuple-  deriving( Eq, Data )+  deriving( Eq, Data, Ord )  instance Outputable TupleSort where   ppr ts = text $@@ -1571,7 +1573,7 @@  data InlinePragma            -- Note [InlinePragma]   = InlinePragma-      { inl_src    :: SourceText -- Note [Pragma source text]+      { inl_src    :: SourceText -- See Note [Pragma source text]       , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]        , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
compiler/GHC/Types/CompleteMatch.hs view
@@ -1,40 +1,63 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}  -- | COMPLETE signature-module GHC.Types.CompleteMatch where+module GHC.Types.CompleteMatch+  ( CompleteMatchX(..)+  , CompleteMatch, CompleteMatches+  , DsCompleteMatch, DsCompleteMatches+  , mkCompleteMatch, vanillaCompleteMatch+  , completeMatchAppliesAtType+  ) where  import GHC.Prelude import GHC.Core.TyCo.Rep-import GHC.Types.Unique.DSet+import GHC.Types.Unique import GHC.Core.ConLike import GHC.Core.TyCon import GHC.Core.Type ( splitTyConApp_maybe )+import GHC.Types.Name ( Name )+import GHC.Types.Unique.DSet import GHC.Utils.Outputable +type CompleteMatch   = CompleteMatchX Name+type DsCompleteMatch = CompleteMatchX ConLike++type CompleteMatches   = [CompleteMatch]+type DsCompleteMatches = [DsCompleteMatch]+ -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. -- See also Note [Implementation of COMPLETE pragmas].-data CompleteMatch = CompleteMatch-  { cmConLikes :: UniqDSet ConLike -- ^ The set of `ConLike` values-  , cmResultTyCon :: Maybe TyCon   -- ^ The optional, concrete result TyCon the set applies to+data CompleteMatchX con = CompleteMatch+  { cmConLikes :: UniqDSet con  -- ^ The set of constructor names+  , cmResultTyCon :: Maybe Name -- ^ The optional, concrete result TyCon name the set applies to   }+  deriving Eq -vanillaCompleteMatch :: UniqDSet ConLike -> CompleteMatch-vanillaCompleteMatch cls = CompleteMatch { cmConLikes = cls, cmResultTyCon = Nothing }+mkCompleteMatch :: UniqDSet con -> Maybe Name -> CompleteMatchX con+mkCompleteMatch nms mb_tc = CompleteMatch { cmConLikes = nms, cmResultTyCon = mb_tc } -instance Outputable CompleteMatch where+vanillaCompleteMatch :: UniqDSet con -> CompleteMatchX con+vanillaCompleteMatch nms = mkCompleteMatch nms Nothing++instance Outputable con => Outputable (CompleteMatchX con) where   ppr (CompleteMatch cls mty) = case mty of     Nothing -> ppr cls     Just ty -> ppr cls <> text "@" <> parens (ppr ty) -type CompleteMatches = [CompleteMatch]--completeMatchAppliesAtType :: Type -> CompleteMatch -> Bool-completeMatchAppliesAtType ty cm = all @Maybe ty_matches (cmResultTyCon cm)+-- | Does this 'COMPLETE' set apply at this type?+--+-- See the part about "result type constructors" in+-- Note [Implementation of COMPLETE pragmas] in GHC.HsToCore.Pmc.Solver.+completeMatchAppliesAtType :: Type -> CompleteMatchX con -> Bool+completeMatchAppliesAtType ty cm = all @Maybe ty_matches (getUnique <$> cmResultTyCon cm)   where+    ty_matches :: Unique -> Bool     ty_matches sig_tc       | Just (tc, _arg_tys) <- splitTyConApp_maybe ty-      , tc == sig_tc+      , tc `hasKey` sig_tc       || sig_tc `is_family_ty_con_of` tc          -- #24326: sig_tc might be the data Family TyCon of the representation          --         TyCon tc -- this CompleteMatch still applies@@ -42,4 +65,6 @@       | otherwise       = False     fam_tc `is_family_ty_con_of` repr_tc =-      (fst <$> tyConFamInst_maybe repr_tc) == Just fam_tc+      case fst <$> tyConFamInst_maybe repr_tc of+        Just tc -> tc `hasKey` fam_tc+        Nothing -> False
compiler/GHC/Types/CostCentre.hs view
@@ -4,6 +4,7 @@         CostCentre(..), CcName, CCFlavour,         mkCafFlavour, mkExprCCFlavour, mkDeclCCFlavour, mkHpcCCFlavour,         mkLateCCFlavour, mkCallerCCFlavour,+        getAllCAFsCC,          pprCostCentre,         CostCentreStack,@@ -393,3 +394,13 @@     -- ok, because we only need the SrcSpan when declaring the     -- CostCentre in the original module, it is not used by importing     -- modules.++getAllCAFsCC :: Module -> (CostCentre, CostCentreStack)+getAllCAFsCC this_mod =+    let+      span = mkGeneralSrcSpan (mkFastString "<entire-module>") -- XXX do better+      all_cafs_cc  = mkAllCafsCC this_mod span+      all_cafs_ccs = mkSingletonCCS all_cafs_cc+    in+      (all_cafs_cc, all_cafs_ccs)+
+ compiler/GHC/Types/DefaultEnv.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DeriveDataTypeable #-}++module GHC.Types.DefaultEnv+   ( ClassDefaults (..)+   , DefaultEnv+   , emptyDefaultEnv+   , isEmptyDefaultEnv+   , defaultEnv+   , unitDefaultEnv+   , lookupDefaultEnv+   , filterDefaultEnv+   , defaultList+   , plusDefaultEnv+   )+where++import GHC.Prelude+import GHC.Core.TyCon (TyCon(tyConName))+import GHC.Core.TyCon.Env (TyConEnv, emptyTyConEnv, isEmptyTyConEnv, mkTyConEnvWith, unitTyConEnv,+                           filterTyConEnv, nonDetTyConEnvElts, plusTyConEnv)+import GHC.Hs.Extension (GhcRn)+import GHC.Tc.Utils.TcType (Type)+import GHC.Types.Name (Name, nameUnique, stableNameCmp)+import GHC.Types.Unique.FM (lookupUFM_Directly)+import GHC.Unit.Module.Warnings (WarningTxt)+import GHC.Unit.Types (Module)+import GHC.Utils.Outputable++import Data.Data (Data)+import Data.List (sortBy)+import Data.Function (on)++-- See Note [Named default declarations] in GHC.Tc.Gen.Default+-- | Default environment mapping class @TyCon@s to their default type lists+type DefaultEnv = TyConEnv ClassDefaults++data ClassDefaults+  = ClassDefaults { cd_class   :: !TyCon  -- ^ always a class constructor+                  , cd_types   :: [Type]+                  , cd_module :: Maybe Module+                    -- ^ @Nothing@ for built-in,+                    -- @Just@ the current module or the module whence the default was imported+                    -- see Note [Default exports] in GHC.Tc.Gen.Export+                  , cd_warn    :: Maybe (WarningTxt GhcRn)+                    -- ^ Warning emitted when the default is used+                  }+  deriving Data++instance Outputable ClassDefaults where+  ppr ClassDefaults {cd_class = cls, cd_types = tys} = text "default" <+> ppr cls <+> parens (interpp'SP tys)++emptyDefaultEnv :: DefaultEnv+emptyDefaultEnv = emptyTyConEnv++isEmptyDefaultEnv :: DefaultEnv -> Bool+isEmptyDefaultEnv = isEmptyTyConEnv++unitDefaultEnv :: ClassDefaults -> DefaultEnv+unitDefaultEnv d = unitTyConEnv (cd_class d) d++defaultEnv :: [ClassDefaults] -> DefaultEnv+defaultEnv = mkTyConEnvWith cd_class++defaultList :: DefaultEnv -> [ClassDefaults]+defaultList = sortBy (stableNameCmp `on` (tyConName . cd_class)) . nonDetTyConEnvElts+              -- sortBy recovers determinism++lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults+lookupDefaultEnv env = lookupUFM_Directly env . nameUnique++filterDefaultEnv :: (ClassDefaults -> Bool) -> DefaultEnv -> DefaultEnv+filterDefaultEnv = filterTyConEnv++plusDefaultEnv :: DefaultEnv -> DefaultEnv -> DefaultEnv+plusDefaultEnv = plusTyConEnv
compiler/GHC/Types/Demand.hs view
@@ -1,3 +1,4 @@+ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE PatternSynonyms #-}@@ -38,7 +39,7 @@     lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd,     -- ** Other @Demand@ operations     oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, lazifyDmd, floatifyDmd,-    peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds,+    peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds, strictCallArity,     mkWorkerDemand, subDemandIfEvaluated,     -- ** Extracting one-shot information     callCards, argOneShots, argsOneShots, saturatedByOneShots,@@ -50,7 +51,7 @@      -- * Demand environments     DmdEnv(..), addVarDmdEnv, mkTermDmdEnv, nopDmdEnv, plusDmdEnv, plusDmdEnvs,-    reuseEnv,+    multDmdEnv, reuseEnv,      -- * Demand types     DmdType(..), dmdTypeDepth,@@ -605,22 +606,8 @@ --   * How many times a variable is evaluated, via a 'Card'inality, and --   * How deep its value was evaluated in turn, via a 'SubDemand'. ----- Examples (using Note [Demand notation]):------   * 'seq' puts demand `1A` on its first argument: It evaluates the argument---     strictly (`1`), but not any deeper (`A`).---   * 'fst' puts demand `1P(1L,A)` on its argument: It evaluates the argument---     pair strictly and the first component strictly, but no nested info---     beyond that (`L`). Its second argument is not used at all.---   * '$' puts demand `1C(1,L)` on its first argument: It calls (`C`) the---     argument function with one argument, exactly once (`1`). No info---     on how the result of that call is evaluated (`L`).---   * 'maybe' puts demand `MC(M,L)` on its second argument: It evaluates---     the argument function at most once ((M)aybe) and calls it once when---     it is evaluated.---   * `fst p + fst p` puts demand `SP(SL,A)` on `p`: It's `1P(1L,A)`---     multiplied by two, so we get `S` (used at least once, possibly multiple---     times).+-- See also Note [Demand notation]+-- and Note [Demand examples]. -- -- This data type is quite similar to `'Scaled' 'SubDemand'`, but it's scaled -- by 'Card', which is an /interval/ on 'Multiplicity', the upper bound of@@ -1042,6 +1029,12 @@     go _ _  _                          = (topCard, topSubDmd) {-# INLINE peelManyCalls #-} -- so that the pair cancels away in a `fst _` context +strictCallArity :: SubDemand -> Arity+strictCallArity sd = go 0 sd+  where+    go n (Call card sd) | isStrict card = go (n+1) sd+    go n _                              = n+ -- | Extract the 'SubDemand' of a 'Demand'. -- PRECONDITION: The SubDemand must be used in a context where the expression -- denoted by the Demand is under evaluation.@@ -1903,10 +1896,11 @@ splitDmdTy ty@DmdType{dt_env=env}       = (defaultArgDmd (de_div env), ty)  multDmdType :: Card -> DmdType -> DmdType-multDmdType n (DmdType fv args)+multDmdType C_11 dmd_ty = dmd_ty -- a vital optimisation for T25196+multDmdType n    (DmdType fv args)   = -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $     DmdType (multDmdEnv n fv)-            (map (multDmd n) args)+            (strictMap (multDmd n) args)  peelFV :: DmdType -> Var -> (DmdType, Demand) peelFV (DmdType fv ds) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)@@ -2078,6 +2072,12 @@ *                                                                      * ************************************************************************ +Note [DmdSig: demand signatures, and demand-sig arity]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+See also+  * Note [Demand signatures semantically]+  * Note [Understanding DmdType and DmdSig]+ In a let-bound Id we record its demand signature. In principle, this demand signature is a demand transformer, mapping a demand on the Id into a DmdType, which gives@@ -2088,20 +2088,22 @@  However, in fact we store in the Id an extremely emasculated demand transformer, namely--                a single DmdType+        a single DmdType (Nevertheless we dignify DmdSig as a distinct type.) -This DmdType gives the demands unleashed by the Id when it is applied-to as many arguments as are given in by the arg demands in the DmdType.+The DmdSig for an Id is a semantic thing.  Suppose a function `f` has a DmdSig of+  DmdSig (DmdType (fv_dmds,res) [d1..dn])+Here `n` is called the "demand-sig arity" of the DmdSig.  The signature means:+  * If you apply `f` to n arguments (the demand-sig-arity)+  * then you can unleash demands d1..dn on the arguments+  * and demands fv_dmds on the free variables. Also see Note [Demand type Divergence] for the meaning of a Divergence in a-strictness signature.+demand signature. -If an Id is applied to less arguments than its arity, it means that-the demand on the function at a call site is weaker than the vanilla-call demand, used for signature inference. Therefore we place a top-demand on all arguments. Otherwise, the demand is specified by Id's-signature.+If `f` is applied to fewer value arguments than its demand-sig arity, it means+that the demand on the function at a call site is weaker than the vanilla call+demand, used for signature inference. Therefore we place a top demand on all+arguments.  For example, the demand transformer described by the demand signature         DmdSig (DmdType {x -> <1L>} <A><1P(L,L)>)@@ -2112,6 +2114,61 @@ If this same function is applied to one arg, all we can say is that it uses x with 1L, and its arg with demand 1P(L,L). +Note [Demand signatures semantically]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Demand analysis interprets expressions in the abstract domain of demand+transformers. Given a (sub-)demand that denotes the evaluation context, the+abstract transformer of an expression gives us back a demand type denoting+how other things (like arguments and free vars) were used when the expression+was evaluated. Here's an example:++  f x y =+    if x + expensive+      then \z -> z + y * ...+      else \z -> z * ...++The abstract transformer (let's call it F_e) of the if expression (let's+call it e) would transform an incoming (undersaturated!) head sub-demand A+into a demand type like {x-><1L>,y-><L>}<L>. In pictures:++     SubDemand ---F_e---> DmdType+     <A>                  {x-><1L>,y-><L>}<L>++Let's assume that the demand transformers we compute for an expression are+correct wrt. to some concrete semantics for Core. How do demand signatures fit+in? They are strange beasts, given that they come with strict rules when to+it's sound to unleash them.++Fortunately, we can formalise the rules with Galois connections. Consider+f's strictness signature, {}<1L><L>. It's a single-point approximation of+the actual abstract transformer of f's RHS for arity 2. So, what happens is that+we abstract *once more* from the abstract domain we already are in, replacing+the incoming Demand by a simple lattice with two elements denoting incoming+arity: A_2 = {<2, >=2} (where '<2' is the top element and >=2 the bottom+element). Here's the diagram:++     A_2 -----f_f----> DmdType+      ^                   |+      | α               γ |+      |                   v+  SubDemand --F_f----> DmdType++With+  α(C(1,C(1,_))) = >=2+  α(_)         =  <2+  γ(ty)        =  ty+and F_f being the abstract transformer of f's RHS and f_f being the abstracted+abstract transformer computable from our demand signature simply by++  f_f(>=2) = {}<1L><L>+  f_f(<2)  = multDmdType C_0N {}<1L><L>++where multDmdType makes a proper top element out of the given demand type.++In practice, the A_n domain is not just a simple Bool, but a Card, which is+exactly the Card with which we have to multDmdType. The Card for arity n+is computed by calling @peelManyCalls n@, which corresponds to α above.+ Note [Understanding DmdType and DmdSig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Demand types are sound approximations of an expression's semantics relative to@@ -2124,10 +2181,10 @@ put that expression under. Note the monotonicity; a stronger incoming demand yields a more precise demand type: -    incoming demand   |  demand type+    incoming sub-demand   |  demand type     ---------------------------------    1A                  |  <L><L>{}-    C(1,C(1,L))           |  <1P(L)><L>{}+    P(A)                  |  <L><L>{}+    C(1,C(1,P(L)))        |  <1P(L)><L>{}     C(1,C(1,1P(1P(L),A))) |  <1P(A)><A>{}  Note that in the first example, the depth of the demand type was *higher* than@@ -2148,11 +2205,11 @@   * A demand type that is sound to unleash when the minimum arity requirement is     met. -Here comes the subtle part: The threshold is encoded in the wrapped demand-type's depth! So in mkDmdSigForArity we make sure to trim the list of-argument demands to the given threshold arity. Call sites will make sure that-this corresponds to the arity of the call demand that elicited the wrapped-demand type. See also Note [What are demand signatures?].+Here comes the subtle part: The threshold is encoded in the demand-sig arity!+So in mkDmdSigForArity we make sure to trim the list of argument demands to the+given threshold arity. Call sites will make sure that this corresponds to the+arity of the call demand that elicited the wrapped demand type. See also+Note [DmdSig: demand signatures, and demand-sig arity] -}  -- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe@@ -2165,9 +2222,11 @@ -- | Turns a 'DmdType' computed for the particular 'Arity' into a 'DmdSig' -- unleashable at that arity. See Note [Understanding DmdType and DmdSig]. mkDmdSigForArity :: Arity -> DmdType -> DmdSig-mkDmdSigForArity arity dmd_ty@(DmdType fvs args)-  | arity < dmdTypeDepth dmd_ty = DmdSig $ DmdType fvs (take arity args)-  | otherwise                   = DmdSig (etaExpandDmdType arity dmd_ty)+mkDmdSigForArity threshold_arity dmd_ty@(DmdType fvs args)+  | threshold_arity < dmdTypeDepth dmd_ty+  = DmdSig $ DmdType (fvs { de_div = topDiv }) (take threshold_arity args)+  | otherwise+  = DmdSig (etaExpandDmdType threshold_arity dmd_ty)  mkClosedDmdSig :: [Demand] -> Divergence -> DmdSig mkClosedDmdSig ds div = mkDmdSigForArity (length ds) (DmdType (mkEmptyDmdEnv div) ds)@@ -2312,7 +2371,7 @@ -- whether it diverges. -- -- See Note [Understanding DmdType and DmdSig]--- and Note [What are demand signatures?].+-- and Note [DmdSig: demand signatures, and demand-sig arity] type DmdTransformer = SubDemand -> DmdType  -- | Extrapolate a demand signature ('DmdSig') into a 'DmdTransformer'.@@ -2323,7 +2382,7 @@ dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds)) sd   = multDmdType (fst $ peelManyCalls (length arg_ds) sd) dmd_ty     -- see Note [Demands from unsaturated function calls]-    -- and Note [What are demand signatures?]+    -- and Note [DmdSig: demand signatures, and demand-sig arity]  -- | A special 'DmdTransformer' for data constructors that feeds product -- demands into the constructor arguments.@@ -2361,61 +2420,6 @@ dmdTransformDictSelSig sig sd = pprPanic "dmdTransformDictSelSig: no args" (ppr sig $$ ppr sd)  {--Note [What are demand signatures?]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Demand analysis interprets expressions in the abstract domain of demand-transformers. Given a (sub-)demand that denotes the evaluation context, the-abstract transformer of an expression gives us back a demand type denoting-how other things (like arguments and free vars) were used when the expression-was evaluated. Here's an example:--  f x y =-    if x + expensive-      then \z -> z + y * ...-      else \z -> z * ...--The abstract transformer (let's call it F_e) of the if expression (let's-call it e) would transform an incoming (undersaturated!) head demand 1A into-a demand type like {x-><1L>,y-><L>}<L>. In pictures:--     Demand ---F_e---> DmdType-     <1A>              {x-><1L>,y-><L>}<L>--Let's assume that the demand transformers we compute for an expression are-correct wrt. to some concrete semantics for Core. How do demand signatures fit-in? They are strange beasts, given that they come with strict rules when to-it's sound to unleash them.--Fortunately, we can formalise the rules with Galois connections. Consider-f's strictness signature, {}<1L><L>. It's a single-point approximation of-the actual abstract transformer of f's RHS for arity 2. So, what happens is that-we abstract *once more* from the abstract domain we already are in, replacing-the incoming Demand by a simple lattice with two elements denoting incoming-arity: A_2 = {<2, >=2} (where '<2' is the top element and >=2 the bottom-element). Here's the diagram:--     A_2 -----f_f----> DmdType-      ^                   |-      | α               γ |-      |                   v-  SubDemand --F_f----> DmdType--With-  α(C(1,C(1,_))) = >=2-  α(_)         =  <2-  γ(ty)        =  ty-and F_f being the abstract transformer of f's RHS and f_f being the abstracted-abstract transformer computable from our demand signature simply by--  f_f(>=2) = {}<1L><L>-  f_f(<2)  = multDmdType C_0N {}<1L><L>--where multDmdType makes a proper top element out of the given demand type.--In practice, the A_n domain is not just a simple Bool, but a Card, which is-exactly the Card with which we have to multDmdType. The Card for arity n-is computed by calling @peelManyCalls n@, which corresponds to α above.- Note [Demand transformer for a dictionary selector] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have a superclass selector 'sc_sel' and a class method@@ -2639,12 +2643,8 @@ but it's always clear from context which "overload" is meant. It's like return-type inference of e.g. 'read'. -Examples are in the haddock for 'Demand'.  Here are some more:-   SA                 Strict, but does not look at subcomponents (`seq`)-   SP(L,L)            Strict boxed pair, components lazy-   S!P(L,L)           Strict unboxed pair, components lazy-   LP(SA,SA)          Lazy pair, but if it is evaluated will evaluated its components-   LC(1C(L))          Lazy, but if called will apply the result exactly once+An example of the demand syntax is 1!P(1!L,A), the demand of fst's argument.+See Note [Demand examples] for more examples and their semantics.  This is the syntax for demand signatures: @@ -2662,7 +2662,39 @@            (omitted if empty)                     (omitted if                                                 no information) +Note [Demand examples]+~~~~~~~~~~~~~~~~~~~~~~+Here are some examples of the demand notation, specified in Note [Demand notation],+in action. In each case we give the demand on the variable `x`. +Demand on x    Example            Explanation+  1!A           seq x y             Evaluates `x` exactly once (`1`), but not+                                    any deeper (`A`), and discards the box (`!`).+  S!A           seq x (seq x y)     Twice the previous demand; hence eval'd+                                    more than once (`S` for strict).+  1!P(1!L,A)    fst x               Evaluates pair `x` exactly once, first+                                    component exactly once. No info that (`L`).+                                    Second component is absent. Discards boxes (`!`).+  1P(1L,A)      opq_fst x           Like fst, but all boxes are retained.+  SP(1!L,A)     opq_seq x (fst x)   Two evals of x but exactly one of its first component.+                                    Box of x retained, but box of first component discarded.+  1!C(1,L)      x $ 3               Evals x exactly once ( 1 ) and calls it+                                    exactly once ( C(1,_) ). No info on how the+                                    result is evaluated ( L ).+  MC(M,L)       maybe y x           Evals x at most once ( 1 ) and calls it at+                                    most once ( C(1,_) ). No info on how the+                                    result is evaluated ( L ).+  LP(SL,A)      map (+ fst x)       Evals x lazily and multiple times ( L ),+                                    but when it is evaluated, the first+                                    component is evaluated (strictly) as well.++In the examples above, `opq_fst` is an opaque wrapper around `fst`, i.e.++  opq_fst = fst+  {-# OPAQUE opq_fst #-}++Similarly for `seq`. The effect of an OPAQUE pragma is that it discards any+boxity flags in the demand signature, as described in Note [OPAQUE pragma]. -}  -- | See Note [Demand notation]
compiler/GHC/Types/Error.hs view
@@ -100,19 +100,23 @@ import GHC.Types.Hint import GHC.Data.FastString (unpackFS) import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)++import GHC.Types.Hint.Ppr () -- Outputable instance+import GHC.Unit.Module.Warnings (WarningCategory(..))+ import GHC.Utils.Json import GHC.Utils.Panic-import GHC.Unit.Module.Warnings (WarningCategory)++import GHC.Version (cProjectVersion) import Data.Bifunctor import Data.Foldable    ( fold, toList ) import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.List ( intercalate )+import Data.Maybe ( maybeToList ) import Data.Typeable ( Typeable ) import Numeric.Natural ( Natural ) import Text.Printf ( printf )-import GHC.Version (cProjectVersion)-import GHC.Types.Hint.Ppr () -- Outputtable instance  {- Note [Messages] ~~~~~~~~~~~~~~~~~~@@ -393,10 +397,8 @@ pattern WarningWithFlag :: WarningFlag -> DiagnosticReason pattern WarningWithFlag w = WarningWithFlags (w :| []) -{--Note [Warnings controlled by multiple flags]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-+{- Note [Warnings controlled by multiple flags]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Diagnostics that started life as flag-controlled warnings have a 'diagnosticReason' of 'WarningWithFlags', giving the flags that control the warning. Usually there is only one flag, but in a few cases multiple flags@@ -563,11 +565,11 @@ {- Note [Diagnostic Message JSON Schema] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The below instance of ToJson must conform to the JSON schema-specified in docs/users_guide/diagnostics-as-json-schema-1_0.json.+specified in docs/users_guide/diagnostics-as-json-schema-1_1.json. When the schema is altered, please bump the version. If the content is altered in a backwards compatible way, update the minor version (e.g. 1.3 ~> 1.4).-If the content is breaking, update the major version (e.g. 1.3 ~> 2.3).+If the content is breaking, update the major version (e.g. 1.3 ~> 2.0). When updating the schema, replace the above file and name it appropriately with the version appended, and change the documentation of the -fdiagnostics-as-json flag to reflect the new schema.@@ -576,25 +578,41 @@ -}  schemaVersion :: String-schemaVersion = "1.0"+schemaVersion = "1.1" -- See Note [Diagnostic Message JSON Schema] before editing! instance Diagnostic e => ToJson (MsgEnvelope e) where-  json m = JSObject [+  json m = JSObject $ [     ("version", JSString schemaVersion),     ("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),     ("span", json $ errMsgSpan m),     ("severity", json $ errMsgSeverity m),     ("code", maybe JSNull json (diagnosticCode diag)),     ("message", JSArray $ map renderToJSString diagMsg),-    ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) )-    ]-    where diag = errMsgDiagnostic m-          opts = defaultDiagnosticOpts @e-          style = mkErrStyle (errMsgContext m)-          ctx = defaultSDocContext {sdocStyle = style }-          diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))-          renderToJSString :: SDoc -> JsonDoc-          renderToJSString = JSString . (renderWithContext ctx)+    ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) ) ]+    ++ [ ("reason", reasonJson)+       | reasonJson <- maybeToList $ usefulReasonJson_maybe (errMsgReason m) ]+    where+      diag = errMsgDiagnostic m+      opts = defaultDiagnosticOpts @e+      style = mkErrStyle (errMsgContext m)+      ctx = defaultSDocContext {sdocStyle = style }+      diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))+      renderToJSString :: SDoc -> JsonDoc+      renderToJSString = JSString . (renderWithContext ctx)++      usefulReasonJson_maybe :: ResolvedDiagnosticReason -> Maybe JsonDoc+      usefulReasonJson_maybe (ResolvedDiagnosticReason rea) =+        case rea of+          WarningWithoutFlag -> Nothing+          ErrorWithoutFlag   -> Nothing+          WarningWithFlags flags ->+            Just $ JSObject+              [ ("flags", JSArray $ map (JSString . NE.head . warnFlagNames) (NE.toList flags))+              ]+          WarningWithCategory (WarningCategory cat) ->+            Just $ JSObject+              [ ("category", JSString $ unpackFS cat)+              ]  instance Show (MsgEnvelope DiagnosticMessage) where     show = showMsgEnvelope
compiler/GHC/Types/Error/Codes.hs view
@@ -184,6 +184,7 @@   GhcDiagnosticCode "PsWarnUnrecognisedPragma"                      = 42044   GhcDiagnosticCode "PsWarnMisplacedPragma"                         = 28007   GhcDiagnosticCode "PsWarnImportPreQualified"                      = 07924+  GhcDiagnosticCode "PsWarnViewPatternSignatures"                   = 00834   GhcDiagnosticCode "PsErrLexer"                                    = 21231   GhcDiagnosticCode "PsErrCmmLexer"                                 = 75725   GhcDiagnosticCode "PsErrCmmParser"                                = 09848@@ -246,7 +247,8 @@   GhcDiagnosticCode "PsErrArrowExprInPat"                           = 04584   GhcDiagnosticCode "PsErrArrowCmdInPat"                            = 98980   GhcDiagnosticCode "PsErrArrowCmdInExpr"                           = 66043-  GhcDiagnosticCode "PsErrViewPatInExpr"                            = 66228+  GhcDiagnosticCode "PsErrViewPatInExpr"                            = Outdated 66228+  GhcDiagnosticCode "PsErrOrPatInExpr"                              = 66718   GhcDiagnosticCode "PsErrLambdaCmdInFunAppCmd"                     = 12178   GhcDiagnosticCode "PsErrCaseCmdInFunAppCmd"                       = 92971   GhcDiagnosticCode "PsErrLambdaCaseCmdInFunAppCmd"                 = Outdated 47171@@ -287,6 +289,8 @@   GhcDiagnosticCode "PsErrMultipleConForNewtype"                    = 05380   GhcDiagnosticCode "PsErrUnicodeCharLooksLike"                     = 31623   GhcDiagnosticCode "PsErrInvalidPun"                               = 52943+  GhcDiagnosticCode "PsErrIllegalOrPat"                             = 29847+  GhcDiagnosticCode "PsErrTypeSyntaxInPat"                          = 32181    -- Driver diagnostic codes   GhcDiagnosticCode "DriverMissingHomeModules"                      = 32850@@ -318,6 +322,9 @@   GhcDiagnosticCode "DriverPackageTrustIgnored"                     = 83552   GhcDiagnosticCode "DriverUnrecognisedFlag"                        = 93741   GhcDiagnosticCode "DriverDeprecatedFlag"                          = 53692+  GhcDiagnosticCode "DriverModuleGraphCycle"                        = 92213+  GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284+  GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain"               = 66599    -- Constraint solver diagnostic codes   GhcDiagnosticCode "BadTelescope"                                  = 97739@@ -413,8 +420,6 @@   GhcDiagnosticCode "TcRnFamInstNotInjective"                       = 05175   GhcDiagnosticCode "TcRnBangOnUnliftedType"                        = 55666   GhcDiagnosticCode "TcRnLazyBangOnUnliftedType"                    = 71444-  GhcDiagnosticCode "TcRnMultipleDefaultDeclarations"               = 99565-  GhcDiagnosticCode "TcRnBadDefaultType"                            = 88933   GhcDiagnosticCode "TcRnPatSynBundledWithNonDataCon"               = 66775   GhcDiagnosticCode "TcRnPatSynBundledWithWrongType"                = 66025   GhcDiagnosticCode "TcRnDupeModuleExport"                          = 51876@@ -422,6 +427,7 @@   GhcDiagnosticCode "TcRnNullExportedModule"                        = 64649   GhcDiagnosticCode "TcRnMissingExportList"                         = 85401   GhcDiagnosticCode "TcRnExportHiddenComponents"                    = 94558+  GhcDiagnosticCode "TcRnExportHiddenDefault"                       = 74775   GhcDiagnosticCode "TcRnDuplicateExport"                           = 47854   GhcDiagnosticCode "TcRnExportedParentChildMismatch"               = 88993   GhcDiagnosticCode "TcRnConflictingExports"                        = 69158@@ -460,7 +466,6 @@    GhcDiagnosticCode "TcRnUntickedPromotedThing"                     = 49957   GhcDiagnosticCode "TcRnIllegalBuiltinSyntax"                      = 39716-  GhcDiagnosticCode "TcRnWarnDefaulting"                            = 18042   GhcDiagnosticCode "TcRnForeignImportPrimExtNotSet"                = 49692   GhcDiagnosticCode "TcRnForeignImportPrimSafeAnn"                  = 26133   GhcDiagnosticCode "TcRnForeignFunctionImportAsValue"              = 76251@@ -491,6 +496,7 @@   GhcDiagnosticCode "TcRnDifferentExportWarnings"                   = 92878   GhcDiagnosticCode "TcRnIncompleteExportWarnings"                  = 94721   GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl"                   = 50649+  GhcDiagnosticCode "TcRnOrPatBindsVariables"                       = 81303   GhcDiagnosticCode "TcRnIllegalKind"                               = 64861   GhcDiagnosticCode "TcRnUnexpectedPatSigType"                      = 74097   GhcDiagnosticCode "TcRnIllegalKindSignature"                      = 91382@@ -570,7 +576,7 @@   GhcDiagnosticCode "TcRnNoExplicitImportList"                      = 16029   GhcDiagnosticCode "TcRnSafeImportsDisabled"                       = 26971   GhcDiagnosticCode "TcRnDeprecatedModule"                          = 15328-  GhcDiagnosticCode "TcRnCompatUnqualifiedImport"                   = 82347+  GhcDiagnosticCode "TcRnCompatUnqualifiedImport"                   = Outdated 82347   GhcDiagnosticCode "TcRnRedundantSourceImport"                     = 54478   GhcDiagnosticCode "TcRnDuplicateDecls"                            = 29916   GhcDiagnosticCode "TcRnPackageImportsDisabled"                    = 10032@@ -608,6 +614,11 @@   GhcDiagnosticCode "TcRnNamespacedFixitySigWithoutFlag"            = 78534   GhcDiagnosticCode "TcRnOutOfArityTyVar"                           = 84925   GhcDiagnosticCode "TcRnMisplacedInvisPat"                         = 11983+  GhcDiagnosticCode "TcRnIllformedTypePattern"                      = 88754+  GhcDiagnosticCode "TcRnIllegalTypePattern"                        = 70206+  GhcDiagnosticCode "TcRnIllformedTypeArgument"                     = 29092+  GhcDiagnosticCode "TcRnIllegalTypeExpr"                           = 35499+  GhcDiagnosticCode "TcRnUnexpectedTypeSyntaxInTerms"               = 31244    -- TcRnTypeApplicationsDisabled   GhcDiagnosticCode "TypeApplication"                               = 23482@@ -644,6 +655,7 @@    -- Invisible binders   GhcDiagnosticCode "TcRnIllegalInvisTyVarBndr"                     = 58589+  GhcDiagnosticCode "TcRnIllegalWildcardTyVarBndr"                  = 12211   GhcDiagnosticCode "TcRnInvalidInvisTyVarBndr"                     = 57916   GhcDiagnosticCode "TcRnInvisBndrWithoutSig"                       = 92337 @@ -654,10 +666,6 @@   GhcDiagnosticCode "HasConstructorContext"                         = 17440   GhcDiagnosticCode "HasExistentialTyVar"                           = 07525   GhcDiagnosticCode "HasStrictnessAnnotation"                       = 04049-  GhcDiagnosticCode "TcRnIllformedTypePattern"                      = 88754-  GhcDiagnosticCode "TcRnIllegalTypePattern"                        = 70206-  GhcDiagnosticCode "TcRnIllformedTypeArgument"                     = 29092-  GhcDiagnosticCode "TcRnIllegalTypeExpr"                           = 35499    -- TcRnBadRecordUpdate   GhcDiagnosticCode "NoConstructorHasAllFields"                     = 14392@@ -832,6 +840,14 @@   GhcDiagnosticCode "LookupInstErrFlexiVar"                         = 10373   GhcDiagnosticCode "LookupInstErrNotFound"                         = 10374 +  -- Diagnostic codes for default declarations and type defaulting+  GhcDiagnosticCode "TcRnMultipleDefaultDeclarations"               = 99565+  GhcDiagnosticCode "TcRnIllegalDefaultClass"                       = 26555+  GhcDiagnosticCode "TcRnIllegalNamedDefault"                       = 55756+  GhcDiagnosticCode "TcRnBadDefaultType"                            = 88933+  GhcDiagnosticCode "TcRnWarnDefaulting"                            = 18042+  GhcDiagnosticCode "TcRnWarnClashingDefaultImports"                = 77007+   -- TcRnEmptyStmtsGroupError/EmptyStatementGroupErrReason   GhcDiagnosticCode "EmptyStmtsGroupInParallelComp"                 = 41242   GhcDiagnosticCode "EmptyStmtsGroupInTransformListComp"            = 92693@@ -1120,7 +1136,7 @@     first, and decide whether to recur into it using the     HasTypeQ type family.   - The two different behaviours are controlled by two main instances (*) and (**).-    - (*) recurs into a subtype, when we have a type family equation such as:+    - (*) recurses into a subtype, when we have a type family equation such as:          ConRecursInto "TcRnCannotDeriveInstance" = 'Just DeriveInstanceErrReason
compiler/GHC/Types/FieldLabel.hs view
@@ -99,7 +99,7 @@ data DuplicateRecordFields     = DuplicateRecordFields   -- ^ Fields may be duplicated in a single module     | NoDuplicateRecordFields -- ^ Fields must be unique within a module (the default)-  deriving (Show, Eq, Typeable, Data)+  deriving (Show, Eq, Data)  instance Binary DuplicateRecordFields where     put_ bh f = put_ bh (f == DuplicateRecordFields)@@ -118,7 +118,7 @@ data FieldSelectors     = FieldSelectors   -- ^ Selector functions are available (the default)     | NoFieldSelectors -- ^ Selector functions are not available-  deriving (Show, Eq, Typeable, Data)+  deriving (Show, Eq, Data)  instance Binary FieldSelectors where     put_ bh f = put_ bh (f == FieldSelectors)@@ -140,9 +140,7 @@     put_ bh (FieldLabel aa ab ac) = do         put_ bh aa         put_ bh ab-        case getUserData bh of-          UserData{ ud_put_binding_name = put_binding_name } ->-              put_binding_name bh ac+        put_ bh ac     get bh = do         aa <- get bh         ab <- get bh
compiler/GHC/Types/Fixity.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_GHC -Wno-dodgy-exports #-} -- For re-export of GHC.Hs.Basic instances  -- | Fixity module GHC.Types.Fixity@@ -11,77 +12,28 @@    , negateFixity    , funTyFixity    , compareFixity+   , module GHC.Hs.Basic    ) where  import GHC.Prelude -import GHC.Types.SourceText--import GHC.Utils.Outputable-import GHC.Utils.Binary--import Data.Data hiding (Fixity, Prefix, Infix)--data Fixity = Fixity SourceText Int FixityDirection-  -- Note [Pragma source text] in "GHC.Types.SourceText"-  deriving Data--instance Outputable Fixity where-    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]--instance Eq Fixity where -- Used to determine if two fixities conflict-  (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2--instance Binary Fixity 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)+import Language.Haskell.Syntax.Basic (LexicalFixity(..), FixityDirection(..), Fixity(..) )+import GHC.Hs.Basic () -- For instances only  -------------------------data FixityDirection-   = InfixL-   | InfixR-   | InfixN-   deriving (Eq, Data) -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-------------------------- maxPrecedence, minPrecedence :: Int maxPrecedence = 9 minPrecedence = 0  defaultFixity :: Fixity-defaultFixity = Fixity NoSourceText maxPrecedence InfixL+defaultFixity = Fixity maxPrecedence InfixL  negateFixity, funTyFixity :: Fixity -- Wired-in fixities-negateFixity = Fixity NoSourceText 6 InfixL  -- Fixity of unary negate-funTyFixity  = Fixity NoSourceText (-1) InfixR  -- Fixity of '->', see #15235+negateFixity = Fixity 6 InfixL  -- Fixity of unary negate+funTyFixity  = Fixity (-1) InfixR  -- Fixity of '->', see #15235  {- Consider@@ -96,7 +48,7 @@ compareFixity :: Fixity -> Fixity               -> (Bool,         -- Error please                   Bool)         -- Associate to the right: a op1 (b op2 c)-compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)+compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)   = case prec1 `compare` prec2 of         GT -> left         LT -> right@@ -108,12 +60,3 @@     right        = (False, True)     left         = (False, False)     error_please = (True,  False)---- |Captures the fixity of declarations as they are parsed. This is not--- necessarily the same as the fixity declaration, as the normal fixity may be--- overridden using parens or backticks.-data LexicalFixity = Prefix | Infix deriving (Data,Eq)--instance Outputable LexicalFixity where-  ppr Prefix = text "Prefix"-  ppr Infix  = text "Infix"
compiler/GHC/Types/Fixity/Env.hs view
@@ -43,4 +43,3 @@  emptyIfaceFixCache :: OccName -> Maybe Fixity emptyIfaceFixCache _ = Nothing-
compiler/GHC/Types/ForeignCall.hs view
@@ -13,7 +13,7 @@         CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,         CCallSpec(..),         CCallTarget(..), isDynamicTarget,-        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,+        CCallConv(..), defaultCCallConv, ccallConvAttribute,          Header(..), CType(..),     ) where@@ -146,10 +146,6 @@  ccall:          Caller allocates parameters, *and* deallocates them. -stdcall:        Caller allocates parameters, callee deallocates.-                Function name has @N after it, where N is number of arg bytes-                e.g.  _Foo@8. This convention is x86 (win32) specific.- See: http://www.programmersheaven.com/2/Calling-conventions -} @@ -172,20 +168,13 @@ defaultCCallConv :: CCallConv defaultCCallConv = CCallConv -ccallConvToInt :: CCallConv -> Int-ccallConvToInt StdCallConv = 0-ccallConvToInt CCallConv   = 1-ccallConvToInt CApiConv    = panic "ccallConvToInt CApiConv"-ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv"-ccallConvToInt JavaScriptCallConv = panic "ccallConvToInt JavaScriptCallConv"- {- Generate the gcc attribute corresponding to the given calling convention (used by PprAbsC): -}  ccallConvAttribute :: CCallConv -> SDoc-ccallConvAttribute StdCallConv       = text "__attribute__((__stdcall__))"+ccallConvAttribute StdCallConv       = panic "ccallConvAttribute StdCallConv" ccallConvAttribute CCallConv         = empty ccallConvAttribute CApiConv          = empty ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv"@@ -200,7 +189,7 @@ isCLabelString lbl   = all ok (unpackFS lbl)   where-    ok c = isAlphaNum c || c == '_' || c == '.'+    ok c = isAlphaNum c || c == '_' || c == '.' || c == '@'         -- The '.' appears in e.g. "foo.so" in the         -- module part of a ExtName.  Maybe it should be separate @@ -233,7 +222,7 @@         = text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\""  -- The filename for a C header file--- Note [Pragma source text] in "GHC.Types.SourceText"+-- See Note [Pragma source text] in "GHC.Types.SourceText" data Header = Header SourceText FastString     deriving (Eq, Data) @@ -241,13 +230,7 @@     ppr (Header st h) = pprWithSourceText st (doubleQuotes $ ppr h)  -- | A C type, used in CAPI FFI calls------  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{-\# CTYPE'@,---        'GHC.Parser.Annotation.AnnHeader','GHC.Parser.Annotation.AnnVal',---        'GHC.Parser.Annotation.AnnClose' @'\#-}'@,---- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"-data CType = CType SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"+data CType = CType SourceText -- See Note [Pragma source text] in "GHC.Types.SourceText"                    (Maybe Header) -- header to include for this type                    (SourceText,FastString) -- the type itself     deriving (Eq, Data)
compiler/GHC/Types/GREInfo.hs view
@@ -186,12 +186,24 @@   - We can fill in the dots if you say `T1 {..}` in construction or pattern matching     See GHC.Rename.Pat.rnHsRecFields.rn_dotdot +  This information is stored in ConFieldInfo.+ * Whether the constructor is nullary.   We need to know this to accept `T2 {..}`, and `T3 {..}`, but reject `T4 {..}`,   in both construction and pattern matching.   See GHC.Rename.Pat.rnHsRecFields.rn_dotdot   and Note [Nullary constructors and empty record wildcards] +  This information is stored in ConFieldInfo.++* Whether the constructor is a data constructor or a pattern synonym, and,+  if it is a data constructor, what are the other data constructors of the+  parent type. This is used for computing irrefutability of pattern matches+  when deciding how to desugar do blocks (whether to use a fail operation).+  See GHC.Hs.Pat.isIrrefutableHsPat.++  This information is stored in ConLikeInfo.+ Note [Nullary constructors and empty record wildcards] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A nullary constructor is one with no arguments.@@ -202,32 +214,84 @@ This is done as as per https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0496-empty-record-wildcards.rst -} +-- | Information known to the renamer about a data constructor or pattern synonym.+--+-- See Note [Local constructor info in the renamer].+data ConInfo+  = ConInfo+  { conLikeInfo  :: !ConLikeInfo+  , conFieldInfo :: !ConFieldInfo+  }+  deriving stock Eq+  deriving Data++-- | Whether a constructor is a data constructor or a pattern synonym.+--+-- See Note [Local constructor info in the renamer].+data ConLikeInfo+  = ConIsData+    { conLikeDataCons :: [Name]+      -- ^ All the 'DataCon's of the parent 'TyCon',+      -- including the 'ConLike' itself.+      --+      -- Used in 'GHC.Hs.Pat.isIrrefutableHsPat'.+    }+  | ConIsPatSyn+  deriving stock Eq+  deriving Data++instance NFData ConInfo where+  rnf (ConInfo a b) = rnf a `seq` rnf b++instance NFData ConLikeInfo where+  rnf (ConIsData a) = rnf a+  rnf ConIsPatSyn = ()++ -- | Information about the record fields of a constructor. -- -- See Note [Local constructor info in the renamer]-data ConInfo+data ConFieldInfo   = ConHasRecordFields (NonEmpty FieldLabel)   | ConHasPositionalArgs   | ConIsNullary   deriving stock Eq   deriving Data -instance NFData ConInfo where+instance NFData ConFieldInfo where   rnf ConIsNullary = ()   rnf ConHasPositionalArgs = ()   rnf (ConHasRecordFields flds) = rnf flds -mkConInfo :: Arity -> [FieldLabel] -> ConInfo-mkConInfo 0 _ = ConIsNullary-mkConInfo _ fields = maybe ConHasPositionalArgs ConHasRecordFields+mkConInfo :: ConLikeInfo -> Arity -> [FieldLabel] -> ConInfo+mkConInfo con_ty n flds =+  ConInfo { conLikeInfo  = con_ty+          , conFieldInfo = mkConFieldInfo n flds }++mkConFieldInfo :: Arity -> [FieldLabel] -> ConFieldInfo+mkConFieldInfo 0 _ = ConIsNullary+mkConFieldInfo _ fields = maybe ConHasPositionalArgs ConHasRecordFields                    $ NonEmpty.nonEmpty fields  conInfoFields :: ConInfo -> [FieldLabel]-conInfoFields (ConHasRecordFields fields) = NonEmpty.toList fields-conInfoFields ConHasPositionalArgs = []-conInfoFields ConIsNullary = []+conInfoFields = conFieldInfoFields . conFieldInfo +conFieldInfoFields :: ConFieldInfo -> [FieldLabel]+conFieldInfoFields (ConHasRecordFields fields) = NonEmpty.toList fields+conFieldInfoFields ConHasPositionalArgs = []+conFieldInfoFields ConIsNullary = []+ instance Outputable ConInfo where+  ppr (ConInfo { conLikeInfo = con_ty, conFieldInfo = fld_info })+    = text "ConInfo" <+> braces+    (text "con_ty:" <+> ppr con_ty <> comma+    <+> text "fields:" <+> ppr fld_info)++instance Outputable ConLikeInfo where+  ppr (ConIsData cons) = text "ConIsData" <+> parens (ppr cons)+  ppr ConIsPatSyn      = text "ConIsPatSyn"++instance Outputable ConFieldInfo where   ppr ConIsNullary = text "ConIsNullary"   ppr ConHasPositionalArgs = text "ConHasPositionalArgs"   ppr (ConHasRecordFields fieldLabels) =@@ -244,6 +308,10 @@  instance Outputable ConLikeName where   ppr = ppr . conLikeName_Name++instance OutputableBndr ConLikeName where+    pprInfixOcc con = pprInfixName (conLikeName_Name con)+    pprPrefixOcc con = pprPrefixName (conLikeName_Name con)  instance Uniquable ConLikeName where   getUnique = getUnique . conLikeName_Name
compiler/GHC/Types/Hint.hs view
@@ -10,6 +10,7 @@   , SimilarName(..)   , StarIsType(..)   , UntickedPromotedThing(..)+  , AssumedDerivingStrategy(..)   , pprUntickedConstructor, isBareSymbol   , suggestExtension   , suggestExtensionWithInfo@@ -22,7 +23,7 @@   ) where  import Language.Haskell.Syntax.Expr (LHsExpr)-import Language.Haskell.Syntax (LPat, LIdP)+import Language.Haskell.Syntax (LPat, LIdP, LHsSigType, LHsSigWcType)  import GHC.Prelude @@ -46,6 +47,7 @@ import GHC.Data.FastString (fsLit, FastString)  import Data.Typeable ( Typeable )+import Data.Map.Strict (Map)  -- | The bindings we have available in scope when -- suggesting an explicit type signature.@@ -473,9 +475,48 @@   {-| Suggest explicitly quantifying a type variable instead of relying on implicit quantification -}   | SuggestExplicitQuantification RdrName -   {-| Suggest binding explicitly; e.g   data T @k (a :: F k) = .... -}   | SuggestBindTyVarExplicitly Name++  {-| Suggest a default declaration; e.g @default Cls (Ty1, Ty2)@ -}+  | SuggestDefaultDeclaration TyCon [Type]++  {-| Suggest using explicit deriving strategies for a deriving clause.++      Triggered by: 'GHC.Tc.Errors.Types.TcRnNoDerivingClauseStrategySpecified'.++      See comment of 'TcRnNoDerivingClauseStrategySpecified' for context.+  -}+  | SuggestExplicitDerivingClauseStrategies+    (Map AssumedDerivingStrategy [LHsSigType GhcRn])+    -- ^ Those deriving clauses that we assumed a particular strategy for.++  {-| Suggest using an explicit deriving strategy for a standalone deriving instance.++      Triggered by: 'GHC.Tc.Errors.Types.TcRnNoStandaloneDerivingStrategySpecified'.++      See comment of 'TcRnNoStandaloneDerivingStrategySpecified' for context.+  -}+  | SuggestExplicitStandaloneDerivingStrategy+    AssumedDerivingStrategy -- ^ The deriving strategy we assumed+    (LHsSigWcType GhcRn) -- ^ The instance signature (e.g 'Show a => Show (T a)')++  {-| Suggest add parens to pattern `e -> p :: t` -}+  | SuggestParenthesizePatternRHS++-- | The deriving strategy that was assumed when not explicitly listed in the+--   source. This is used solely by the missing-deriving-strategies warning.+--   There's no `Via` case because we never assume that.+data AssumedDerivingStrategy+  = AssumedStockStrategy+  | AssumedAnyclassStrategy+  | AssumedNewtypeStrategy+  deriving (Eq, Ord)++instance Outputable AssumedDerivingStrategy where+  ppr AssumedStockStrategy = text "stock"+  ppr AssumedAnyclassStrategy = text "anyclass"+  ppr AssumedNewtypeStrategy = text "newtype"  -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
compiler/GHC/Types/Hint/Ppr.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-}   -- instance Outputable GhcHint+{-# OPTIONS_GHC -Wno-orphans #-}   {- instance Outputable GhcHint -}  module GHC.Types.Hint.Ppr (   perhapsAsPat@@ -24,9 +25,13 @@ import GHC.Unit.Types import GHC.Utils.Outputable -import Data.List (intersperse)+import GHC.Driver.Flags+ import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map +import qualified GHC.LanguageExtensions as LangExt+ instance Outputable GhcHint where   ppr = \case     UnknownHint m@@ -34,15 +39,20 @@     SuggestExtension extHint       -> case extHint of           SuggestSingleExtension extraUserInfo ext ->-            (text "Perhaps you intended to use" <+> ppr ext) $$ extraUserInfo+            ("Perhaps you intended to use" <+> extension_with_implied ext)+            $$ extraUserInfo           SuggestAnyExtension extraUserInfo exts ->-            let header = text "Enable any of the following extensions:"-            in  header <+> hcat (intersperse (text ", ") (map ppr exts)) $$ extraUserInfo+            (enable "any" <+> unquotedListWith "or" (map implied exts))+            $$ extraUserInfo           SuggestExtensions extraUserInfo exts ->-            let header = text "Enable all of the following extensions:"-            in  header <+> hcat (intersperse (text ", ") (map ppr exts)) $$ extraUserInfo+            (enable "all" <+> unquotedListWith "and" (map implied exts))+            $$ extraUserInfo           SuggestExtensionInOrderTo extraUserInfo ext ->-            (text "Use" <+> ppr ext) $$ extraUserInfo+            ("Use" <+> extension_with_implied ext)+            $$ extraUserInfo+      where extension_with_implied ext = "the" <+> quotes (ppr ext) <+> "extension" <+> pprImpliedExtensions ext+            implied ext = quotes (ppr ext) <+> pprImpliedExtensions ext+            enable any_or_all = "Enable" <+> any_or_all <+> "of the following extensions" <> colon     SuggestCorrectPragmaName suggestions       -> text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)     SuggestMissingDo@@ -260,6 +270,24 @@     SuggestBindTyVarExplicitly tv       -> text "bind" <+> quotes (ppr tv)          <+> text "explicitly with" <+> quotes (char '@' <> ppr tv)+    SuggestDefaultDeclaration cls tys+      -> hang (text "Consider declaring")+            2 (text "default" <+> ppr cls <+> parens (pprWithCommas ppr tys))+    SuggestExplicitDerivingClauseStrategies assumed_derivings ->+      hang+        (text "Use explicit deriving strategies:")+        2+        (vcat $ map pp_derivings (Map.toList assumed_derivings))+      where+        pp_derivings (strat, preds) =+          hsep [text "deriving", ppr strat, parens (pprWithCommas ppr preds)]+    SuggestExplicitStandaloneDerivingStrategy strat deriv_sig ->+      hang+        (text "Use an explicit deriving strategy:")+        2+        (hsep [text "deriving", ppr strat, text "instance", ppr deriv_sig])+    SuggestParenthesizePatternRHS+      -> text "Parenthesize the RHS of the view pattern"  perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"@@ -368,6 +396,16 @@     pp_ns rdr | ns /= tried_ns = pprNameSpace ns               | otherwise      = empty       where ns = rdrNameSpace rdr++pprImpliedExtensions :: LangExt.Extension -> SDoc+pprImpliedExtensions extension = case implied of+    [] -> empty+    xs -> parens $ "implied by" <+> unquotedListWith "and" xs+  where implied = map (quotes . ppr)+                . filter (\ext -> extensionDeprecation ext == ExtensionNotDeprecated)+                . map (\(impl, _, _) -> impl)+                . filter (\(_, t, orig) -> orig == extension && t == turnOn)+                $ impliedXFlags  pprPrefixUnqual :: Name -> SDoc pprPrefixUnqual name =
compiler/GHC/Types/IPE.hs view
@@ -13,7 +13,7 @@ import GHC.Types.SrcLoc import GHC.Core.DataCon -import GHC.Types.Unique.Map+import GHC.Types.Unique.DFM import GHC.Core.Type import Data.List.NonEmpty import GHC.Cmm.CLabel (CLabel)@@ -25,8 +25,8 @@  -- | A map from a 'Name' to the best approximate source position that -- name arose from.-type ClosureMap = UniqMap Name  -- The binding-                          (Type, Maybe IpeSourceLocation)+type ClosureMap = UniqDFM Name  -- The binding+                          (Name, (Type, Maybe IpeSourceLocation))                           -- The best approximate source position.                           -- (rendered type, source position, source note                           -- label)@@ -38,7 +38,7 @@ -- the constructor was used at, if possible and a string which names -- the source location. This is the same information as is the payload -- for the 'GHC.Core.SourceNote' constructor.-type DCMap = UniqMap DataCon (NonEmpty (Int, Maybe IpeSourceLocation))+type DCMap = UniqDFM DataCon (DataCon, NonEmpty (Int, Maybe IpeSourceLocation))  type InfoTableToSourceLocationMap = Map.Map CLabel (Maybe IpeSourceLocation) @@ -49,4 +49,4 @@                           }  emptyInfoTableProvMap :: InfoTableProvMap-emptyInfoTableProvMap = InfoTableProvMap emptyUniqMap emptyUniqMap Map.empty+emptyInfoTableProvMap = InfoTableProvMap emptyUDFM emptyUDFM Map.empty
compiler/GHC/Types/Id.hs view
@@ -72,7 +72,7 @@         isFCallId, isFCallId_maybe,         isDataConWorkId, isDataConWorkId_maybe,         isDataConWrapId, isDataConWrapId_maybe,-        isDataConId_maybe,+        isDataConId, isDataConId_maybe,         idDataCon,         isConLikeId, isWorkerLikeId, isDeadEndId, idIsFrom,         hasNoBinding,@@ -146,27 +146,32 @@ import qualified GHC.Types.Var as Var  import GHC.Core.Type-import GHC.Types.RepType+import GHC.Core.Predicate( isCoVarType ) import GHC.Core.DataCon+import GHC.Core.Class+import GHC.Core.Multiplicity++import GHC.Types.RepType import GHC.Types.Demand import GHC.Types.Cpr import GHC.Types.Name-import GHC.Unit.Module-import GHC.Core.Class-import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) import GHC.Types.ForeignCall-import GHC.Data.Maybe import GHC.Types.SrcLoc import GHC.Types.Unique++import GHC.Stg.InferTags.TagSig++import GHC.Unit.Module+import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) import GHC.Builtin.Uniques (mkBuiltinUnique) import GHC.Types.Unique.Supply++import GHC.Data.Maybe import GHC.Data.FastString-import GHC.Core.Multiplicity  import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic-import GHC.Stg.InferTags.TagSig  -- infixl so you can say (id `set` a `set` b) infixl  1 `setIdUnfolding`,@@ -544,6 +549,12 @@                          DataConWorkId con -> Just con                          DataConWrapId con -> Just con                          _                 -> Nothing++isDataConId :: Id -> Bool+isDataConId id = case Var.idDetails id of+                         DataConWorkId {} -> True+                         DataConWrapId {} -> True+                         _                 -> False  -- | An Id for which we might require all callers to pass strict arguments properly tagged + evaluated. --
compiler/GHC/Types/Id/Info.hs view
@@ -180,7 +180,7 @@         -- should be instantiated to concrete type variables?         --         -- See Note [Representation-polymorphism checking built-ins]-        -- in GHC.Tc.Gen.Head.+        -- in GHC.Tc.Utils.Concrete.    -- | The 'Id' is for a primitive operator.   | PrimOpId@@ -193,7 +193,7 @@         -- type variables.         --         -- See Note [Representation-polymorphism checking built-ins]-        -- in GHC.Tc.Gen.Head.+        -- in GHC.Tc.Utils.Concrete.    | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call.                                 -- Type will be simple: no type families, newtypes, etc
compiler/GHC/Types/Id/Make.hs view
@@ -157,12 +157,15 @@   * May have IdInfo that differs from what would be imported from GHC.Magic.hi.     For example, 'lazy' gets a lazy strictness signature, per Note [lazyId magic]. -  The two remaining identifiers in GHC.Magic, runRW# and inline, are not listed-  in magicIds: they have special behavior but they can be known-key and+  The two remaining identifiers in GHC.Magic, runRW# and inline, are not+  listed in magicIds: they have special behavior but they can be known-key and   not wired-in.-  runRW#: see Note [Simplification of runRW#] in Prep, runRW# code in-  Simplifier, Note [Linting of runRW#].-  inline: see Note [inlineId magic]+  Similarly for GHC.Internal.IO.seq# and GHC.Internal.Exts.considerAccessible.+  runRW#:             see Note [Simplification of runRW#] in Prep,+                      runRW# code in Simplifier, Note [Linting of runRW#].+  seq#:               see Note [seq# magic]+  inline:             see Note [inlineId magic]+  considerAccessible: see Note [considerAccessible] -}  wiredInIds :: [Id]@@ -1136,18 +1139,18 @@    -> HsImplBang  dataConSrcToImplBang bang_opts fam_envs arg_ty-                     (HsSrcBang ann unpk NoSrcStrict)+                     (HsSrcBang ann (HsBang unpk NoSrcStrict))   | bang_opt_strict_data bang_opts -- StrictData => strict field   = dataConSrcToImplBang bang_opts fam_envs arg_ty-                  (HsSrcBang ann unpk SrcStrict)+                  (mkHsSrcBang ann unpk SrcStrict)   | otherwise -- no StrictData => lazy field   = HsLazy -dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)+dataConSrcToImplBang _ _ _ (HsSrcBang _ (HsBang _ SrcLazy))   = HsLazy  dataConSrcToImplBang bang_opts fam_envs arg_ty-                     (HsSrcBang _ unpk_prag SrcStrict)+                     (HsSrcBang _ (HsBang unpk_prag SrcStrict))   | isUnliftedType (scaledThing arg_ty)     -- NB: non-newtype data constructors can't have representation-polymorphic fields     -- so this is OK.@@ -1465,7 +1468,7 @@              -- We'd get a black hole if we used dataConImplBangs           ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool-         ok_arg dcs (Scaled _ ty, HsSrcBang _ unpack_prag str_prag)+         ok_arg dcs (Scaled _ ty, HsSrcBang _ (HsBang unpack_prag str_prag))            | strict_field str_prag            , Just data_cons <- unpackable_type_datacons (topNormaliseType fam_envs ty)            , should_unpack_conservative unpack_prag data_cons  -- Wrinkle (W3)@@ -1535,87 +1538,39 @@   -unpackable_type_datacons :: Type -> Maybe [DataCon] -- Given a type already assumed to have been normalized by topNormaliseType,---    unpackable_type_datacons (T ty1 .. tyn) = Just datacons--- iff the type can be unpacked (see Note [Unpacking GADTs and existentials])--- and `datacons` are the data constructors of T+-- unpackable_type_datacons ty = Just datacons+-- iff ty is of the form+--     T ty1 .. tyn+-- and T is an algebraic data type (not newtype), in which no data+-- constructors have existentials, and datacons is the list of data+-- constructors of T.+unpackable_type_datacons :: Type -> Maybe [DataCon] unpackable_type_datacons ty   | Just (tc, _) <- splitTyConApp_maybe ty-  , not (isNewTyCon tc)-      -- isNewTyCon: even though `ty` has been normalised, whic includes looking-      -- through newtypes, it could still be a /recursive/ newtype, so we must-      -- check for that case+  , not (isNewTyCon tc)  -- Even though `ty` has been normalised, it could still+                         -- be a /recursive/ newtype, so we must check for that   , Just cons <- tyConDataCons_maybe tc-  , unpackable_cons cons-  = Just cons+  , not (null cons)      -- Don't upack nullary sums; no need.+                         -- They already take zero bits+  , all (null . dataConExTyCoVars) cons+  = Just cons -- See Note [Unpacking GADTs and existentials]   | otherwise   = Nothing-  where-    unpackable_cons :: [DataCon] -> Bool-    -- True if we can unpack a value of type (T t1 .. tn),-    -- where T is an algebraic data type with these constructors-    -- See Note [Unpacking GADTs and existentials]-    unpackable_cons []   -- Don't unpack nullary sums; no need.-      = False            -- They already take zero bits; see (UC0) -    unpackable_cons [con]   -- Exactly one data constructor; see (UC1)-      = null (dataConExTyCoVars con)--    unpackable_cons cons  -- More than one data constructor; see (UC2)-      = all isVanillaDataCon cons- {- Note [Unpacking GADTs and existentials] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Can we unpack a value of an algebraic data type T? For example-   data D a = MkD {-# UNPACK #-} (T a)-Can we unpack that (T a) field?--Three cases to consider in `unpackable_cons`--(UC0) No data constructors; a nullary sum type.  This already takes zero-      bits so there is no point in unpacking it.--(UC1) Single-constructor types (products).  We can just represent it by-   its fields. For example, if `T` is defined as:-      data T a = MkT a a Int-   then we can unpack it as follows.  The worker for MkD takes three unpacked fields:-       data D a = MkD a a Int-       $MkD :: T a -> D a-       $MkD (MkT a1 a2 i) = MkD a1 a2 i--   We currently /can't/ do this if T has existentially-bound type variables,-   hence:   null (dataConExTyCoVars con)   in `unpackable_cons`.-   But see also (UC3) below.--   But we /can/ do it for (some) GADTs, such as:-      data Equal a b where { Equal :: Equal a a }-      data Wom a where { Wom1 :: Int -> Wom Bool }-   We will get a MkD constructor that includes some coercion arguments,-   but that is fine.   See #14978.  We still can't accommodate existentials,-   but these particular examples don't use existentials.--(UC2) Multi-constructor types, e.g.-        data T a = T1 a | T2 Int a-  Here we unpack the field to an unboxed sum type, thus:-    data D a = MkD (# a | (# Int, a #) #)--  However, now we can't deal with GADTs at all, because we'd need an-  unboxed sum whose component was a unboxed tuple, whose component(s)-  have kind (CONSTRAINT r); and that's not well-kinded.  Hence the-    all isVanillaDataCon-  condition in `unpackable_cons`. See #25672.+There is nothing stopping us unpacking a data type with equality+components, like+  data Equal a b where+    Equal :: Equal a a -(UC3)  For single-constructor types, with some more plumbing we could-   allow existentials. e.g.-       data T a = forall b. MkT a (b->Int) b-   could unpack to-       data D a = forall b. MkD a (b->Int) b-       $MkD :: T a -> D a-       $MkD (MkT @b x f y) = MkD @b x f y-   Eminently possible, but more plumbing needed.+And it'd be fine to unpack a product type with existential components+too, but that would require a bit more plumbing, so currently we don't. +So for now we require: null (dataConExTyCoVars data_con)+See #14978  Note [Unpack one-wide fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -2283,8 +2238,106 @@ * To defeat the specialiser when we have incoherent instances.   See Note [Coherence and specialisation: overview] in GHC.Core.InstEnv. +Note [seq# magic]+~~~~~~~~~~~~~~~~~+The purpose of the magic Id (See Note [magicIds])++  seq# :: forall a s . a -> State# s -> (# State# s, a #)++is to elevate evaluation of its argument `a` into an observable side effect.+This implies that GHC's optimisations must preserve the evaluation "exactly+here", in the state thread.++The main use of seq# is to implement `evaluate`++   evaluate :: a -> IO a+   evaluate a = IO $ \s -> seq# a s++Its (NOINLINE) definition in GHC.Magic is simply++   seq# a s = let !a' = lazy a in (# s, a' #)++Things to note++(SEQ1)+  It must be NOINLINE, because otherwise the eval !a' would be decoupled from+  the state token s, and GHC's optimisations, in particular strictness analysis,+  would happily move the eval around.++  However, we *do* inline saturated applications of seq# in CorePrep, where+  evaluation order is fixed; see the implementation notes below.+  This is one reason why we need seq# to be known-key.++(SEQ2)+  The use of `lazy` ensures that strictness analysis does not see the eval+  that takes place, so the final demand signature is <L><L>, not <1L><L>.+  This is important for a definition like++    foo x y = evaluate y >> evaluate x++  Although both y and x are ultimately evaluated, the user made it clear+  they want to evaluate y *before* x.+  But if strictness analysis sees the evals, it infers foo as strict in+  both parameters. This strictness would be exploited in the backend by+  picking a call-by-value calling convention for foo, one that would evaluate+  x *before* y. Nononono!++  Because the definition of seq# uses `lazy`, it must live in a different module+  (GHC.Internal.IO); otherwise strictness analysis uses its own strictness+  signature for the definition of `lazy` instead of the one we wire in.++(SEQ3)+  Why does seq# return the value? Consider+     let x = e in+     case seq# x s of (# _, x' #) -> ... x' ... case x' of __DEFAULT -> ...+  Here, we could simply use x instead of x', but doing so would+  introduce an unnecessary indirection and tag check at runtime;+  also we can attach an evaldUnfolding to x' to discard any+  subsequent evals such as the `case x' of __DEFAULT`.++(SEQ4)+  T15226 demonstrates that we want to discard ok-for-discard seq#s. That is,+  simplify `case seq# <ok-to-discard> s of (# s', _ #) -> rhs[s']` to `rhs[s]`.+  You might wonder whether the Simplifier could do this. But see the excellent+  example in #24334 (immortalised as test T24334) for why it should be done in+  CorePrep.++Implementing seq#.  The compiler has magic for `seq#` in++- GHC.CoreToStg.Prep.cpeRhsE: Implement (SEQ4).++- Simplify.addEvals records evaluated-ness for the result (cf. (SEQ3)); see+  Note [Adding evaluatedness info to pattern-bound variables]+  in GHC.Core.Opt.Simplify.Iteration++- GHC.Core.Opt.DmdAnal.exprMayThrowPreciseException:+  Historically, seq# used to be a primop, and the majority of primops+  should return False in exprMayThrowPreciseException, so we do the same+  for seq# for back compat.++- GHC.CoreToStg.Prep: Inline saturated applications to a Case, e.g.,++    seq# (f 13) s+    ==>+    case f 13 of sat of __DEFAULT -> (# s, sat #)++  This is implemented in `cpeApp`, not unlike Note [runRW magic].+  We are only inlining seq#, leaving opportunities for case-of-known-con+  behind that are easily picked up by Unarise:++    case seq# f 13 s of (# s', r #) -> rhs+    ==> {Prep}+    case f 13 of sat of __DEFAULT -> case (# s, sat #) of (# s', r #) -> rhs+    ==> {Unarise}+    case f 13 of sat of __DEFAULT -> rhs[s/s',sat/r]++  Note that CorePrep really allocates a CaseBound FloatingBind for `f 13`.+  That's OK, because the telescope of Floats always stays in the same order+  and won't be floated out of binders, so all guarantees of evaluation order+  provided by seq# are upheld.+ Note [oneShot magic]-~~~~~~~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~ In the context of making left-folds fuse somewhat okish (see ticket #7994 and Note [Left folds via right fold]) it was determined that it would be useful if library authors could explicitly tell the compiler that a certain lambda is
compiler/GHC/Types/Literal.hs view
@@ -145,19 +145,13 @@   | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'   | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble' -  | LitLabel   FastString (Maybe Int) FunctionOrData+  | LitLabel   FastString FunctionOrData                                 -- ^ A label literal. Parameters:                                 --                                 -- 1) The name of the symbol mentioned in the                                 --    declaration                                 ---                                -- 2) The size (in bytes) of the arguments-                                --    the label expects. Only applicable with-                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will-                                --    be appended to label name when emitting-                                --    assembly.-                                ---                                -- 3) Flag indicating whether the symbol+                                -- 2) Flag indicating whether the symbol                                 --    references a function or a data   deriving Data @@ -259,10 +253,9 @@     put_ bh (LitNullAddr)    = putByte bh 2     put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah     put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai-    put_ bh (LitLabel aj mb fod)+    put_ bh (LitLabel aj fod)         = do putByte bh 5              put_ bh aj-             put_ bh mb              put_ bh fod     put_ bh (LitNumber nt i)         = do putByte bh 6@@ -289,9 +282,8 @@                     return (LitDouble ai)               5 -> do                     aj <- get bh-                    mb <- get bh                     fod <- get bh-                    return (LitLabel aj mb fod)+                    return (LitLabel aj fod)               6 -> do                     nt <- get bh                     i  <- get bh@@ -843,7 +835,7 @@ literalType (LitString  _)    = addrPrimTy literalType (LitFloat _)      = floatPrimTy literalType (LitDouble _)     = doublePrimTy-literalType (LitLabel _ _ _)  = addrPrimTy+literalType (LitLabel _ _)    = addrPrimTy literalType (LitNumber lt _)  = case lt of    LitNumBigNat  -> byteArrayPrimTy    LitNumInt     -> intPrimTy@@ -874,7 +866,7 @@ cmpLit (LitNullAddr)        (LitNullAddr)         = EQ cmpLit (LitFloat     a)     (LitFloat      b)     = a `compare` b cmpLit (LitDouble    a)     (LitDouble     b)     = a `compare` b-cmpLit (LitLabel     a _ _) (LitLabel      b _ _) = a `lexicalCompareFS` b+cmpLit (LitLabel     a _)   (LitLabel      b _)   = a `lexicalCompareFS` b cmpLit (LitNumber nt1 a)    (LitNumber nt2  b)   = (nt1 `compare` nt2) `mappend` (a `compare` b) cmpLit (LitRubbish tc1 b1)  (LitRubbish tc2 b2)  = (tc1 `compare` tc2) `mappend`@@ -908,11 +900,8 @@        LitNumWord16  -> pprPrimWord16 i        LitNumWord32  -> pprPrimWord32 i        LitNumWord64  -> pprPrimWord64 i-pprLiteral add_par (LitLabel l mb fod) =-    add_par (text "__label" <+> b <+> ppr fod)-    where b = case mb of-              Nothing -> pprHsString l-              Just x  -> doubleQuotes (ftext l <> text ('@':show x))+pprLiteral add_par (LitLabel l fod) =+    add_par (text "__label" <+> pprHsString l <+> ppr fod) pprLiteral _       (LitRubbish torc rep)   = text "RUBBISH" <> pp_tc <> parens (ppr rep)   where
compiler/GHC/Types/Name.hs view
@@ -663,12 +663,12 @@ -- distinction. instance Binary Name where    put_ bh name =-      case getUserData bh of-        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name+      case findUserDataWriter Proxy bh of+        tbl -> putEntry tbl bh name     get bh =-      case getUserData bh of-        UserData { ud_get_name = get_name } -> get_name bh+      case findUserDataReader Proxy bh of+        tbl -> getEntry tbl bh  {- ************************************************************************@@ -716,9 +716,9 @@ {-# SPECIALISE pprName :: Name -> SDoc #-} {-# SPECIALISE pprName :: Name -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable --- | Print fully qualified name (with unit-id, module and unique)+-- | Print fully qualified name (with unit-id and module, but no unique) pprFullName :: Module -> Name -> SDoc-pprFullName this_mod Name{n_sort = sort, n_uniq = uniq, n_occ = occ} =+pprFullName this_mod Name{n_sort = sort, n_occ = occ} =   let mod = case sort of         WiredIn  m _ _ -> m         External m     -> m@@ -727,8 +727,6 @@       in ftext (unitIdFS (moduleUnitId mod))          <> colon    <> ftext (moduleNameFS $ moduleName mod)          <> dot      <> ftext (occNameFS occ)-         <> char '_' <> pprUniqueAlways uniq-  -- | Print a ticky ticky styled name --
compiler/GHC/Types/Name/Occurrence.hs view
@@ -106,7 +106,7 @@         mainOcc, ppMainFn,          -- * Tidying up-        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,+        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv, trimTidyOccEnv,         tidyOccName, avoidClashesOccEnv, delTidyOccEnvList,          -- FsEnv@@ -1142,7 +1142,7 @@  Note [TidyOccEnv] ~~~~~~~~~~~~~~~~~-type TidyOccEnv = UniqFM Int+type TidyOccEnv = UniqFM FastString Int  * Domain = The OccName's FastString. These FastStrings are "taken";            make sure that we don't re-use@@ -1197,8 +1197,16 @@ To achieve this, the function avoidClashesOccEnv can be used to prepare the TidyEnv, by “blocking” every name that occurs twice in the map. This way, none of the "a"s will get the privilege of keeping this name, and all of them will-get a suitable number by tidyOccName.+get a suitable number by tidyOccName.  Thus +   avoidNameClashesOccEnv ["a" :-> 7] ["b", "a", "c", "b", "a"]+     = ["a" :-> 7, "b" :-> 1]++Here+* "a" is already the TidyOccEnv, and so is unaffected+* "b" occurs twice, so is blocked by adding "b" :-> 1+* "c" occurs only once, and so is not affected.+ This prepared TidyEnv can then be used with tidyOccName. See tidyTyCoVarBndrs for an example where this is used. @@ -1217,8 +1225,8 @@   where     add env (OccName _ fs) = addToUFM env fs 1 -delTidyOccEnvList :: TidyOccEnv -> [FastString] -> TidyOccEnv-delTidyOccEnvList = delListFromUFM+delTidyOccEnvList :: TidyOccEnv -> [OccName] -> TidyOccEnv+delTidyOccEnvList env occs = env `delListFromUFM` map occNameFS occs  -- see Note [Tidying multiple names at once] avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv@@ -1262,6 +1270,16 @@                      -- If they are the same (n==1), the former wins                      -- See Note [TidyOccEnv] +trimTidyOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv+-- Restrict the env to just the [OccName]+trimTidyOccEnv env vs+  = foldl' add emptyUFM vs+  where+    add :: TidyOccEnv -> OccName -> TidyOccEnv+    add so_far (OccName _ fs)+      = case lookupUFM env fs of+          Just n  -> addToUFM so_far fs n+          Nothing -> so_far  {- ************************************************************************
compiler/GHC/Types/Name/Ppr.hs view
@@ -123,8 +123,7 @@             , fUNTyConName, unrestrictedFunTyConName             , oneDataConName             , listTyConName-            , manyDataConName-            , soloDataConName ]+            , manyDataConName ]           || isJust (isTupleTyOcc_maybe mod occ)           || isJust (isSumTyOcc_maybe mod occ)
compiler/GHC/Types/Name/Reader.hs view
@@ -51,7 +51,7 @@         GlobalRdrEnvX, GlobalRdrEnv, IfGlobalRdrEnv,         emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,         extendGlobalRdrEnv, greOccName,-        pprGlobalRdrEnv, globalRdrEnvElts,+        pprGlobalRdrEnv, globalRdrEnvElts, globalRdrEnvLocal,          -- ** Looking up 'GlobalRdrElt's         FieldsOrSelectors(..), filterFieldGREs, allowGRE,@@ -121,6 +121,7 @@ import GHC.Types.Name.Env     ( NameEnv, nonDetNameEnvElts, emptyNameEnv, extendNameEnv_Acc ) import GHC.Types.Name.Set+import GHC.Types.PkgQual import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique import GHC.Types.Unique.FM@@ -162,14 +163,6 @@ -- > `bar` -- > ( ~ ) ----- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',---           'GHC.Parser.Annotation.AnnOpen'  @'('@ or @'['@ or @'[:'@,---           'GHC.Parser.Annotation.AnnClose' @')'@ or @']'@ or @':]'@,,---           'GHC.Parser.Annotation.AnnBackquote' @'`'@,---           'GHC.Parser.Annotation.AnnVal'---           'GHC.Parser.Annotation.AnnTilde',---- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation" data RdrName   = Unqual OccName         -- ^ Unqualified  name@@ -809,7 +802,7 @@          $ Map.fromListWith unionUniqSets          [ (S.Arg (flSelector fl) fl, unitUniqSet con)          | (con, con_info) <- cons-         , ConHasRecordFields fls <- [con_info]+         , ConInfo _ (ConHasRecordFields fls) <- [con_info]          , fl <- NE.toList fls ]  instance HasOccName (GlobalRdrEltX info) where@@ -936,6 +929,9 @@ globalRdrEnvElts :: GlobalRdrEnvX info -> [GlobalRdrEltX info] globalRdrEnvElts env = nonDetFoldOccEnv (++) [] env +globalRdrEnvLocal :: GlobalRdrEnvX info -> GlobalRdrEnvX info+globalRdrEnvLocal = mapOccEnv (filter isLocalGRE)+ -- | Drop all 'GREInfo' fields in a 'GlobalRdrEnv' in order to -- avoid space leaks. -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.@@ -1780,7 +1776,9 @@         old_mod_name = moduleName old_mod         id_spec      = ImpDeclSpec { is_mod = old_mod                                    , is_as = old_mod_name+                                   , is_pkg_qual = NoPkgQual                                    , is_qual = True+                                   , is_isboot = NotBoot                                    , is_dloc = greDefinitionSrcSpan old_gre }      set_qual :: ImportSpec -> ImportSpec@@ -1939,9 +1937,14 @@                                    -- TODO: either should be Module, or there                                    -- should be a Maybe UnitId here too.         is_as       :: !ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)+        is_pkg_qual :: !PkgQual,    -- ^ Was this a package import?         is_qual     :: !Bool,       -- ^ Was this import qualified?-        is_dloc     :: !SrcSpan     -- ^ The location of the entire import declaration+        is_dloc     :: !SrcSpan,    -- ^ The location of the entire import declaration+        is_isboot   :: !IsBootInterface -- ^ Was this a SOURCE import?     } deriving (Eq, Data)++instance NFData ImpDeclSpec where+  rnf = rwhnf -- Already strict in all fields  -- | Import Item Specification --
compiler/GHC/Types/PkgQual.hs view
@@ -22,8 +22,8 @@ -- package qualifier. data PkgQual   = NoPkgQual       -- ^ No package qualifier-  | ThisPkg  UnitId -- ^ Import from home-unit-  | OtherPkg UnitId -- ^ Import from another unit+  | ThisPkg  !UnitId -- ^ Import from home-unit+  | OtherPkg !UnitId -- ^ Import from another unit   deriving (Data, Ord, Eq)  instance Outputable RawPkgQual where
compiler/GHC/Types/RepType.hs view
@@ -535,7 +535,7 @@ GHC.Builtin.Types and its helper function mk_runtime_rep_dc.) Example 2 passes the promoted list as the one argument to the extracted function. The extracted function is defined as prim_rep_fun within tupleRepDataCon in GHC.Builtin.Types. It takes one argument, decomposes-the promoted list (with extractPromotedList), and then recurs back to runtimeRepPrimRep+the promoted list (with extractPromotedList), and then recurses back to runtimeRepPrimRep to process the LiftedRep and WordRep, concatenating the results.  -}
+ compiler/GHC/Types/SptEntry.hs view
@@ -0,0 +1,17 @@+module GHC.Types.SptEntry+  ( SptEntry(..)+  )+where++import GHC.Types.Var           ( Id )+import GHC.Fingerprint.Type    ( Fingerprint )+import GHC.Utils.Outputable++-- | An entry to be inserted into a module's static pointer table.+-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable".+data SptEntry = SptEntry Id Fingerprint++instance Outputable SptEntry where+  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr++
compiler/GHC/Types/SrcLoc.hs view
@@ -908,18 +908,18 @@ -- ---------------------------------------------------------------------  --- | The anchor for an @'AnnKeywordId'@. The Parser inserts the+-- | The anchor for an exact print annotation. The Parser inserts the -- @'EpaSpan'@ variant, giving the exact location of the original item -- in the parsed source.  This can be replaced by the @'EpaDelta'@ -- version, to provide a position for the item relative to the end of -- the previous item in the source.  This is useful when editing an--- AST prior to exact printing the changed one. The list of comments--- in the @'EpaDelta'@ variant captures any comments between the prior--- output and the thing being marked here, since we cannot otherwise--- sort the relative order.+-- AST prior to exact printing the changed one.+-- The EpaDelta also contains the original @'SrcSpan'@ for use by+-- tools wanting to manipulate the AST after converting it using+-- ghc-exactprint' @'makeDeltaAst'@.  data EpaLocation' a = EpaSpan !SrcSpan-                    | EpaDelta !DeltaPos !a+                    | EpaDelta !SrcSpan !DeltaPos !a                     deriving (Data,Eq,Show)  type NoCommentsLocation = EpaLocation' NoComments@@ -960,7 +960,7 @@  instance (Outputable a) => Outputable (EpaLocation' a) where   ppr (EpaSpan r) = text "EpaSpan" <+> ppr r-  ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs+  ppr (EpaDelta s d cs) = text "EpaDelta" <+> ppr s <+> ppr d <+> ppr cs  instance Outputable DeltaPos where   ppr (SameLine c) = text "SameLine" <+> ppr c
compiler/GHC/Types/Tickish.hs view
@@ -106,9 +106,11 @@     -- the user.     ProfNote {       profNoteCC    :: CostCentre, -- ^ the cost centre+       profNoteCount :: !Bool,      -- ^ bump the entry count?       profNoteScope :: !Bool       -- ^ scopes over the enclosed expression                                    -- (i.e. not just a tick)+      -- Invariant: the False/False case never happens     }    -- | A "tick" used by HPC to track the execution of each
compiler/GHC/Types/TyThing.hs view
@@ -314,13 +314,13 @@               -- Note [Parents] in GHC.Types.Name.Reader.             RealDataCon dc1 ->               (ParentIs $ tyConName $ dataConTyCon dc1-              , [ (DataConName $ dataConName $ dc, ConHasRecordFields (fld :| flds))+              , [ (DataConName $ dataConName $ dc, ConInfo conInfo (ConHasRecordFields (fld :| flds)))                 | dc <- tyConDataCons $ dataConTyCon dc1                 -- Go through all the data constructors of the parent TyCon,                 -- to ensure that all the record fields have the correct set                 -- of parent data constructors. See #23546.                 , let con_info = conLikeConInfo (RealDataCon dc)-                , ConHasRecordFields flds0 <- [con_info]+                , ConInfo conInfo (ConHasRecordFields flds0) <- [con_info]                 , let flds1 = NE.toList flds0 `intersect` dataConFieldLabels dc                 , fld:flds <- [flds1]                 ])
compiler/GHC/Types/TyThing/Ppr.hs view
@@ -98,7 +98,7 @@   (in GHC.IfaceToCore). For example, IfaceClosedSynFamilyTyCon   stores a [IfaceAxBranch] that is used only for pretty-printing. -- See Note [Free tyvars in IfaceType] in GHC.Iface.Type+- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type  See #7730, #8776 for details   -}
compiler/GHC/Types/Unique.hs view
@@ -205,6 +205,9 @@ instance Uniquable Int where   getUnique i = mkUniqueIntGrimily i +instance Uniquable Word64 where+  getUnique i = mkUniqueGrimily i+ instance Uniquable ModuleName where   getUnique (ModuleName nm) = getUnique nm @@ -243,12 +246,17 @@ -- is to get ABI compatible binaries given the same inputs and environment. -- The motivation behind that is that if the ABI doesn't change the -- binaries can be safely reused.--- Note that this is weaker than bit-for-bit identical binaries and getting--- bit-for-bit identical binaries is not a goal for now.--- This means that we don't care about nondeterminism that happens after--- the interface files are created, in particular we don't care about--- register allocation and code generation.--- To track progress on bit-for-bit determinism see #12262.+--+-- Besides ABI/interface determinism, we also guarantee bit-for-bit identical+-- binaries (when -fobject-determinism is given), also known as object+-- determinism (#12935)+--+-- To achieve this, we must take care to non-determinism in the code+-- generation, and, in particular, guarantee that the existing uniques are+-- renamed deterministically and new ones are produced deterministically too.+-- The overview of object determinism is given by Note [Object determinism].+-- References to this note identify code where the unique determinism may+-- impact object determinism more specifically.  eqUnique :: Unique -> Unique -> Bool eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
compiler/GHC/Types/Unique/DFM.hs view
@@ -41,11 +41,12 @@         alterUDFM,         mapUDFM,         mapMaybeUDFM,+        mapMUDFM,         plusUDFM,-        plusUDFM_C,+        plusUDFM_C, plusUDFM_CK,         lookupUDFM, lookupUDFM_Directly,         elemUDFM,-        foldUDFM,+        foldUDFM, foldWithKeyUDFM,         eltsUDFM,         filterUDFM, filterUDFM_Directly,         isNullUDFM,@@ -55,6 +56,7 @@         equalKeysUDFM,         minusUDFM,         listToUDFM, listToUDFM_Directly,+        listToUDFM_C_Directly,         udfmMinusUFM, ufmMinusUDFM,         partitionUDFM,         udfmRestrictKeys,@@ -223,6 +225,12 @@ addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) {-# INLINEABLE addListToUDFM_Directly_C #-} +-- | Like 'addListToUDFM_Directly_C' but also passes the unique key to the combine function+addListToUDFM_Directly_CK+  :: (Unique -> elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt+addListToUDFM_Directly_CK f = foldl' (\m (k, v) -> addToUDFM_C_Directly (f k) m k v)+{-# INLINEABLE addListToUDFM_Directly_CK #-}+ delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i @@ -233,6 +241,15 @@   | i > j = insertUDFMIntoLeft_C f udfml udfmr   | otherwise = insertUDFMIntoLeft_C f udfmr udfml +-- | Like 'plusUDFM_C' but the combine function also receives the unique key+plusUDFM_CK :: (Unique -> elt -> elt -> elt) -> UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt+plusUDFM_CK f udfml@(UDFM _ i) udfmr@(UDFM _ j)+  -- we will use the upper bound on the tag as a proxy for the set size,+  -- to insert the smaller one into the bigger one+  | i > j = insertUDFMIntoLeft_CK f udfml udfmr+  | otherwise = insertUDFMIntoLeft_CK f udfmr udfml++ -- Note [Overflow on plusUDFM] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- There are multiple ways of implementing plusUDFM.@@ -281,6 +298,12 @@ insertUDFMIntoLeft_C f udfml udfmr =   addListToUDFM_Directly_C f udfml $ udfmToList udfmr +-- | Like 'insertUDFMIntoLeft_C', but the merge function also receives the unique key+insertUDFMIntoLeft_CK+  :: (Unique -> elt -> elt -> elt) -> UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt+insertUDFMIntoLeft_CK f udfml udfmr =+  addListToUDFM_Directly_CK f udfml $ udfmToList udfmr+ lookupUDFM :: Uniquable key => UniqDFM key elt -> key -> Maybe elt lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m @@ -297,6 +320,12 @@ -- This INLINE prevents a regression in !10568 foldUDFM k z m = foldr k z (eltsUDFM m) +-- | Like 'foldUDFM' but the function also receives a key+foldWithKeyUDFM :: (Unique -> elt -> a -> a) -> a -> UniqDFM key elt -> a+{-# INLINE foldWithKeyUDFM #-}+-- This INLINE was copied from foldUDFM+foldWithKeyUDFM k z m = foldr (uncurry k) z (udfmToList m)+ -- | Performs a nondeterministic strict fold over the UniqDFM. -- It's O(n), same as the corresponding function on `UniqFM`. -- If you use this please provide a justification why it doesn't introduce@@ -396,6 +425,9 @@ listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM key elt listToUDFM_Directly = foldl' (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM +listToUDFM_C_Directly :: (elt -> elt -> elt) -> [(Unique, elt)] -> UniqDFM key elt+listToUDFM_C_Directly f = foldl' (\m (u, v) -> addToUDFM_C_Directly f m u v) emptyUDFM+ -- | Apply a function to a particular element adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM key elt -> key -> UniqDFM key elt adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i@@ -428,6 +460,13 @@ -- Critical this is strict map, otherwise you get a big space leak when reloading -- in GHCi because all old ModDetails are retained (see pruneHomePackageTable). -- Modify with care.++{-# INLINEABLE mapMUDFM #-}+-- | 'mapM' for a 'UniqDFM'.+mapMUDFM :: Monad m => (elt1 -> m elt2) -> UniqDFM key elt1 -> m (UniqDFM key elt2)+mapMUDFM f (UDFM m i) = do+  m' <- traverse (traverse f) m+  return $ UDFM m' i  mapMaybeUDFM :: forall elt1 elt2 key.                 (elt1 -> Maybe elt2) -> UniqDFM key elt1 -> UniqDFM key elt2
+ compiler/GHC/Types/Unique/DSM.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE UnboxedTuples, PatternSynonyms, DerivingVia #-}+module GHC.Types.Unique.DSM+  (+  -- * Threading a deterministic supply+    DUniqSupply+  , UniqDSM(UDSM)+  , DUniqResult+  , pattern DUniqResult++  -- ** UniqDSM and DUniqSupply operations+  , getUniqueDSM+  , runUniqueDSM+  , takeUniqueFromDSupply+  , initDUniqSupply++  -- ** Tag operations+  , newTagDUniqSupply+  , getTagDUniqSupply++  -- * A transfomer threading a deterministic supply+  , UniqDSMT(UDSMT)++  -- ** UniqDSMT operations+  , runUDSMT+  , withDUS+  , hoistUDSMT+  , liftUDSMT++  -- ** Tags+  , setTagUDSMT++  -- * Monad class for deterministic supply threading+  , MonadGetUnique(..)+  , MonadUniqDSM(..)++  )+  where++import GHC.Exts (oneShot)+import GHC.Prelude+import GHC.Word+import Control.Monad.Fix+import GHC.Types.Unique+import qualified GHC.Utils.Monad.State.Strict as Strict+import qualified GHC.Types.Unique.Supply as USM+import Control.Monad.IO.Class++{-+Note [Deterministic Uniques in the CG]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHC produces fully deterministic object code. To achieve this, there is a key+pass (detRenameCmmGroup) which renames all non-deterministic uniques in+the Cmm code right after StgToCmm. See Note [Object determinism] for the big+picture and some details.++The code generation pipeline that processes this renamed, deterministic, Cmm,+however, may still need to generate new uniques. If we were to resort to the+non-deterministic unique supply used in the rest of the compiler, our renaming+efforts would be for naught.++Therefore, after having renamed Cmm deterministically, we must ensure that all+uniques created by the code generation pipeline use a deterministic source of uniques.+Most often, this means don't use `UniqSM` in the Cmm passes, use `UniqDSM`:++`UniqDSM` is a pure state monad with an incrementing counter from which we+source new uniques. Unlike `UniqSM`, there's no way to `split` the supply, but+it turns out this was rarely really needed for code generation and migrating+from UniqSM to UniqDSM was easy.++Secondly, the `DUniqSupply` used to run a `UniqDSM` must be threaded through+all passes to guarantee uniques in different passes are unique amongst them+altogether.+Specifically, the same `DUniqSupply` must be threaded through the CG Streaming+pipeline, starting with Driver.Main calling `StgToCmm.codeGen`, `cmmPipeline`,+`cmmToRawCmm`, and `codeOutput` in sequence.++To thread resources through the `Stream` abstraction, we use the `UniqDSMT`+transformer on top of `IO` as the Monad underlying the Stream. `UniqDSMT` will+thread the `DUniqSupply` through every pass applied to the `Stream`, for every+element. We use @type CgStream = Stream (UniqDSMT IO)@ for the Stream used in+code generation which that carries through the deterministic unique supply.++Unlike non-deterministic unique supplies which can be split into supplies using+different tags, or where a new supply with a new tag can be brought from the+void, a `DUniqSupply` needs to be sampled iteratively. To use a different tag+during a specific pass (to more easily identify uniques created in it), the tag+should be manually set and then reset on the unique supply. There's also the+auxiliary `setTagUDSMT` which sets the tag for all uniques supplied in the given+action, and resets it implicitly.++See also Note [Object determinism] in GHC.StgToCmm+-}++-- See Note [Deterministic Uniques in the CG]+newtype DUniqSupply = DUS Word64 -- supply uniques iteratively+type DUniqResult result = (# result, DUniqSupply #)++pattern DUniqResult :: a -> DUniqSupply -> (# a, DUniqSupply #)+pattern DUniqResult x y = (# x, y #)+{-# COMPLETE DUniqResult #-}++-- | A monad which just gives the ability to obtain 'Unique's deterministically.+-- There's no splitting.+newtype UniqDSM result = UDSM' { unUDSM :: DUniqSupply -> DUniqResult result }+  deriving (Functor, Applicative, Monad) via (Strict.State DUniqSupply)++instance MonadFix UniqDSM where+  mfix m = UDSM (\us0 -> let (r,us1) = runUniqueDSM us0 (m r) in DUniqResult r us1)++-- See Note [The one-shot state monad trick] in GHC.Utils.Monad+pattern UDSM :: (DUniqSupply -> DUniqResult a) -> UniqDSM a+pattern UDSM m <- UDSM' m+  where+    UDSM m = UDSM' (oneShot $ \s -> m s)+{-# COMPLETE UDSM #-}++getUniqueDSM :: UniqDSM Unique+getUniqueDSM = UDSM (\(DUS us0) -> DUniqResult (mkUniqueGrimily us0) (DUS $ us0+1))++takeUniqueFromDSupply :: DUniqSupply -> (Unique, DUniqSupply)+takeUniqueFromDSupply d =+  case unUDSM getUniqueDSM d of+    DUniqResult x y -> (x, y)++-- | Initialize a deterministic unique supply with the given Tag and initial unique.+initDUniqSupply :: Char -> Word64 -> DUniqSupply+initDUniqSupply c firstUniq =+  let !tag = mkTag c+  in DUS (tag .|. firstUniq)++runUniqueDSM :: DUniqSupply -> UniqDSM a -> (a, DUniqSupply)+runUniqueDSM ds (UDSM f) =+  case f ds of+    DUniqResult uq us -> (uq, us)++-- | Set the tag of uniques generated from this deterministic unique supply+newTagDUniqSupply :: Char -> DUniqSupply -> DUniqSupply+newTagDUniqSupply c (DUS w) = DUS $ getKey $ newTagUnique (mkUniqueGrimily w) c++-- | Get the tag uniques generated from this deterministic unique supply would have+getTagDUniqSupply :: DUniqSupply -> Char+getTagDUniqSupply (DUS w) = fst $ unpkUnique (mkUniqueGrimily w)++-- | Get a unique from a monad that can access a unique supply.+--+-- Crucially, because 'MonadGetUnique' doesn't allow you to get the+-- 'UniqSupply' (unlike 'MonadUnique'), an instance such as 'UniqDSM' can use a+-- deterministic unique supply to return deterministic uniques without allowing+-- for the 'UniqSupply' to be shared.+class Monad m => MonadGetUnique m where+  getUniqueM :: m Unique++instance MonadGetUnique UniqDSM where+  getUniqueM = getUniqueDSM++-- non deterministic instance+instance MonadGetUnique USM.UniqSM where+  getUniqueM = USM.getUniqueM++--------------------------------------------------------------------------------+-- UniqDSMT+--------------------------------------------------------------------------------++-- | Transformer version of 'UniqDSM' to use when threading a deterministic+-- uniq supply over a Monad. Specifically, it is used in the `Stream` of Cmm+-- decls.+newtype UniqDSMT m result = UDSMT' (DUniqSupply -> m (result, DUniqSupply))+  deriving (Functor)++-- Similar to GHC.Utils.Monad.State.Strict, using Note [The one-shot state monad trick]+-- Using the one-shot trick is necessary for performance.+-- Using transfomer's strict `StateT` regressed some performance tests in 1-2%.+-- The one-shot trick here fixes those regressions.++pattern UDSMT :: (DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result+pattern UDSMT m <- UDSMT' m+  where+    UDSMT m = UDSMT' (oneShot $ \s -> m s)+{-# COMPLETE UDSMT #-}++instance Monad m => Applicative (UniqDSMT m) where+  pure x = UDSMT $ \s -> pure (x, s)+  UDSMT f <*> UDSMT x = UDSMT $ \s0 -> do+    (f', s1) <- f s0+    (x', s2) <- x s1+    pure (f' x', s2)++instance Monad m => Monad (UniqDSMT m) where+  UDSMT x >>= f = UDSMT $ \s0 -> do+    (x', s1) <- x s0+    case f x' of UDSMT y -> y s1++instance MonadIO m => MonadIO (UniqDSMT m) where+  liftIO x = UDSMT $ \s -> (,s) <$> liftIO x++instance Monad m => MonadGetUnique (UniqDSMT m) where+  getUniqueM = UDSMT $ \us -> do+    let (u, us') = takeUniqueFromDSupply us+    return (u, us')++-- | Set the tag of the running @UniqDSMT@ supply to the given tag and run an action with it.+-- All uniques produced in the given action will use this tag, until the tag is changed+-- again.+setTagUDSMT :: Monad m => Char {-^ Tag -} -> UniqDSMT m a -> UniqDSMT m a+setTagUDSMT tag (UDSMT act) = UDSMT $ \us -> do+  let origtag = getTagDUniqSupply us+      new_us  = newTagDUniqSupply tag us+  (a, us') <- act new_us+  let us'_origtag = newTagDUniqSupply origtag us'+      -- restore original tag+  return (a, us'_origtag)++-- | Like 'runUniqueDSM' but for 'UniqDSMT'+runUDSMT :: DUniqSupply -> UniqDSMT m a -> m (a, DUniqSupply)+runUDSMT dus (UDSMT st) = st dus++-- | Lift an IO action that depends on, and threads through, a unique supply+-- into UniqDSMT IO.+withDUS :: (DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a+withDUS f = UDSMT $ \us -> do+  (a, us') <- liftIO (f us)+  return (a, us')++-- | Change the monad underyling an applied @UniqDSMT@, i.e. transform a+-- @UniqDSMT m@ into a @UniqDSMT n@ given @m ~> n@.+hoistUDSMT :: (forall x. m x -> n x) -> UniqDSMT m a -> UniqDSMT n a+hoistUDSMT nt (UDSMT m) = UDSMT $ \s -> nt (m s)++-- | Lift a monadic action @m a@ into an @UniqDSMT m a@+liftUDSMT :: Functor m => m a -> UniqDSMT m a+liftUDSMT m = UDSMT $ \s -> (,s) <$> m++--------------------------------------------------------------------------------+-- MonadUniqDSM+--------------------------------------------------------------------------------++class (Monad m) => MonadUniqDSM m where+  -- | Lift a pure 'UniqDSM' action into a 'MonadUniqDSM' such as 'UniqDSMT'+  liftUniqDSM :: UniqDSM a -> m a++instance MonadUniqDSM UniqDSM where+  liftUniqDSM = id++instance Monad m => MonadUniqDSM (UniqDSMT m) where+  liftUniqDSM act = UDSMT $ \us -> pure $ runUniqueDSM us act
compiler/GHC/Types/Unique/DSet.hs view
@@ -33,7 +33,7 @@         lookupUniqDSet,         uniqDSetToList,         partitionUniqDSet,-        mapUniqDSet+        mapUniqDSet, strictFoldUniqDSet, mapMUniqDSet     ) where  import GHC.Prelude@@ -125,7 +125,22 @@  -- See Note [UniqSet invariant] in GHC.Types.Unique.Set mapUniqDSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b-mapUniqDSet f = mkUniqDSet . map f . uniqDSetToList+mapUniqDSet f (UniqDSet m) = UniqDSet $ unsafeCastUDFMKey $ mapUDFM f m+  -- Simply apply `f` to each element, retaining all the structure unchanged.+  -- The identification of keys and elements prevents a derived Functor+  -- instance, but `unsafeCastUDFMKey` makes it possible to apply the strict+  -- mapping from DFM.++-- | Like 'mapUniqDSet' but for 'mapM'. Assumes the function we are mapping+-- over the 'UniqDSet' does not modify uniques, as per+-- Note [UniqSet invariant] in GHC.Types.Unique.Set.+mapMUniqDSet :: (Monad m, Uniquable b) => (a -> m b) -> UniqDSet a -> m (UniqDSet b)+mapMUniqDSet f (UniqDSet m) = UniqDSet . unsafeCastUDFMKey <$> mapMUDFM f m+{-# INLINEABLE mapMUniqDSet #-}++strictFoldUniqDSet :: (a -> r -> r) -> r -> UniqDSet a -> r+strictFoldUniqDSet k r s = foldl' (\ !r e -> k e r) r $+                           uniqDSetToList s  -- Two 'UniqDSet's are considered equal if they contain the same -- uniques.
compiler/GHC/Types/Unique/FM.hs view
@@ -71,7 +71,7 @@         nonDetStrictFoldUFM_Directly,         anyUFM, allUFM, seqEltsUFM,         mapUFM, mapUFM_Directly, strictMapUFM,-        mapMaybeUFM, mapMaybeWithKeyUFM,+        mapMaybeUFM, mapMaybeUFM_sameUnique, mapMaybeWithKeyUFM,         elemUFM, elemUFM_Directly,         filterUFM, filterUFM_Directly, partitionUFM,         sizeUFM,@@ -389,7 +389,12 @@ mapUFM f (UFM m) = UFM (M.map f m)  mapMaybeUFM :: (elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2-mapMaybeUFM f (UFM m) = UFM (M.mapMaybe f m)+mapMaybeUFM = mapMaybeUFM_sameUnique++-- | Like 'Data.Map.mapMaybe', but you must ensure the passed-in function does+-- not modify the unique.+mapMaybeUFM_sameUnique :: (elt1 -> Maybe elt2) -> UniqFM key1 elt1 -> UniqFM key2 elt2+mapMaybeUFM_sameUnique f (UFM m) = UFM (M.mapMaybe f m)  mapMaybeWithKeyUFM :: (Unique -> elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2 mapMaybeWithKeyUFM f (UFM m) = UFM (M.mapMaybeWithKey (f . mkUniqueGrimily) m)
compiler/GHC/Types/Unique/Set.hs view
@@ -44,6 +44,27 @@         nonDetEltsUniqSet,         nonDetKeysUniqSet,         nonDetStrictFoldUniqSet,+        mapMaybeUniqSet_sameUnique,++        -- UniqueSet+        UniqueSet(..),+        nullUniqueSet,+        sizeUniqueSet,+        memberUniqueSet,+        emptyUniqueSet,+        singletonUniqueSet,+        insertUniqueSet,+        deleteUniqueSet,+        differenceUniqueSet,+        unionUniqueSet,+        unionsUniqueSet,+        intersectionUniqueSet,+        isSubsetOfUniqueSet,+        filterUniqueSet,+        foldlUniqueSet,+        foldrUniqueSet,+        elemsUniqueSet,+        fromListUniqueSet,     ) where  import GHC.Prelude@@ -55,6 +76,8 @@ import GHC.Utils.Outputable import Data.Data import qualified Data.Semigroup as Semi+import Control.DeepSeq+import qualified GHC.Data.Word64Set as S  -- Note [UniqSet invariant] -- ~~~~~~~~~~~~~~~~~~~~~~~~~@@ -63,9 +86,13 @@ -- It means that to implement mapUniqSet you have to update -- both the keys and the values. +-- | Set of Uniquable values newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a a}                   deriving (Data, Semi.Semigroup, Monoid) +instance NFData a => NFData (UniqSet a) where+  rnf = forceUniqSet rnf+ emptyUniqSet :: UniqSet a emptyUniqSet = UniqSet emptyUFM @@ -179,6 +206,11 @@ mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet +-- | Like 'Data.Set.mapMaybe', but you must ensure the passed in function+-- does not change the 'Unique'.+mapMaybeUniqSet_sameUnique :: (a -> Maybe b) -> UniqSet a -> UniqSet b+mapMaybeUniqSet_sameUnique f (UniqSet a) = UniqSet $ mapMaybeUFM_sameUnique f a+ -- Two 'UniqSet's are considered equal if they contain the same -- uniques. instance Eq (UniqSet a) where@@ -200,3 +232,84 @@ -- It's OK to use nonDetUFMToList here because we only use it for -- pretty-printing. pprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet++forceUniqSet :: (a -> ()) -> UniqSet a -> ()+forceUniqSet f (UniqSet fm) = seqEltsUFM f fm++--------------------------------------------------------+-- UniqueSet+--------------------------------------------------------++-- | Set of Unique values+--+-- Similar to 'UniqSet Unique' but with a more compact representation.+newtype UniqueSet = US { unUniqueSet :: S.Word64Set }+  deriving (Eq, Ord, Show, Semigroup, Monoid)++{-# INLINE nullUniqueSet #-}+nullUniqueSet :: UniqueSet -> Bool+nullUniqueSet (US s) = S.null s++{-# INLINE sizeUniqueSet #-}+sizeUniqueSet :: UniqueSet -> Int+sizeUniqueSet (US s) = S.size s++{-# INLINE memberUniqueSet #-}+memberUniqueSet :: Unique -> UniqueSet -> Bool+memberUniqueSet k (US s) = S.member (getKey k) s++{-# INLINE emptyUniqueSet #-}+emptyUniqueSet :: UniqueSet+emptyUniqueSet = US S.empty++{-# INLINE singletonUniqueSet #-}+singletonUniqueSet :: Unique -> UniqueSet+singletonUniqueSet k = US (S.singleton (getKey k))++{-# INLINE insertUniqueSet #-}+insertUniqueSet :: Unique -> UniqueSet -> UniqueSet+insertUniqueSet k (US s) = US (S.insert (getKey k) s)++{-# INLINE deleteUniqueSet #-}+deleteUniqueSet :: Unique -> UniqueSet -> UniqueSet+deleteUniqueSet k (US s) = US (S.delete (getKey k) s)++{-# INLINE unionUniqueSet #-}+unionUniqueSet :: UniqueSet -> UniqueSet -> UniqueSet+unionUniqueSet (US x) (US y) = US (S.union x y)++{-# INLINE unionsUniqueSet #-}+unionsUniqueSet :: [UniqueSet] -> UniqueSet+unionsUniqueSet xs = US (S.unions (map unUniqueSet xs))++{-# INLINE differenceUniqueSet #-}+differenceUniqueSet :: UniqueSet -> UniqueSet -> UniqueSet+differenceUniqueSet (US x) (US y) = US (S.difference x y)++{-# INLINE intersectionUniqueSet #-}+intersectionUniqueSet :: UniqueSet -> UniqueSet -> UniqueSet+intersectionUniqueSet (US x) (US y) = US (S.intersection x y)++{-# INLINE isSubsetOfUniqueSet #-}+isSubsetOfUniqueSet :: UniqueSet -> UniqueSet -> Bool+isSubsetOfUniqueSet (US x) (US y) = S.isSubsetOf x y++{-# INLINE filterUniqueSet #-}+filterUniqueSet :: (Unique -> Bool) -> UniqueSet -> UniqueSet+filterUniqueSet f (US s) = US (S.filter (f . mkUniqueGrimily) s)++{-# INLINE foldlUniqueSet #-}+foldlUniqueSet :: (a -> Unique -> a) -> a -> UniqueSet -> a+foldlUniqueSet k z (US s) = S.foldl' (\a b -> k a (mkUniqueGrimily b)) z s++{-# INLINE foldrUniqueSet #-}+foldrUniqueSet :: (Unique -> b -> b) -> b -> UniqueSet -> b+foldrUniqueSet k z (US s) = S.foldr (k . mkUniqueGrimily) z s++{-# INLINE elemsUniqueSet #-}+elemsUniqueSet :: UniqueSet -> [Unique]+elemsUniqueSet (US s) = map mkUniqueGrimily (S.elems s)++{-# INLINE fromListUniqueSet #-}+fromListUniqueSet :: [Unique] -> UniqueSet+fromListUniqueSet ks = US (S.fromList (map getKey ks))
compiler/GHC/Types/Unique/Supply.hs view
@@ -4,6 +4,7 @@ -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE UnboxedTuples #-}@@ -41,6 +42,7 @@ import Data.Word import GHC.Exts( Ptr(..), noDuplicate#, oneShot ) import Foreign.Storable+import GHC.Utils.Monad.State.Strict as Strict  #include "MachDeps.h" @@ -169,8 +171,7 @@ benefits of threading the tag this *also* has the benefit of avoiding the tag getting captured in thunks, or being passed around at runtime. It does however come at the cost of having to use a fixed tag for all-code run in this Monad. But remember, the tag is purely cosmetic:-See Note [Uniques and tags].+code run in this Monad. The tag is mostly cosmetic: See Note [Uniques and tags].  NB: It's *not* an optimization to pass around the UniqSupply inside an IORef instead of the tag. While this would avoid frequent state updates@@ -201,9 +202,8 @@  mkSplitUniqSupply :: Char -> IO UniqSupply -- ^ Create a unique supply out of thin air.--- The "tag" (Char) supplied is purely cosmetic, making it easier--- to figure out where a Unique was born. See--- Note [Uniques and tags].+-- The "tag" (Char) supplied is mostly cosmetic, making it easier+-- to figure out where a Unique was born. See Note [Uniques and tags]. -- -- The payload part of the Uniques allocated from this UniqSupply are -- guaranteed distinct wrt all other supplies, regardless of their "tag".@@ -304,6 +304,8 @@ uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2 takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1) +{-# INLINE splitUniqSupply #-}+ {- ************************************************************************ *                                                                      *@@ -320,12 +322,7 @@  -- | A monad which just gives the ability to obtain 'Unique's newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }---- See Note [The one-shot state monad trick] for why we don't derive this.-instance Functor UniqSM where-  fmap f (USM m) = mkUniqSM $ \us ->-      case m us of-        (# r, us' #) -> UniqResult (f r) us'+  deriving (Functor, Applicative, Monad) via (Strict.State UniqSupply)  -- | Smart constructor for 'UniqSM', as described in Note [The one-shot state -- monad trick].@@ -333,17 +330,6 @@ mkUniqSM f = USM (oneShot f) {-# INLINE mkUniqSM #-} -instance Monad UniqSM where-  (>>=) = thenUs-  (>>)  = (*>)--instance Applicative UniqSM where-    pure = returnUs-    (USM f) <*> (USM x) = mkUniqSM $ \us0 -> case f us0 of-                            UniqResult ff us1 -> case x us1 of-                              UniqResult xx us2 -> UniqResult (ff xx) us2-    (*>) = thenUs_- -- TODO: try to get rid of this instance instance MonadFail UniqSM where     fail = panic@@ -356,29 +342,11 @@ initUs_ :: UniqSupply -> UniqSM a -> a initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r } -{-# INLINE thenUs #-}-{-# INLINE returnUs #-}-{-# INLINE splitUniqSupply #-}---- @thenUs@ is where we split the @UniqSupply@.- liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply) liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1)  instance MonadFix UniqSM where     mfix m = mkUniqSM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1)--thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b-thenUs (USM expr) cont-  = mkUniqSM (\us0 -> case (expr us0) of-                   UniqResult result us1 -> unUSM (cont result) us1)--thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b-thenUs_ (USM expr) (USM cont)-  = mkUniqSM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 })--returnUs :: a -> UniqSM a-returnUs result = mkUniqSM (\us -> UniqResult result us)  getUs :: UniqSM UniqSupply getUs = mkUniqSM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2)
compiler/GHC/Types/Var.hs view
@@ -129,8 +129,10 @@ import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Hs.Specificity ()+import Language.Haskell.Syntax.Specificity+ import Data.Data-import Control.DeepSeq  {- ************************************************************************@@ -341,9 +343,12 @@ -}  instance Outputable Var where-  ppr var = sdocOption sdocSuppressVarKinds $ \supp_var_kinds ->+  ppr var = docWithStyle ppr_code ppr_normal+    where+      -- don't display debug info with Code style (#25255)+      ppr_code = ppr (varName var)+      ppr_normal sty = sdocOption sdocSuppressVarKinds $ \supp_var_kinds ->             getPprDebug $ \debug ->-            getPprStyle $ \sty ->             let               ppr_var = case var of                   (TyVar {})@@ -451,97 +456,6 @@  {- ********************************************************************* *                                                                      *-*                   ForAllTyFlag-*                                                                      *-********************************************************************* -}---- | ForAllTyFlag------ Is something required to appear in source Haskell ('Required'),--- permitted by request ('Specified') (visible type application), or--- prohibited entirely from appearing in source Haskell ('Inferred')?--- See Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in "GHC.Core.TyCo.Rep"-data ForAllTyFlag = Invisible !Specificity-                  | Required-  deriving (Eq, Ord, Data)-  -- (<) on ForAllTyFlag means "is less visible than"---- | Whether an 'Invisible' argument may appear in source Haskell.-data Specificity = InferredSpec-                   -- ^ the argument may not appear in source Haskell, it is-                   -- only inferred.-                 | SpecifiedSpec-                   -- ^ the argument may appear in source Haskell, but isn't-                   -- required.-  deriving (Eq, Ord, Data)--pattern Inferred, Specified :: ForAllTyFlag-pattern Inferred  = Invisible InferredSpec-pattern Specified = Invisible SpecifiedSpec--{-# COMPLETE Required, Specified, Inferred #-}---- | Does this 'ForAllTyFlag' classify an argument that is written in Haskell?-isVisibleForAllTyFlag :: ForAllTyFlag -> Bool-isVisibleForAllTyFlag af = not (isInvisibleForAllTyFlag af)---- | Does this 'ForAllTyFlag' classify an argument that is not written in Haskell?-isInvisibleForAllTyFlag :: ForAllTyFlag -> Bool-isInvisibleForAllTyFlag (Invisible {}) = True-isInvisibleForAllTyFlag Required       = False--isInferredForAllTyFlag :: ForAllTyFlag -> Bool--- More restrictive than isInvisibleForAllTyFlag-isInferredForAllTyFlag (Invisible InferredSpec) = True-isInferredForAllTyFlag _                        = False--isSpecifiedForAllTyFlag :: ForAllTyFlag -> Bool--- More restrictive than isInvisibleForAllTyFlag-isSpecifiedForAllTyFlag (Invisible SpecifiedSpec) = True-isSpecifiedForAllTyFlag _                         = False--coreTyLamForAllTyFlag :: ForAllTyFlag--- ^ The ForAllTyFlag on a (Lam a e) term, where `a` is a type variable.--- If you want other ForAllTyFlag, use a cast.--- See Note [Required foralls in Core] in GHC.Core.TyCo.Rep-coreTyLamForAllTyFlag = Specified--instance Outputable ForAllTyFlag where-  ppr Required  = text "[req]"-  ppr Specified = text "[spec]"-  ppr Inferred  = text "[infrd]"--instance Binary Specificity where-  put_ bh SpecifiedSpec = putByte bh 0-  put_ bh InferredSpec  = putByte bh 1--  get bh = do-    h <- getByte bh-    case h of-      0 -> return SpecifiedSpec-      _ -> return InferredSpec--instance Binary ForAllTyFlag where-  put_ bh Required  = putByte bh 0-  put_ bh Specified = putByte bh 1-  put_ bh Inferred  = putByte bh 2--  get bh = do-    h <- getByte bh-    case h of-      0 -> return Required-      1 -> return Specified-      _ -> return Inferred--instance NFData Specificity where-  rnf SpecifiedSpec = ()-  rnf InferredSpec = ()-instance NFData ForAllTyFlag where-  rnf (Invisible spec) = rnf spec-  rnf Required = ()--{- *********************************************************************-*                                                                      * *                   FunTyFlag *                                                                      * ********************************************************************* -}@@ -720,7 +634,7 @@  data VarBndr var argf = Bndr var argf   -- See Note [The VarBndr type and its uses]-  deriving( Data )+  deriving( Data, Eq, Ord)  -- | Variable Binder --
compiler/GHC/Types/Var.hs-boot view
@@ -2,13 +2,12 @@ module GHC.Types.Var where  import {-# SOURCE #-} GHC.Types.Name+import Language.Haskell.Syntax.Specificity (Specificity) -data ForAllTyFlag data FunTyFlag data Var instance NamedThing Var data VarBndr var argf-data Specificity type TyVar = Var type Id    = Var type TyCoVar = Id
compiler/GHC/Types/Var/Env.hs view
@@ -470,7 +470,7 @@ delTidyEnvList :: TidyEnv -> [Var] -> TidyEnv delTidyEnvList (occ_env, var_env) vs = (occ_env', var_env')   where-    occ_env' = occ_env `delTidyOccEnvList` map (occNameFS . getOccName) vs+    occ_env' = occ_env `delTidyOccEnvList` map getOccName vs     var_env' = var_env `delVarEnvList` vs  {-
compiler/GHC/Types/Var/Set.hs view
@@ -26,7 +26,7 @@         nonDetStrictFoldVarSet,          -- * Deterministic Var set types-        DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,+        DVarSet, DIdSet, DTyVarSet, DCoVarSet, DTyCoVarSet,          -- ** Manipulating these sets         emptyDVarSet, unitDVarSet, mkDVarSet,@@ -38,7 +38,7 @@         isEmptyDVarSet, delDVarSet, delDVarSetList,         minusDVarSet,         nonDetStrictFoldDVarSet,-        filterDVarSet, mapDVarSet,+        filterDVarSet, mapDVarSet, strictFoldDVarSet,         dVarSetMinusVarSet, anyDVarSet, allDVarSet,         transCloDVarSet,         sizeDVarSet, seqDVarSet,@@ -232,6 +232,9 @@ -- | Deterministic Type Variable Set type DTyVarSet   = UniqDSet TyVar +-- | Deterministic Coercion Variable Set+type DCoVarSet   = UniqDSet CoVar+ -- | Deterministic Type or Coercion Variable Set type DTyCoVarSet = UniqDSet TyCoVar @@ -307,6 +310,9 @@  mapDVarSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b mapDVarSet = mapUniqDSet++strictFoldDVarSet :: (a -> r -> r) -> r -> UniqDSet a -> r+strictFoldDVarSet = strictFoldUniqDSet  filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet filterDVarSet = filterUniqDSet
compiler/GHC/Unit/External.hs view
@@ -31,6 +31,8 @@ import GHC.Types.TypeEnv import GHC.Types.Unique.DSet +import GHC.Linker.Types (Linkable)+ import Data.IORef  @@ -39,7 +41,7 @@ type PackageInstEnv          = InstEnv type PackageFamInstEnv       = FamInstEnv type PackageAnnEnv           = AnnEnv-type PackageCompleteMatches = CompleteMatches+type PackageCompleteMatches  = CompleteMatches  -- | Helps us find information about modules in the imported packages type PackageIfaceTable = ModuleEnv ModIface@@ -68,6 +70,7 @@   , eps_PIT              = emptyPackageIfaceTable   , eps_free_holes       = emptyInstalledModuleEnv   , eps_PTE              = emptyTypeEnv+  , eps_iface_bytecode   = emptyModuleEnv   , eps_inst_env         = emptyInstEnv   , eps_fam_inst_env     = emptyFamInstEnv   , eps_rule_base        = mkRuleBase builtinRules@@ -138,6 +141,12 @@                 -- ^ Result of typechecking all the external package                 -- interface files we have sucked in. The domain of                 -- the mapping is external-package modules++        -- | If an interface was written with @-fwrite-if-simplified-core@, this+        -- will contain an IO action that compiles bytecode from core bindings.+        --+        -- See Note [Interface Files with Core Definitions]+        eps_iface_bytecode :: !(ModuleEnv (IO Linkable)),          eps_inst_env     :: !PackageInstEnv,   -- ^ The total 'InstEnv' accumulated                                                -- from all the external-package modules
compiler/GHC/Unit/Finder/Types.hs view
@@ -1,6 +1,7 @@ module GHC.Unit.Finder.Types    ( FinderCache (..)    , FinderCacheState+   , FileCacheState    , FindResult (..)    , InstalledFindResult (..)    , FinderOpts(..)@@ -9,11 +10,12 @@  import GHC.Prelude import GHC.Unit+import GHC.Data.OsPath import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways+import GHC.Unit.Env -import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set @@ -24,14 +26,23 @@ -- type FinderCacheState = InstalledModuleEnv InstalledFindResult type FileCacheState   = M.Map FilePath Fingerprint-data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState)-                               , fcFileCache   :: (IORef FileCacheState)+data FinderCache = FinderCache { flushFinderCaches :: UnitEnv -> IO ()+                               -- ^ remove all the home modules from the cache; package modules are+                               -- assumed to not move around during a session; also flush the file hash+                               -- cache.+                               , addToFinderCache  :: InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()+                               -- ^ Add a found location to the cache for the module.+                               , lookupFinderCache :: InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)+                               -- ^ Look for a location in the cache.+                               , lookupFileCache   :: FilePath -> IO Fingerprint+                               -- ^ Look for the hash of a file in the cache. This should add it to the+                               -- cache. If the file doesn't exist, raise an IOException.                                }  data InstalledFindResult   = InstalledFound ModLocation InstalledModule   | InstalledNoPackage UnitId-  | InstalledNotFound [FilePath] (Maybe UnitId)+  | InstalledNotFound [OsPath] (Maybe UnitId)  -- | The result of searching for an imported module. --@@ -70,7 +81,7 @@ -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts-  { finder_importPaths :: [FilePath]+  { finder_importPaths :: [OsPath]       -- ^ Where are we allowed to look for Modules and Source files   , finder_lookupHomeInterfaces :: Bool       -- ^ When looking up a home module:@@ -88,17 +99,17 @@   , finder_enableSuggestions :: Bool       -- ^ If we encounter unknown modules, should we suggest modules       -- that have a similar name.-  , finder_workingDirectory :: Maybe FilePath+  , finder_workingDirectory :: Maybe OsPath   , finder_thisPackageName  :: Maybe FastString   , finder_hiddenModules    :: Set.Set ModuleName-  , finder_reexportedModules :: Set.Set ModuleName-  , finder_hieDir :: Maybe FilePath-  , finder_hieSuf :: String-  , finder_hiDir :: Maybe FilePath-  , finder_hiSuf :: String-  , finder_dynHiSuf :: String-  , finder_objectDir :: Maybe FilePath-  , finder_objectSuf :: String-  , finder_dynObjectSuf :: String-  , finder_stubDir :: Maybe FilePath-  } deriving Show+  , finder_reexportedModules :: M.Map ModuleName ModuleName -- Reverse mapping, if you are looking for this name then look for this module.+  , finder_hieDir :: Maybe OsPath+  , finder_hieSuf :: OsString+  , finder_hiDir :: Maybe OsPath+  , finder_hiSuf :: OsString+  , finder_dynHiSuf :: OsString+  , finder_objectDir :: Maybe OsPath+  , finder_objectSuf :: OsString+  , finder_dynObjectSuf :: OsString+  , finder_stubDir :: Maybe OsPath+  }
compiler/GHC/Unit/Home/ModInfo.hs view
@@ -12,6 +12,7 @@    , emptyHomePackageTable    , lookupHpt    , eltsHpt+   , concatHpt    , filterHpt    , allHpt    , anyHpt@@ -34,7 +35,7 @@ import GHC.Unit.Module.ModDetails import GHC.Unit.Module -import GHC.Linker.Types ( Linkable(..), isObjectLinkable )+import GHC.Linker.Types ( Linkable(..), linkableIsNativeCodeOnly )  import GHC.Types.Unique import GHC.Types.Unique.DFM@@ -90,17 +91,17 @@  justBytecode :: Linkable -> HomeModLinkable justBytecode lm =-  assertPpr (not (isObjectLinkable lm)) (ppr lm)+  assertPpr (not (linkableIsNativeCodeOnly lm)) (ppr lm)    $ emptyHomeModInfoLinkable { homeMod_bytecode = Just lm }  justObjects :: Linkable -> HomeModLinkable justObjects lm =-  assertPpr (isObjectLinkable lm) (ppr lm)+  assertPpr (linkableIsNativeCodeOnly lm) (ppr lm)    $ emptyHomeModInfoLinkable { homeMod_object = Just lm }  bytecodeAndObjects :: Linkable -> Linkable -> HomeModLinkable bytecodeAndObjects bc o =-  assertPpr (not (isObjectLinkable bc) && isObjectLinkable o) (ppr bc $$ ppr o)+  assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o)     (HomeModLinkable (Just bc) (Just o))  @@ -145,6 +146,13 @@  eltsHpt :: HomePackageTable -> [HomeModInfo] eltsHpt = eltsUDFM++-- | Like @concatMap f . 'eltsHpt'@, but filters out all 'HomeModInfo' for which+-- @f@ returns the empty list before doing the sort inherent to 'eltsUDFM'.+concatHpt :: (HomeModInfo -> [a]) -> HomePackageTable -> [a]+concatHpt f = concat . eltsUDFM . mapMaybeUDFM g+  where+    g hmi = case f hmi of { [] -> Nothing; as -> Just as }  filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable filterHpt = filterUDFM
compiler/GHC/Unit/Module/Env.hs view
@@ -33,6 +33,17 @@    , mergeInstalledModuleEnv    , plusInstalledModuleEnv    , installedModuleEnvElts++     -- * InstalledModuleWithIsBootEnv+   , InstalledModuleWithIsBootEnv+   , emptyInstalledModuleWithIsBootEnv+   , lookupInstalledModuleWithIsBootEnv+   , extendInstalledModuleWithIsBootEnv+   , filterInstalledModuleWithIsBootEnv+   , delInstalledModuleWithIsBootEnv+   , mergeInstalledModuleWithIsBootEnv+   , plusInstalledModuleWithIsBootEnv+   , installedModuleWithIsBootEnvElts    ) where @@ -282,4 +293,57 @@   -> InstalledModuleEnv elt plusInstalledModuleEnv f (InstalledModuleEnv xm) (InstalledModuleEnv ym) =   InstalledModuleEnv $ Map.unionWith f xm ym++++--------------------------------------------------------------------+-- InstalledModuleWithIsBootEnv+--------------------------------------------------------------------++-- | A map keyed off of 'InstalledModuleWithIsBoot'+newtype InstalledModuleWithIsBootEnv elt = InstalledModuleWithIsBootEnv (Map InstalledModuleWithIsBoot elt)++instance Outputable elt => Outputable (InstalledModuleWithIsBootEnv elt) where+  ppr (InstalledModuleWithIsBootEnv env) = ppr env+++emptyInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a+emptyInstalledModuleWithIsBootEnv = InstalledModuleWithIsBootEnv Map.empty++lookupInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> Maybe a+lookupInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m = Map.lookup m e++extendInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> a -> InstalledModuleWithIsBootEnv a+extendInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m x = InstalledModuleWithIsBootEnv (Map.insert m x e)++filterInstalledModuleWithIsBootEnv :: (InstalledModuleWithIsBoot -> a -> Bool) -> InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBootEnv a+filterInstalledModuleWithIsBootEnv f (InstalledModuleWithIsBootEnv e) =+  InstalledModuleWithIsBootEnv (Map.filterWithKey f e)++delInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> InstalledModuleWithIsBootEnv a+delInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m = InstalledModuleWithIsBootEnv (Map.delete m e)++installedModuleWithIsBootEnvElts :: InstalledModuleWithIsBootEnv a -> [(InstalledModuleWithIsBoot, a)]+installedModuleWithIsBootEnvElts (InstalledModuleWithIsBootEnv e) = Map.assocs e++mergeInstalledModuleWithIsBootEnv+  :: (elta -> eltb -> Maybe eltc)+  -> (InstalledModuleWithIsBootEnv elta -> InstalledModuleWithIsBootEnv eltc)  -- map X+  -> (InstalledModuleWithIsBootEnv eltb -> InstalledModuleWithIsBootEnv eltc) -- map Y+  -> InstalledModuleWithIsBootEnv elta+  -> InstalledModuleWithIsBootEnv eltb+  -> InstalledModuleWithIsBootEnv eltc+mergeInstalledModuleWithIsBootEnv f g h (InstalledModuleWithIsBootEnv xm) (InstalledModuleWithIsBootEnv ym)+  = InstalledModuleWithIsBootEnv $ Map.mergeWithKey+      (\_ x y -> (x `f` y))+      (coerce g)+      (coerce h)+      xm ym++plusInstalledModuleWithIsBootEnv :: (elt -> elt -> elt)+  -> InstalledModuleWithIsBootEnv elt+  -> InstalledModuleWithIsBootEnv elt+  -> InstalledModuleWithIsBootEnv elt+plusInstalledModuleWithIsBootEnv f (InstalledModuleWithIsBootEnv xm) (InstalledModuleWithIsBootEnv ym) =+  InstalledModuleWithIsBootEnv $ Map.unionWith f xm ym
compiler/GHC/Unit/Module/Imported.hs view
@@ -13,10 +13,13 @@ import GHC.Types.Name.Reader import GHC.Types.SafeHaskell import GHC.Types.SrcLoc+import Data.Map (Map)  -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message-type ImportedMods = ModuleEnv [ImportedBy]+type ImportedMods = Map Module [ImportedBy]+  -- We don't want to use a `ModuleEnv` since it would leak a non-deterministic+  -- order to the interface files when passed as a list to `mkUsageInfo`.  -- | If a module was "imported" by the user, we associate it with -- more detailed usage information 'ImportedModsVal'; a module
compiler/GHC/Unit/Module/Location.hs view
@@ -1,25 +1,43 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-} -- | Module location module GHC.Unit.Module.Location-   ( ModLocation(..)+   ( ModLocation+    ( ..+    , ml_hs_file+    , ml_hi_file+    , ml_dyn_hi_file+    , ml_obj_file+    , ml_dyn_obj_file+    , ml_hie_file+    )+   , pattern ModLocation    , addBootSuffix    , addBootSuffix_maybe    , addBootSuffixLocn_maybe    , addBootSuffixLocn    , addBootSuffixLocnOut    , removeBootSuffix+   , mkFileSrcSpan    ) where  import GHC.Prelude++import GHC.Data.OsPath import GHC.Unit.Types+import GHC.Types.SrcLoc import GHC.Utils.Outputable+import GHC.Data.FastString (mkFastString) +import qualified System.OsString as OsString+ -- | Module Location -- -- Where a module lives on the file system: the actual locations -- of the .hs, .hi, .dyn_hi, .o, .dyn_o and .hie files, if we have them. ----- For a module in another unit, the ml_hs_file and ml_obj_file components of+-- For a module in another unit, the ml_hs_file_ospath and ml_obj_file_ospath components of -- ModLocation are undefined. -- -- The locations specified by a ModLocation may or may not@@ -38,31 +56,31 @@ -- boot suffixes in mkOneShotModLocation.  data ModLocation-   = ModLocation {-        ml_hs_file   :: Maybe FilePath,+   = OsPathModLocation {+        ml_hs_file_ospath   :: Maybe OsPath,                 -- ^ The source file, if we have one.  Package modules                 -- probably don't have source files. -        ml_hi_file   :: FilePath,+        ml_hi_file_ospath   :: OsPath,                 -- ^ Where the .hi file is, whether or not it exists                 -- yet.  Always of form foo.hi, even if there is an                 -- hi-boot file (we add the -boot suffix later) -        ml_dyn_hi_file :: FilePath,+        ml_dyn_hi_file_ospath :: OsPath,                 -- ^ Where the .dyn_hi file is, whether or not it exists                 -- yet. -        ml_obj_file  :: FilePath,+        ml_obj_file_ospath  :: OsPath,                 -- ^ Where the .o file is, whether or not it exists yet.                 -- (might not exist either because the module hasn't                 -- been compiled yet, or because it is part of a                 -- unit with a .a file) -        ml_dyn_obj_file :: FilePath,+        ml_dyn_obj_file_ospath :: OsPath,                 -- ^ Where the .dy file is, whether or not it exists                 -- yet. -        ml_hie_file  :: FilePath+        ml_hie_file_ospath  :: OsPath                 -- ^ Where the .hie file is, whether or not it exists                 -- yet.   } deriving Show@@ -71,18 +89,18 @@    ppr = text . show  -- | Add the @-boot@ suffix to .hs, .hi and .o files-addBootSuffix :: FilePath -> FilePath-addBootSuffix path = path ++ "-boot"+addBootSuffix :: OsPath -> OsPath+addBootSuffix path = path `mappend` os "-boot"  -- | Remove the @-boot@ suffix to .hs, .hi and .o files-removeBootSuffix :: FilePath -> FilePath-removeBootSuffix "-boot" = []-removeBootSuffix (x:xs)  = x : removeBootSuffix xs-removeBootSuffix []      = error "removeBootSuffix: no -boot suffix"-+removeBootSuffix :: OsPath -> OsPath+removeBootSuffix pathWithBootSuffix =+  case OsString.stripSuffix (os "-boot") pathWithBootSuffix of+    Just path -> path+    Nothing -> error "removeBootSuffix: no -boot suffix"  -- | Add the @-boot@ suffix if the @Bool@ argument is @True@-addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath+addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of   IsBoot -> addBootSuffix path   NotBoot -> path@@ -95,22 +113,59 @@ -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn-  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)-         , ml_hi_file  = addBootSuffix (ml_hi_file locn)-         , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)-         , ml_obj_file = addBootSuffix (ml_obj_file locn)-         , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)-         , ml_hie_file = addBootSuffix (ml_hie_file locn) }+  = locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn)+         , ml_hi_file_ospath  = addBootSuffix (ml_hi_file_ospath locn)+         , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn)+         , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn)+         , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn)+         , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) }  -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn-  = locn { ml_hi_file  = addBootSuffix (ml_hi_file locn)-         , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)-         , ml_obj_file = addBootSuffix (ml_obj_file locn)-         , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)-         , ml_hie_file = addBootSuffix (ml_hie_file locn)+  = locn { ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn)+         , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn)+         , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn)+         , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn)+         , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn)          } +-- | Compute a 'SrcSpan' from a 'ModLocation'.+mkFileSrcSpan :: ModLocation -> SrcSpan+mkFileSrcSpan mod_loc+  = case ml_hs_file mod_loc of+      Just file_path -> mkGeneralSrcSpan (mkFastString file_path)+      Nothing        -> interactiveSrcSpan   -- Presumably +-- ----------------------------------------------------------------------------+-- Helpers for backwards compatibility+-- ----------------------------------------------------------------------------++{-# COMPLETE ModLocation #-}++pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation+pattern ModLocation+  { ml_hs_file+  , ml_hi_file+  , ml_dyn_hi_file+  , ml_obj_file+  , ml_dyn_obj_file+  , ml_hie_file+  } <- OsPathModLocation+    { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)+    , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)+    , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)+    , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)+    , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)+    , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)+    } where+      ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file+        = OsPathModLocation+          { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file+          , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file+          , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file+          , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file+          , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file+          , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file+          }
compiler/GHC/Unit/Module/ModDetails.hs view
@@ -10,6 +10,7 @@  import GHC.Types.Avail import GHC.Types.CompleteMatch+import GHC.Types.DefaultEnv ( DefaultEnv, emptyDefaultEnv ) import GHC.Types.TypeEnv import GHC.Types.Annotations ( Annotation ) @@ -23,6 +24,9 @@       -- ^ Local type environment for this particular module       -- Includes Ids, TyCons, PatSyns +   , md_defaults  :: !DefaultEnv+      -- ^ default declarations exported by this module+    , md_insts     :: InstEnv       -- ^ 'DFunId's for the instances in this module @@ -34,7 +38,7 @@       -- ^ Annotations present in this module: currently       -- they only annotate things also declared in this module -   , md_complete_matches :: [CompleteMatch]+   , md_complete_matches :: CompleteMatches       -- ^ Complete match pragmas for this module    } @@ -43,6 +47,7 @@ emptyModDetails = ModDetails    { md_types            = emptyTypeEnv    , md_exports          = []+   , md_defaults         = emptyDefaultEnv    , md_insts            = emptyInstEnv    , md_rules            = []    , md_fam_insts        = []
compiler/GHC/Unit/Module/ModGuts.hs view
@@ -27,6 +27,7 @@ import GHC.Types.Annotations ( Annotation ) import GHC.Types.Avail import GHC.Types.CompleteMatch+import GHC.Types.DefaultEnv ( DefaultEnv ) import GHC.Types.Fixity.Env import GHC.Types.ForeignStubs import GHC.Types.HpcInfo@@ -62,6 +63,7 @@                                          -- Used for creating interface files.         mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module                                          -- (includes TyCons for classes)+        mg_defaults  :: !DefaultEnv    , -- ^ Class defaults exported from this module         mg_insts     :: ![ClsInst],      -- ^ Class instances declared in this module         mg_fam_insts :: ![FamInst],                                          -- ^ Family instances declared in this module@@ -74,7 +76,7 @@         -- ^ Files to be compiled with the C compiler         mg_warns     :: !(Warnings GhcRn),  -- ^ Warnings declared in the module         mg_anns      :: [Annotation],    -- ^ Annotations declared in this module-        mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches+        mg_complete_matches :: CompleteMatches, -- ^ Complete Matches         mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module         mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module @@ -139,7 +141,6 @@         cg_foreign_files :: ![(ForeignSrcLang, FilePath)],         cg_dep_pkgs  :: !(Set UnitId),      -- ^ Dependent packages, used to                                             -- generate #includes for C code gen-        cg_hpc_info  :: !HpcInfo,           -- ^ Program coverage tick box information         cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints         cg_spt_entries :: [SptEntry]                 -- ^ Static pointer table entries for static forms defined in
compiler/GHC/Unit/Module/ModIface.hs view
@@ -4,10 +4,73 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveAnyClass #-}  module GHC.Unit.Module.ModIface    ( ModIface-   , ModIface_ (..)+   , ModIface_+      ( mi_module+      , mi_sig_of+      , mi_hsc_src+      , mi_deps+      , mi_usages+      , mi_exports+      , mi_used_th+      , mi_fixities+      , mi_warns+      , mi_anns+      , mi_decls+      , mi_defaults+      , mi_extra_decls+      , mi_foreign+      , mi_top_env+      , mi_insts+      , mi_fam_insts+      , mi_rules+      , mi_hpc+      , mi_trust+      , mi_trust_pkg+      , mi_complete_matches+      , mi_docs+      , mi_final_exts+      , mi_ext_fields+      , mi_src_hash+      , mi_hi_bytes+      )+   , pattern ModIface+   , restoreFromOldModIface+   , addSourceFingerprint+   , set_mi_module+   , set_mi_sig_of+   , set_mi_hsc_src+   , set_mi_src_hash+   , set_mi_hi_bytes+   , set_mi_deps+   , set_mi_usages+   , set_mi_exports+   , set_mi_used_th+   , set_mi_fixities+   , set_mi_warns+   , set_mi_anns+   , set_mi_insts+   , set_mi_fam_insts+   , set_mi_rules+   , set_mi_decls+   , set_mi_defaults+   , set_mi_extra_decls+   , set_mi_foreign+   , set_mi_top_env+   , set_mi_hpc+   , set_mi_trust+   , set_mi_trust_pkg+   , set_mi_complete_matches+   , set_mi_docs+   , set_mi_final_exts+   , set_mi_ext_fields+   , completePartialModIface+   , IfaceBinHandle(..)    , PartialModIface    , ModIfaceBackend (..)    , IfaceDeclExts@@ -15,6 +78,8 @@    , IfaceExport    , WhetherHasOrphans    , WhetherHasFamInst+   , IfaceTopEnv (..)+   , IfaceImport(..)    , mi_boot    , mi_fix    , mi_semantic_module@@ -39,19 +104,21 @@ import GHC.Unit import GHC.Unit.Module.Deps import GHC.Unit.Module.Warnings+import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..), emptyIfaceForeign)  import GHC.Types.Avail import GHC.Types.Fixity import GHC.Types.Fixity.Env import GHC.Types.HpcInfo import GHC.Types.Name-import GHC.Types.Name.Reader+import GHC.Types.Name.Reader (IfGlobalRdrEnv) import GHC.Types.SafeHaskell import GHC.Types.SourceFile import GHC.Types.Unique.DSet import GHC.Types.Unique.FM  import GHC.Data.Maybe+import qualified GHC.Data.Strict as Strict  import GHC.Utils.Fingerprint import GHC.Utils.Binary@@ -59,6 +126,7 @@ import Control.DeepSeq import Control.Exception + {- Note [Interface file stages]    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -139,7 +207,17 @@   IfaceBackendExts 'ModIfaceCore = ()   IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend -+-- | In-memory byte array representation of a 'ModIface'.+--+-- See Note [Sharing of ModIface] for why we need this.+data IfaceBinHandle (phase :: ModIfacePhase) where+  -- | A partial 'ModIface' cannot be serialised to disk.+  PartialIfaceBinHandle :: IfaceBinHandle 'ModIfaceCore+  -- | Optional 'FullBinData' that can be serialised to disk directly.+  --+  -- See Note [Private fields in ModIface] for when this fields needs to be cleared+  -- (e.g., set to 'Nothing').+  FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal  -- | A 'ModIface' plus a 'ModDetails' summarises everything we know -- about a compiled module.  The 'ModIface' is the stuff *before* linking,@@ -153,63 +231,76 @@ -- -- See Note [Strictness in ModIface] to learn about why some fields are -- strict and others are not.+--+-- See Note [Private fields in ModIface] to learn why we don't export any of the+-- fields. data ModIface_ (phase :: ModIfacePhase)-  = ModIface {-        mi_module     :: !Module,             -- ^ Name of the module we are for-        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?+  = PrivateModIface {+        mi_module_     :: !Module,             -- ^ Name of the module we are for+        mi_sig_of_     :: !(Maybe Module),     -- ^ Are we a sig of another mod? -        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?+        mi_hsc_src_    :: !HscSource,          -- ^ Boot? Signature? -        mi_deps     :: Dependencies,+        mi_deps_     :: Dependencies,                 -- ^ The dependencies of the module.  This is                 -- consulted for directly-imported modules, but not                 -- for anything else (hence lazy) -        mi_usages   :: [Usage],+        mi_usages_   :: [Usage],                 -- ^ Usages; kept sorted so that it's easy to decide                 -- whether to write a new iface file (changing usages                 -- doesn't affect the hash of this module)                 -- NOT STRICT!  we read this field lazily from the interface file                 -- It is *only* consulted by the recompilation checker+                --+                -- The elements must be *deterministically* sorted to guarantee+                -- deterministic interface files -        mi_exports  :: ![IfaceExport],+        mi_exports_  :: ![IfaceExport],                 -- ^ Exports                 -- Kept sorted by (mod,occ), to make version comparisons easier                 -- Records the modules that are the declaration points for things                 -- exported by this module, and the 'OccName's of those things  -        mi_used_th  :: !Bool,+        mi_used_th_  :: !Bool,                 -- ^ Module required TH splices when it was compiled.                 -- This disables recompilation avoidance (see #481). -        mi_fixities :: [(OccName,Fixity)],+        mi_fixities_ :: [(OccName,Fixity)],                 -- ^ Fixities                 -- NOT STRICT!  we read this field lazily from the interface file -        mi_warns    :: IfaceWarnings,+        mi_warns_    :: IfaceWarnings,                 -- ^ Warnings                 -- NOT STRICT!  we read this field lazily from the interface file -        mi_anns     :: [IfaceAnnotation],+        mi_anns_     :: [IfaceAnnotation],                 -- ^ Annotations                 -- NOT STRICT!  we read this field lazily from the interface file  -        mi_decls    :: [IfaceDeclExts phase],+        mi_decls_    :: [IfaceDeclExts phase],                 -- ^ Type, class and variable declarations                 -- The hash of an Id changes if its fixity or deprecations change                 --      (as well as its type of course)                 -- Ditto data constructors, class operations, except that                 -- the hash of the parent class/tycon changes -        mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo],+        mi_extra_decls_ :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo],                 -- ^ Extra variable definitions which are **NOT** exposed but when                 -- combined with mi_decls allows us to restart code generation.                 -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs] -        mi_globals  :: !(Maybe IfGlobalRdrEnv),-                -- ^ Binds all the things defined at the top level in+        mi_foreign_ :: !IfaceForeign,+                -- ^ Foreign stubs and files to supplement 'mi_extra_decls_'.+                -- See Note [Foreign stubs and TH bytecode linking]++        mi_defaults_ :: [IfaceDefault],+                -- ^ default declarations exported by the module++        mi_top_env_  :: !(Maybe IfaceTopEnv),+                -- ^ Just enough information to reconstruct the top level environment in                 -- the /original source/ code for this module. which                 -- is NOT the same as mi_exports, nor mi_decls (which                 -- may contains declarations for things not actually@@ -224,36 +315,36 @@                 -- 'HomeModInfo', but that leads to more plumbing.                  -- Instance declarations and rules-        mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance-        mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances-        mi_rules       :: [IfaceRule],     -- ^ Sorted rules+        mi_insts_       :: [IfaceClsInst],     -- ^ Sorted class instance+        mi_fam_insts_   :: [IfaceFamInst],  -- ^ Sorted family instances+        mi_rules_       :: [IfaceRule],     -- ^ Sorted rules -        mi_hpc       :: !AnyHpcUsage,+        mi_hpc_       :: !AnyHpcUsage,                 -- ^ True if this program uses Hpc at any point in the program. -        mi_trust     :: !IfaceTrustInfo,+        mi_trust_     :: !IfaceTrustInfo,                 -- ^ Safe Haskell Trust information for this module. -        mi_trust_pkg :: !Bool,+        mi_trust_pkg_ :: !Bool,                 -- ^ Do we require the package this module resides in be trusted                 -- to trust this module? This is used for the situation where a                 -- module is Safe (so doesn't require the package be trusted                 -- itself) but imports some trustworthy modules from its own                 -- package (which does require its own package be trusted).                 -- See Note [Trust Own Package] in GHC.Rename.Names-        mi_complete_matches :: ![IfaceCompleteMatch],+        mi_complete_matches_ :: ![IfaceCompleteMatch], -        mi_docs :: !(Maybe Docs),+        mi_docs_ :: !(Maybe Docs),                 -- ^ Docstrings and related data for use by haddock, the ghci                 -- @:doc@ command, and other tools.                 --                 -- @Just _@ @<=>@ the module was built with @-haddock@. -        mi_final_exts :: !(IfaceBackendExts phase),+        mi_final_exts_ :: !(IfaceBackendExts phase),                 -- ^ Either `()` or `ModIfaceBackend` for                 -- a fully instantiated interface. -        mi_ext_fields :: !ExtensibleFields,+        mi_ext_fields_ :: !ExtensibleFields,                 -- ^ Additional optional fields, where the Map key represents                 -- the field name, resulting in a (size, serialized data) pair.                 -- Because the data is intended to be serialized through the@@ -262,10 +353,25 @@                 -- chosen over `ByteString`s.                 -- -        mi_src_hash :: !Fingerprint+        mi_src_hash_ :: !Fingerprint,                 -- ^ Hash of the .hs source, used for recompilation checking.+        mi_hi_bytes_ :: !(IfaceBinHandle phase)+                -- ^ A serialised in-memory buffer of this 'ModIface'.+                -- If this handle is given, we can avoid serialising the 'ModIface'+                -- when writing this 'ModIface' to disk, and write this buffer to disk instead.+                -- See Note [Sharing of ModIface].      } +-- Enough information to reconstruct the top level environment for a module+data IfaceTopEnv+  = IfaceTopEnv+  { ifaceTopExports :: !IfGlobalRdrEnv -- ^ all top level things in this module, including unexported stuff+  , ifaceImports :: ![IfaceImport]    -- ^ all the imports in this module+  }++instance NFData IfaceTopEnv where+  rnf (IfaceTopEnv a b) = rnf a `seq` rnf b+ {- Note [Strictness in ModIface] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -342,34 +448,42 @@  -- See Note [Strictness in ModIface] about where we use lazyPut vs put instance Binary ModIface where-   put_ bh (ModIface {-                 mi_module    = mod,-                 mi_sig_of    = sig_of,-                 mi_hsc_src   = hsc_src,-                 mi_src_hash = _src_hash, -- Don't `put_` this in the instance+   put_ bh (PrivateModIface {+                 mi_module_    = mod,+                 mi_sig_of_    = sig_of,+                 mi_hsc_src_   = hsc_src,+                 mi_src_hash_ = _src_hash, -- Don't `put_` this in the instance                                           -- because we are going to write it                                           -- out separately in the actual file-                 mi_deps      = deps,-                 mi_usages    = usages,-                 mi_exports   = exports,-                 mi_used_th   = used_th,-                 mi_fixities  = fixities,-                 mi_warns     = warns,-                 mi_anns      = anns,-                 mi_decls     = decls,-                 mi_extra_decls = extra_decls,-                 mi_insts     = insts,-                 mi_fam_insts = fam_insts,-                 mi_rules     = rules,-                 mi_hpc       = hpc_info,-                 mi_trust     = trust,-                 mi_trust_pkg = trust_pkg,-                 mi_complete_matches = complete_matches,-                 mi_docs      = docs,-                 mi_ext_fields = _ext_fields, -- Don't `put_` this in the instance so we+                 mi_hi_bytes_  = _hi_bytes, -- We don't serialise the 'mi_hi_bytes_', as it itself+                                            -- may contain an in-memory byte array buffer for this+                                            -- 'ModIface'. If we used 'put_' on this 'ModIface', then+                                            -- we likely have a good reason, and do not want to reuse+                                            -- the byte array.+                                            -- See Note [Private fields in ModIface]+                 mi_deps_      = deps,+                 mi_usages_    = usages,+                 mi_exports_   = exports,+                 mi_used_th_   = used_th,+                 mi_fixities_  = fixities,+                 mi_warns_     = warns,+                 mi_anns_      = anns,+                 mi_decls_     = decls,+                 mi_extra_decls_ = extra_decls,+                 mi_foreign_   = foreign_,+                 mi_defaults_  = defaults,+                 mi_insts_     = insts,+                 mi_fam_insts_ = fam_insts,+                 mi_rules_     = rules,+                 mi_hpc_       = hpc_info,+                 mi_trust_     = trust,+                 mi_trust_pkg_ = trust_pkg,+                 mi_complete_matches_ = complete_matches,+                 mi_docs_      = docs,+                 mi_ext_fields_ = _ext_fields, -- Don't `put_` this in the instance so we                                               -- can deal with it's pointer in the header                                               -- when we write the actual file-                 mi_final_exts = ModIfaceBackend {+                 mi_final_exts_ = ModIfaceBackend {                    mi_iface_hash = iface_hash,                    mi_mod_hash = mod_hash,                    mi_flag_hash = flag_hash,@@ -402,6 +516,8 @@         lazyPut bh anns         put_ bh decls         put_ bh extra_decls+        put_ bh defaults+        put_ bh foreign_         put_ bh insts         put_ bh fam_insts         lazyPut bh rules@@ -434,6 +550,8 @@         anns        <- {-# SCC "bin_anns" #-} lazyGet bh         decls       <- {-# SCC "bin_tycldecls" #-} get bh         extra_decls <- get bh+        defaults    <- get bh+        foreign_    <- get bh         insts       <- {-# SCC "bin_insts" #-} get bh         fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh         rules       <- {-# SCC "bin_rules" #-} lazyGet bh@@ -443,34 +561,41 @@         trust_pkg   <- get bh         complete_matches <- get bh         docs        <- lazyGetMaybe bh-        return (ModIface {-                 mi_module      = mod,-                 mi_sig_of      = sig_of,-                 mi_hsc_src     = hsc_src,-                 mi_src_hash = fingerprint0, -- placeholder because this is dealt+        return (PrivateModIface {+                 mi_module_      = mod,+                 mi_sig_of_      = sig_of,+                 mi_hsc_src_     = hsc_src,+                 mi_src_hash_ = fingerprint0, -- placeholder because this is dealt                                              -- with specially when the file is read-                 mi_deps        = deps,-                 mi_usages      = usages,-                 mi_exports     = exports,-                 mi_used_th     = used_th,-                 mi_anns        = anns,-                 mi_fixities    = fixities,-                 mi_warns       = warns,-                 mi_decls       = decls,-                 mi_extra_decls = extra_decls,-                 mi_globals     = Nothing,-                 mi_insts       = insts,-                 mi_fam_insts   = fam_insts,-                 mi_rules       = rules,-                 mi_hpc         = hpc_info,-                 mi_trust       = trust,-                 mi_trust_pkg   = trust_pkg,+                 mi_hi_bytes_    =+                                   -- We can't populate this field here, as we are+                                   -- missing the 'mi_ext_fields_' field, which is+                                   -- handled in 'getIfaceWithExtFields'.+                                   FullIfaceBinHandle Strict.Nothing,+                 mi_deps_        = deps,+                 mi_usages_      = usages,+                 mi_exports_     = exports,+                 mi_used_th_     = used_th,+                 mi_anns_        = anns,+                 mi_fixities_    = fixities,+                 mi_warns_       = warns,+                 mi_decls_       = decls,+                 mi_extra_decls_ = extra_decls,+                 mi_foreign_     = foreign_,+                 mi_top_env_     = Nothing,+                 mi_defaults_    = defaults,+                 mi_insts_       = insts,+                 mi_fam_insts_   = fam_insts,+                 mi_rules_       = rules,+                 mi_hpc_         = hpc_info,+                 mi_trust_       = trust,+                 mi_trust_pkg_   = trust_pkg,                         -- And build the cached values-                 mi_complete_matches = complete_matches,-                 mi_docs        = docs,-                 mi_ext_fields  = emptyExtensibleFields, -- placeholder because this is dealt+                 mi_complete_matches_ = complete_matches,+                 mi_docs_        = docs,+                 mi_ext_fields_  = emptyExtensibleFields, -- placeholder because this is dealt                                                          -- with specially when the file is read-                 mi_final_exts = ModIfaceBackend {+                 mi_final_exts_ = ModIfaceBackend {                    mi_iface_hash = iface_hash,                    mi_mod_hash = mod_hash,                    mi_flag_hash = flag_hash,@@ -487,42 +612,48 @@                    mi_hash_fn = mkIfaceHashCache decls                  }}) + -- | The original names declared of a certain module that are exported type IfaceExport = AvailInfo  emptyPartialModIface :: Module -> PartialModIface emptyPartialModIface mod-  = ModIface { mi_module      = mod,-               mi_sig_of      = Nothing,-               mi_hsc_src     = HsSrcFile,-               mi_src_hash    = fingerprint0,-               mi_deps        = noDependencies,-               mi_usages      = [],-               mi_exports     = [],-               mi_used_th     = False,-               mi_fixities    = [],-               mi_warns       = IfWarnSome [] [],-               mi_anns        = [],-               mi_insts       = [],-               mi_fam_insts   = [],-               mi_rules       = [],-               mi_decls       = [],-               mi_extra_decls = Nothing,-               mi_globals     = Nothing,-               mi_hpc         = False,-               mi_trust       = noIfaceTrustInfo,-               mi_trust_pkg   = False,-               mi_complete_matches = [],-               mi_docs        = Nothing,-               mi_final_exts  = (),-               mi_ext_fields  = emptyExtensibleFields-             }+  = PrivateModIface+      { mi_module_      = mod,+        mi_sig_of_      = Nothing,+        mi_hsc_src_     = HsSrcFile,+        mi_src_hash_    = fingerprint0,+        mi_hi_bytes_    = PartialIfaceBinHandle,+        mi_deps_        = noDependencies,+        mi_usages_      = [],+        mi_exports_     = [],+        mi_used_th_     = False,+        mi_fixities_    = [],+        mi_warns_       = IfWarnSome [] [],+        mi_anns_        = [],+        mi_defaults_    = [],+        mi_insts_       = [],+        mi_fam_insts_   = [],+        mi_rules_       = [],+        mi_decls_       = [],+        mi_extra_decls_ = Nothing,+        mi_foreign_     = emptyIfaceForeign,+        mi_top_env_     = Nothing,+        mi_hpc_         = False,+        mi_trust_       = noIfaceTrustInfo,+        mi_trust_pkg_   = False,+        mi_complete_matches_ = [],+        mi_docs_        = Nothing,+        mi_final_exts_  = (),+        mi_ext_fields_  = emptyExtensibleFields+      }  emptyFullModIface :: Module -> ModIface emptyFullModIface mod =     (emptyPartialModIface mod)-      { mi_decls = []-      , mi_final_exts = ModIfaceBackend+      { mi_decls_ = []+      , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing+      , mi_final_exts_ = ModIfaceBackend         { mi_iface_hash = fingerprint0,           mi_mod_hash = fingerprint0,           mi_flag_hash = fingerprint0,@@ -557,36 +688,40 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))          , NFData (IfaceDeclExts (phase :: ModIfacePhase))          ) => NFData (ModIface_ phase) where-  rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages-               , mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns-               , mi_decls, mi_extra_decls, mi_globals, mi_insts-               , mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg-               , mi_complete_matches, mi_docs, mi_final_exts-               , mi_ext_fields, mi_src_hash })-    =     rnf mi_module-    `seq` rnf mi_sig_of-    `seq`     mi_hsc_src-    `seq`     mi_deps-    `seq`     mi_usages-    `seq`     mi_exports-    `seq` rnf mi_used_th-    `seq`     mi_fixities-    `seq` rnf mi_warns-    `seq` rnf mi_anns-    `seq` rnf mi_decls-    `seq` rnf mi_extra_decls-    `seq` rnf mi_globals-    `seq` rnf mi_insts-    `seq` rnf mi_fam_insts-    `seq` rnf mi_rules-    `seq` rnf mi_hpc-    `seq`     mi_trust-    `seq` rnf mi_trust_pkg-    `seq` rnf mi_complete_matches-    `seq` rnf mi_docs-    `seq`     mi_final_exts-    `seq`     mi_ext_fields-    `seq` rnf mi_src_hash+  rnf (PrivateModIface+               { mi_module_, mi_sig_of_, mi_hsc_src_, mi_hi_bytes_, mi_deps_, mi_usages_+               , mi_exports_, mi_used_th_, mi_fixities_, mi_warns_, mi_anns_+               , mi_decls_, mi_defaults_, mi_extra_decls_, mi_foreign_, mi_top_env_, mi_insts_+               , mi_fam_insts_, mi_rules_, mi_hpc_, mi_trust_, mi_trust_pkg_+               , mi_complete_matches_, mi_docs_, mi_final_exts_+               , mi_ext_fields_, mi_src_hash_ })+    =     rnf mi_module_+    `seq` rnf mi_sig_of_+    `seq`     mi_hsc_src_+    `seq`     mi_hi_bytes_+    `seq`     mi_deps_+    `seq`     mi_usages_+    `seq`     mi_exports_+    `seq` rnf mi_used_th_+    `seq`     mi_fixities_+    `seq` rnf mi_warns_+    `seq` rnf mi_anns_+    `seq` rnf mi_decls_+    `seq` rnf mi_defaults_+    `seq` rnf mi_extra_decls_+    `seq` rnf mi_foreign_+    `seq` rnf mi_top_env_+    `seq` rnf mi_insts_+    `seq` rnf mi_fam_insts_+    `seq` rnf mi_rules_+    `seq` rnf mi_hpc_+    `seq`     mi_trust_+    `seq` rnf mi_trust_pkg_+    `seq` rnf mi_complete_matches_+    `seq` rnf mi_docs_+    `seq`     mi_final_exts_+    `seq`     mi_ext_fields_+    `seq` rnf mi_src_hash_     `seq` ()  instance NFData (ModIfaceBackend) where@@ -626,5 +761,299 @@ -- | Does this module define family instances? type WhetherHasFamInst = Bool +-- ----------------------------------------------------------------------------+-- Modify a 'ModIface'.+-- ---------------------------------------------------------------------------- +{-+Note [Private fields in ModIface]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The fields of 'ModIface' are private, e.g., not exported, to make the API+impossible to misuse. A 'ModIface' can be "compressed" in-memory using+'shareIface', which serialises the 'ModIface' to an in-memory buffer.+This has the advantage of reducing memory usage of 'ModIface', reducing the+overall memory usage of GHC.+See Note [Sharing of ModIface]. +This in-memory buffer can be reused, if and only if the 'ModIface' is not+modified after it has been "compressed"/shared via 'shareIface'. Instead of+serialising 'ModIface', we simply write the in-memory buffer to disk directly.++However, we can't rely that a 'ModIface' isn't modified after 'shareIface' has+been called. Thus, we make all fields of 'ModIface' private and modification+only happens via exported update functions, such as 'set_mi_decls'.+These functions unconditionally clear any in-memory buffer if used, forcing us+to serialise the 'ModIface' to disk again.+-}++-- | Given a 'PartialModIface', turn it into a 'ModIface' by completing+-- missing fields.+completePartialModIface :: PartialModIface+  -> [(Fingerprint, IfaceDecl)]+  -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]+  -> ModIfaceBackend+  -> ModIface+completePartialModIface partial decls extra_decls final_exts = partial+  { mi_decls_ = decls+  , mi_extra_decls_ = extra_decls+  , mi_final_exts_ = final_exts+  , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing+  }++-- | Add a source fingerprint to a 'ModIface_' without invalidating the byte array+-- buffer 'mi_hi_bytes'.+-- This is a variant of 'set_mi_src_hash' which does invalidate the buffer.+--+-- The 'mi_src_hash' is computed outside of 'ModIface_' based on the 'ModSummary'.+addSourceFingerprint :: Fingerprint -> ModIface_ phase -> ModIface_ phase+addSourceFingerprint val iface = iface { mi_src_hash_ = val }++-- | Copy fields that aren't serialised to disk to the new 'ModIface_'.+-- This includes especially hashes that are usually stored in the interface+-- file header and 'mi_top_env'.+--+-- We need this function after calling 'shareIface', to make sure the+-- 'ModIface_' doesn't lose any information. This function does not discard+-- the in-memory byte array buffer 'mi_hi_bytes'.+restoreFromOldModIface :: ModIface_ phase -> ModIface_ phase -> ModIface_ phase+restoreFromOldModIface old new = new+  { mi_top_env_ = mi_top_env_ old+  , mi_hsc_src_ = mi_hsc_src_ old+  , mi_src_hash_ = mi_src_hash_ old+  }++set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase+set_mi_module val iface = clear_mi_hi_bytes $ iface { mi_module_ = val }++set_mi_sig_of :: Maybe Module -> ModIface_ phase -> ModIface_ phase+set_mi_sig_of val iface = clear_mi_hi_bytes $ iface { mi_sig_of_ = val }++set_mi_hsc_src :: HscSource -> ModIface_ phase -> ModIface_ phase+set_mi_hsc_src val iface = clear_mi_hi_bytes $ iface { mi_hsc_src_ = val }++set_mi_src_hash :: Fingerprint -> ModIface_ phase -> ModIface_ phase+set_mi_src_hash val iface = clear_mi_hi_bytes $ iface { mi_src_hash_ = val }++set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase+set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val }++set_mi_deps :: Dependencies -> ModIface_ phase -> ModIface_ phase+set_mi_deps val iface = clear_mi_hi_bytes $ iface { mi_deps_ = val }++set_mi_usages :: [Usage] -> ModIface_ phase -> ModIface_ phase+set_mi_usages val iface = clear_mi_hi_bytes $ iface { mi_usages_ = val }++set_mi_exports :: [IfaceExport] -> ModIface_ phase -> ModIface_ phase+set_mi_exports val iface = clear_mi_hi_bytes $ iface { mi_exports_ = val }++set_mi_used_th :: Bool -> ModIface_ phase -> ModIface_ phase+set_mi_used_th val iface = clear_mi_hi_bytes $ iface { mi_used_th_ = val }++set_mi_fixities :: [(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase+set_mi_fixities val iface = clear_mi_hi_bytes $ iface { mi_fixities_ = val }++set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase+set_mi_warns val iface = clear_mi_hi_bytes $ iface { mi_warns_ = val }++set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase+set_mi_anns val iface = clear_mi_hi_bytes $ iface { mi_anns_ = val }++set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase+set_mi_insts val iface = clear_mi_hi_bytes $ iface { mi_insts_ = val }++set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase+set_mi_fam_insts val iface = clear_mi_hi_bytes $ iface { mi_fam_insts_ = val }++set_mi_rules :: [IfaceRule] -> ModIface_ phase -> ModIface_ phase+set_mi_rules val iface = clear_mi_hi_bytes $ iface { mi_rules_ = val }++set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase+set_mi_decls val iface = clear_mi_hi_bytes $ iface { mi_decls_ = val }++set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase+set_mi_defaults val iface = clear_mi_hi_bytes $ iface { mi_defaults_ = val }++set_mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIface_ phase -> ModIface_ phase+set_mi_extra_decls val iface = clear_mi_hi_bytes $ iface { mi_extra_decls_ = val }++set_mi_foreign :: IfaceForeign -> ModIface_ phase -> ModIface_ phase+set_mi_foreign foreign_ iface = clear_mi_hi_bytes $ iface { mi_foreign_ = foreign_ }++set_mi_top_env :: Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase+set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val }++set_mi_hpc :: AnyHpcUsage -> ModIface_ phase -> ModIface_ phase+set_mi_hpc val iface = clear_mi_hi_bytes $ iface { mi_hpc_ = val }++set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase+set_mi_trust val iface = clear_mi_hi_bytes $ iface { mi_trust_ = val }++set_mi_trust_pkg :: Bool -> ModIface_ phase -> ModIface_ phase+set_mi_trust_pkg val iface = clear_mi_hi_bytes $ iface { mi_trust_pkg_ = val }++set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase+set_mi_complete_matches val iface = clear_mi_hi_bytes $ iface { mi_complete_matches_ = val }++set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase+set_mi_docs val iface = clear_mi_hi_bytes $  iface { mi_docs_ = val }++set_mi_final_exts :: IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase+set_mi_final_exts val iface = clear_mi_hi_bytes $ iface { mi_final_exts_ = val }++set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase+set_mi_ext_fields val iface = clear_mi_hi_bytes $ iface { mi_ext_fields_ = val }++-- | Invalidate any byte array buffer we might have.+clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase+clear_mi_hi_bytes iface = iface+  { mi_hi_bytes_ = case mi_hi_bytes iface of+      PartialIfaceBinHandle -> PartialIfaceBinHandle+      FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing+  }++-- ----------------------------------------------------------------------------+-- 'ModIface' pattern synonyms to keep breakage low.+-- ----------------------------------------------------------------------------++{-+Note [Inline Pattern synonym of ModIface]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The introduction of the 'ModIface' pattern synonym originally caused an increase+in allocated bytes in multiple performance tests.+In some benchmarks, it was a 2~3% increase.++Without {-# INLINE ModIface #-}, the generated core reveals the reason for this increase.+We show the core for the 'mi_module' record selector:++@+  mi_module+    = \ @phase iface -> $w$mModIface iface mi_module1++  $w$mModIface+    = \ @phase iface cont ->+        case iface of+        { PrivateModIface a b ... z ->+        cont+          a+          b+          ...+          z+        }++  mi_module1+    = \ @phase+        a+        _+        ...+        _ ->+        a+@++Thus, we can see the '$w$mModIface' is not inlined, leading to an increase in+the allocated bytes.++However, with the pragma, the correct core is generated:++@+  mi_module = mi_module_+@++-}++-- See Note [Inline Pattern synonym of ModIface] for why we have all these+-- inline pragmas.+{-# INLINE ModIface #-}+{-# INLINE mi_module #-}+{-# INLINE mi_sig_of #-}+{-# INLINE mi_hsc_src #-}+{-# INLINE mi_deps #-}+{-# INLINE mi_usages #-}+{-# INLINE mi_exports #-}+{-# INLINE mi_used_th #-}+{-# INLINE mi_fixities #-}+{-# INLINE mi_warns #-}+{-# INLINE mi_anns #-}+{-# INLINE mi_decls #-}+{-# INLINE mi_extra_decls #-}+{-# INLINE mi_foreign #-}+{-# INLINE mi_top_env #-}+{-# INLINE mi_insts #-}+{-# INLINE mi_fam_insts #-}+{-# INLINE mi_rules #-}+{-# INLINE mi_hpc #-}+{-# INLINE mi_trust #-}+{-# INLINE mi_trust_pkg #-}+{-# INLINE mi_complete_matches #-}+{-# INLINE mi_docs #-}+{-# INLINE mi_final_exts #-}+{-# INLINE mi_ext_fields #-}+{-# INLINE mi_src_hash #-}+{-# INLINE mi_hi_bytes #-}+{-# COMPLETE ModIface #-}++pattern ModIface ::+  Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] ->+  [IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings ->+  [IfaceAnnotation] -> [IfaceDeclExts phase] ->+  Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign ->+  [IfaceDefault] -> Maybe IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->+  AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->+  IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase ->+  ModIface_ phase+pattern ModIface+  { mi_module+  , mi_sig_of+  , mi_hsc_src+  , mi_deps+  , mi_usages+  , mi_exports+  , mi_used_th+  , mi_fixities+  , mi_warns+  , mi_anns+  , mi_decls+  , mi_extra_decls+  , mi_foreign+  , mi_defaults+  , mi_top_env+  , mi_insts+  , mi_fam_insts+  , mi_rules+  , mi_hpc+  , mi_trust+  , mi_trust_pkg+  , mi_complete_matches+  , mi_docs+  , mi_final_exts+  , mi_ext_fields+  , mi_src_hash+  , mi_hi_bytes+  } <- PrivateModIface+    { mi_module_ = mi_module+    , mi_sig_of_ = mi_sig_of+    , mi_hsc_src_ = mi_hsc_src+    , mi_deps_ = mi_deps+    , mi_usages_ = mi_usages+    , mi_exports_ = mi_exports+    , mi_used_th_ = mi_used_th+    , mi_fixities_ = mi_fixities+    , mi_warns_ = mi_warns+    , mi_anns_ = mi_anns+    , mi_decls_ = mi_decls+    , mi_extra_decls_ = mi_extra_decls+    , mi_foreign_ = mi_foreign+    , mi_defaults_ = mi_defaults+    , mi_top_env_ = mi_top_env+    , mi_insts_ = mi_insts+    , mi_fam_insts_ = mi_fam_insts+    , mi_rules_ = mi_rules+    , mi_hpc_ = mi_hpc+    , mi_trust_ = mi_trust+    , mi_trust_pkg_ = mi_trust_pkg+    , mi_complete_matches_ = mi_complete_matches+    , mi_docs_ = mi_docs+    , mi_final_exts_ = mi_final_exts+    , mi_ext_fields_ = mi_ext_fields+    , mi_src_hash_ = mi_src_hash+    , mi_hi_bytes_ = mi_hi_bytes+    }
compiler/GHC/Unit/Module/ModSummary.hs view
@@ -17,6 +17,11 @@    , msHsFilePath    , msObjFilePath    , msDynObjFilePath+   , msHsFileOsPath+   , msHiFileOsPath+   , msDynHiFileOsPath+   , msObjFileOsPath+   , msDynObjFileOsPath    , msDeps    , isBootSummary    , findTarget@@ -38,6 +43,7 @@ import GHC.Types.PkgQual  import GHC.Data.Maybe+import GHC.Data.OsPath (OsPath) import GHC.Data.StringBuffer ( StringBuffer )  import GHC.Utils.Fingerprint@@ -145,6 +151,13 @@ msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms) msObjFilePath ms = ml_obj_file (ms_location ms) msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms)++msHsFileOsPath, msDynHiFileOsPath, msHiFileOsPath, msObjFileOsPath, msDynObjFileOsPath :: ModSummary -> OsPath+msHsFileOsPath  ms = expectJust "msHsFilePath" (ml_hs_file_ospath  (ms_location ms))+msHiFileOsPath  ms = ml_hi_file_ospath  (ms_location ms)+msDynHiFileOsPath ms = ml_dyn_hi_file_ospath (ms_location ms)+msObjFileOsPath ms = ml_obj_file_ospath (ms_location ms)+msDynObjFileOsPath ms = ml_dyn_obj_file_ospath (ms_location ms)  -- | Did this 'ModSummary' originate from a hs-boot file? isBootSummary :: ModSummary -> IsBootInterface
compiler/GHC/Unit/Module/Warnings.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -130,7 +131,8 @@  -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString-  deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData)+  deriving stock Data+  deriving newtype (Binary, Eq, Outputable, Show, Uniquable, NFData)  mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory
compiler/GHC/Unit/Module/WholeCoreBindings.hs view
@@ -1,17 +1,39 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoFieldSelectors #-}+{-# LANGUAGE DuplicateRecordFields #-}+ module GHC.Unit.Module.WholeCoreBindings where -import GHC.Unit.Types (Module)-import GHC.Unit.Module.Location+import GHC.Cmm.CLabel+import GHC.Driver.DynFlags (DynFlags (targetPlatform), initSDocContext)+import GHC.ForeignSrcLang (ForeignSrcLang (..)) import GHC.Iface.Syntax+import GHC.Prelude+import GHC.Types.ForeignStubs+import GHC.Unit.Module.Location+import GHC.Unit.Types (Module)+import GHC.Utils.Binary+import GHC.Utils.Error (debugTraceMsg)+import GHC.Utils.Logger (Logger)+import GHC.Utils.Outputable+import GHC.Utils.Panic (panic, pprPanic)+import GHC.Utils.TmpFs +import Control.DeepSeq (NFData (..))+import Data.Traversable (for)+import Data.Word (Word8)+import Data.Maybe (fromMaybe)+import System.FilePath (takeExtension)+ {- Note [Interface Files with Core Definitions]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  A interface file can optionally contain the definitions of all core bindings, this is enabled by the flag `-fwrite-if-simplified-core`. This provides everything needed in addition to the normal ModIface and ModDetails-to restart compilation after typechecking to generate bytecode. The `fi_bindings` field+to restart compilation after typechecking to generate bytecode. The `wcb_bindings` field is stored in the normal interface file and the other fields populated whilst loading the interface file. @@ -24,14 +46,14 @@    the WholeCoreBindings into a proper Linkable (if we ever do that). The CoreBindings constructor also    allows us to convert the WholeCoreBindings into multiple different linkables if we so desired. -2. `initWholeCoreBindings` turns a WholeCoreBindings into a proper BCO linkable. This step combines together+2. `initWholeCoreBindings` turns a WholeCoreBindings into a proper BCOs linkable. This step combines together    all the necessary information from a ModIface, ModDetails and WholeCoreBindings in order to-   create the linkable. The linkable created is a "LoadedBCOs" linkable, which-   was introduced just for initWholeCoreBindings, so that the bytecode can be generated lazilly.+   create the linkable. The linkable created is a "LazyBCOs" linkable, which+   was introduced just for initWholeCoreBindings, so that the bytecode can be generated lazily.    Using the `BCOs` constructor directly here leads to the bytecode being forced    too eagerly. -3. Then when bytecode is needed, the LoadedBCOs value is inspected and unpacked and+3. Then when bytecode is needed, the LazyBCOs value is inspected and unpacked and    the linkable is used as before.  The flag `-fwrite-if-simplified-core` determines whether the extra information is written@@ -40,8 +62,55 @@ of the interface file agree with the optimisation level as reported by the interface file. +The lifecycle differs beyond laziness depending on the provenance of a module.+In all cases, the main consumer for interface bytecode is 'get_link_deps', which+traverses a splice's or GHCi expression's dependencies and collects the needed+build artifacts, which can be objects or bytecode, depending on the build+settings.++1. In make mode, all eligible modules are part of the dependency graph.+   Their interfaces are loaded unconditionally and in dependency order by the+   compilation manager, and each module's bytecode is prepared before its+   dependents are compiled, in one of two ways:++   - If the interface file for a module is missing or out of sync with its+     source, it is recompiled and bytecode is generated directly and+     immediately, not involving 'WholeCoreBindings' (in 'runHscBackendPhase').++   - If the interface file is up to date, no compilation is performed, and a+     lazy thunk generating bytecode from interface Core bindings is created in+     'compileOne'', which will only be compiled if a downstream module contains+     a splice that depends on it, as described above.++   In both cases, the bytecode 'Linkable' is stored in a 'HomeModLinkable' in+   the Home Unit Graph, lazy or not.++2. In oneshot mode, which compiles individual modules without a shared home unit+   graph, a previously compiled module is not reprocessed as described for make+   mode above.+   When 'get_link_deps' encounters a dependency on a local module, it requests+   its bytecode from the External Package State, who loads the interface+   on-demand.++   Since the EPS stores interfaces for all package dependencies in addition to+   local modules in oneshot mode, it has a substantial memory footprint.+   We try to curtail that by extracting important data into specialized fields+   in the EPS, and retaining only a few fields of 'ModIface' by overwriting the+   others with bottom values.++   In order to avoid keeping around all of the interface's components needed for+   compiling bytecode, we instead store an IO action in 'eps_iface_bytecode'.+   When 'get_link_deps' evaluates this action, the result is not retained in the+   EPS, but stored in 'LoaderState', where it may eventually get evicted to free+   up the memory.+   This IO action retains the dehydrated Core bindings from the interface in its+   closure.+   Like the bytecode 'Linkable' stored in 'LoaderState', this is preferable to+   storing the intermediate representation as rehydrated Core bindings, since+   the latter have a significantly greater memory footprint.+ Note [Size of Interface Files with Core Definitions]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  How much overhead does `-fwrite-if-simplified-core` add to a typical interface file? As an experiment I compiled the `Cabal` library and `ghc` library (Aug 22) with@@ -60,4 +129,375 @@             { wcb_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -- ^ serialised tidied core bindings.             , wcb_module   :: Module  -- ^ The module which the bindings are for             , wcb_mod_location :: ModLocation -- ^ The location where the sources reside.+              -- | Stubs for foreign declarations and files added via+              -- 'GHC.Internal.TH.Syntax.addForeignFilePath'.+            , wcb_foreign :: IfaceForeign             }++{-+Note [Foreign stubs and TH bytecode linking]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Foreign declarations may introduce additional build products called "stubs" that+contain wrappers for the exposed functions.+For example, consider a foreign import of a C function named @main_loop@ from+the file @bindings.h@ in the module @CLibrary@:++@+foreign import capi "bindings.h main_loop" mainLoop :: IO Int+@++GHC will generate a snippet of C code containing a wrapper:++@+#include "bindings.h"+HsInt ghczuwrapperZC0ZCmainZCCLibraryZCmainzuloop(void) {return main_loop();}+@++Wrappers like these are generated as 'ForeignStubs' by the desugarer in+'dsForeign' and stored in the various @*Guts@ types; until they are compiled to+temporary object files in 'runHscBackendPhase' during code generation and+ultimately merged into the final object file for the module, @CLibrary.o@.++This creates some problems with @-fprefer-byte-code@, which allows splices to+execute bytecode instead of native code for dependencies that provide it.+Usually, when some TH code depends on @CLibrary@, the linker would look for+@CLibrary.o@ and load that before executing the splice, but with this flag, it+will first attempt to load bytecode from @CLibrary.hi@ and compile it in-memory.++Problem 1:++Code for splices is loaded from interfaces in the shape of Core bindings+(see 'WholeCoreBindings'), rather than from object files.+Those Core bindings are intermediate build products that do not contain the+module's stubs, since those are separated from the Haskell code before Core is+generated and only compiled and linked into the final object when native code is+generated.++Therefore, stubs have to be stored separately in interface files.+Unfortunately, the type 'ForeignStubs' contains 'CLabel', which is a huge type+with several 'Unique's used mainly by C--.+Luckily, the only constructor used for foreign stubs is 'ModuleLabel', which+contains the name of a foreign declaration's initializer, if it has one.+So we convert a 'CLabel' to 'CStubLabel' in 'encodeIfaceForeign' and store only+the simplified data.++Problem 2:++Given module B, which contains a splice that executes code from module A, both+in the home package, consider these different circumstances:++1. In make mode, both modules are recompiled+2. In make mode, only B is recompiled+3. In oneshot mode, B is compiled++In case 1, 'runHscBackendPhase' directly generates bytecode from the 'CgGuts'+that the main pipeline produced and stores it in the 'HomeModLinkable' that is+one of its build products.+The stubs are merged into a single object and added to the 'HomeModLinkable' in+'hscGenBackendPipeline'.++In case 2, 'hscRecompStatus' short-circuits the pipeline while checking A, since+the module is up to date.+Nevertheless, it calls 'checkByteCode', which extracts Core bindings from A's+interface and adds them to the 'HomeModLinkable'.+No stubs are generated in this case, since the desugarer wasn't run!++In both of these cases, 'compileOne'' proceeds to call 'initWholeCoreBindings',+applied to the 'HomeModLinkable', to compile Core bindings (lazily) to bytecode,+which is then written back to the 'HomeModLinkable'.+If the 'HomeModLinkable' already contains bytecode (case 1), this is a no-op.+Otherwise, the stub objects from the interface are compiled to objects in+'generateByteCode' and added to the 'HomeModLinkable' as well.++Case 3 is not implemented yet (!13042).++Problem 3:++In all three cases, the final step before splice execution is linking.++The function 'getLinkDeps' is responsible for assembling all of a splice's+dependencies, looking up imported modules in the HPT and EPS, collecting all+'HomeModLinkable's and object files that it can find.++However, since splices are executed in the interpreter, the 'Way' of the current+build may differ from the interpreter's.+For example, the current GHC invocation might be building a static binary, but+the internal interpreter requires dynamic linking; or profiling might be+enabled.+To adapt to the interpreter's 'Way', 'getLinkDeps' substitutes all object files'+extensions with that corresponding to that 'Way' – e.g. changing @.o@ to+@.dyn_o@, which requires dependencies to be built with @-dynamic[-too]@, which+in turn is enforced after downsweep in 'GHC.Driver.Make.enableCodeGenWhen'.++This doesn't work for stub objects, though – they are compiled to temporary+files with mismatching names, so simply switching out the suffix would refer to+a nonexisting file.+Even if that wasn't an issue, they are compiled for the session's 'Way', not its+associated module's, so the dynamic variant wouldn't be available when building+only static outputs.++To mitigate this, we instead build foreign objects specially for the+interpreter, updating the build flags in 'compile_for_interpreter' to use the+interpreter's way.++Problem 4:++Foreign code may have dependencies on Haskell code.++Both foreign exports and @StaticPointers@ produce stubs that contain @extern@+declarations of values referring to STG closures.+When those stub objects are loaded, the undefined symbols need to be provided to+the linker.++I have no insight into how this works, and whether we could provide the memory+address of a BCO as a ccall symbol while linking, so it's unclear at the moment+what to do about this.++In addition to that, those objects would also have to be loaded _after_+bytecode, and therefore 'DotO' would have to be marked additionally to separate+them from those that are loaded before.+If mutual dependencies between BCOs and foreign code are possible, this will be+much more diffcult though.++Problem 5:++TH allows splices to add arbitrary files as additional linker inputs.++Using the method `qAddForeignFilePath`, a foreign source file or a precompiled+object file can be added to the current modules dependencies.+These files will be processed by the pipeline and linked into the final object.++Since the files may be temporarily created from a string, we have to read their+contents in 'encodeIfaceForeign' and store them in the interface as well, and+write them to temporary files when loading bytecode in 'decodeIfaceForeign'.+-}++-- | Wrapper for avoiding a dependency on 'Binary' and 'NFData' in 'CLabel'.+newtype IfaceCLabel = IfaceCLabel CStubLabel++instance Binary IfaceCLabel where+  get bh = do+    csl_is_initializer <- get bh+    csl_module <- get bh+    csl_name <- get bh+    pure (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name})++  put_ bh (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name}) = do+    put_ bh csl_is_initializer+    put_ bh csl_module+    put_ bh csl_name++instance NFData IfaceCLabel where+  rnf (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name}) =+    rnf csl_is_initializer `seq` rnf csl_module `seq` rnf csl_name++instance Outputable IfaceCLabel where+  ppr (IfaceCLabel l) = ppr l++-- | Simplified encoding of 'GHC.Types.ForeignStubs.ForeignStubs' for interface+-- serialization.+--+-- See Note [Foreign stubs and TH bytecode linking]+data IfaceCStubs =+  IfaceCStubs {+    header :: String,+    source :: String,+    initializers :: [IfaceCLabel],+    finalizers :: [IfaceCLabel]+  }++instance Outputable IfaceCStubs where+  ppr IfaceCStubs {header, source, initializers, finalizers} =+    vcat [+      hang (text "header:") 2 (vcat (text <$> lines header)),+      hang (text "source:") 2 (vcat (text <$> lines source)),+      hang (text "initializers:") 2 (ppr initializers),+      hang (text "finalizers:") 2 (ppr finalizers)+    ]++-- | 'Binary' 'put_' for 'ForeignSrcLang'.+binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()+binary_put_ForeignSrcLang bh lang =+  put_ @Word8 bh $ case lang of+    LangC -> 0+    LangCxx -> 1+    LangObjc -> 2+    LangObjcxx -> 3+    LangAsm -> 4+    LangJs -> 5+    RawObject -> 6++-- | 'Binary' 'get' for 'ForeignSrcLang'.+binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang+binary_get_ForeignSrcLang bh = do+  b <- getByte bh+  pure $ case b of+    0 -> LangC+    1 -> LangCxx+    2 -> LangObjc+    3 -> LangObjcxx+    4 -> LangAsm+    5 -> LangJs+    6 -> RawObject+    _ -> panic "invalid Binary value for ForeignSrcLang"++instance Binary IfaceCStubs where+  get bh = do+    header <- get bh+    source <- get bh+    initializers <- get bh+    finalizers <- get bh+    pure IfaceCStubs {..}++  put_ bh IfaceCStubs {..} = do+    put_ bh header+    put_ bh source+    put_ bh initializers+    put_ bh finalizers++instance NFData IfaceCStubs where+  rnf IfaceCStubs {..} =+    rnf header+    `seq`+    rnf source+    `seq`+    rnf initializers+    `seq`+    rnf finalizers++-- | A source file added from Template Haskell using 'qAddForeignFilePath', for+-- storage in interfaces.+--+-- See Note [Foreign stubs and TH bytecode linking]+data IfaceForeignFile =+  IfaceForeignFile {+    -- | The language is specified by the user.+    lang :: ForeignSrcLang,++    -- | The contents of the file, which will be written to a temporary file+    -- when loaded from an interface.+    source :: String,++    -- | The extension used by the user is preserved, to avoid confusing+    -- external tools with an unexpected @.c@ file or similar.+    extension :: FilePath+  }++instance Outputable IfaceForeignFile where+  ppr IfaceForeignFile {lang, source} =+    hang (text (show lang) <> colon) 2 (vcat (text <$> lines source))++instance Binary IfaceForeignFile where+  get bh = do+    lang <- binary_get_ForeignSrcLang bh+    source <- get bh+    extension <- get bh+    pure IfaceForeignFile {lang, source, extension}++  put_ bh IfaceForeignFile {lang, source, extension} = do+    binary_put_ForeignSrcLang bh lang+    put_ bh source+    put_ bh extension++instance NFData IfaceForeignFile where+  rnf IfaceForeignFile {lang, source, extension} =+    lang `seq` rnf source `seq` rnf extension++data IfaceForeign =+  IfaceForeign {+    stubs :: Maybe IfaceCStubs,+    files :: [IfaceForeignFile]+  }++instance Outputable IfaceForeign where+  ppr IfaceForeign {stubs, files} =+    hang (text "stubs:") 2 (maybe (text "empty") ppr stubs) $$+    vcat (ppr <$> files)++emptyIfaceForeign :: IfaceForeign+emptyIfaceForeign = IfaceForeign {stubs = Nothing, files = []}++-- | Convert foreign stubs and foreign files to a format suitable for writing to+-- interfaces.+--+-- See Note [Foreign stubs and TH bytecode linking]+encodeIfaceForeign ::+  Logger ->+  DynFlags ->+  ForeignStubs ->+  [(ForeignSrcLang, FilePath)] ->+  IO IfaceForeign+encodeIfaceForeign logger dflags foreign_stubs lang_paths = do+  files <- read_foreign_files+  stubs <- encode_stubs foreign_stubs+  let iff = IfaceForeign {stubs, files}+  debugTraceMsg logger 3 $+    hang (text "Encoding foreign data for iface:") 2 (ppr iff)+  pure iff+  where+    -- We can't just store the paths, since files may have been generated with+    -- GHC session lifetime in 'GHC.Internal.TH.Syntax.addForeignSource'.+    read_foreign_files =+      for lang_paths $ \ (lang, path) -> do+        source <- readFile path+        pure IfaceForeignFile {lang, source, extension = takeExtension path}++    encode_stubs = \case+      NoStubs ->+        pure Nothing+      ForeignStubs (CHeader header) (CStub source inits finals) ->+        pure $ Just IfaceCStubs {+          header = render header,+          source = render source,+          initializers = encode_label <$> inits,+          finalizers = encode_label <$> finals+        }++    encode_label clabel =+      fromMaybe (invalid_label clabel) (IfaceCLabel <$> cStubLabel clabel)++    invalid_label clabel =+      pprPanic+      "-fwrite-if-simplified-core is incompatible with this foreign stub:"+      (pprCLabel (targetPlatform dflags) clabel)++    render = renderWithContext (initSDocContext dflags PprCode)++-- | Decode serialized foreign stubs and foreign files.+--+-- See Note [Foreign stubs and TH bytecode linking]+decodeIfaceForeign ::+  Logger ->+  TmpFs ->+  TempDir ->+  IfaceForeign ->+  IO (ForeignStubs, [(ForeignSrcLang, FilePath)])+decodeIfaceForeign logger tmpfs tmp_dir iff@IfaceForeign {stubs, files} = do+  debugTraceMsg logger 3 $+    hang (text "Decoding foreign data from iface:") 2 (ppr iff)+  lang_paths <- for files $ \ IfaceForeignFile {lang, source, extension} -> do+    f <- newTempName logger tmpfs tmp_dir TFL_GhcSession extension+    writeFile f source+    pure (lang, f)+  pure (maybe NoStubs decode_stubs stubs, lang_paths)+  where+    decode_stubs IfaceCStubs {header, source, initializers, finalizers} =+      ForeignStubs+      (CHeader (text header))+      (CStub (text source) (labels initializers) (labels finalizers))++    labels ls = [fromCStubLabel l | IfaceCLabel l <- ls]++instance Binary IfaceForeign where+  get bh = do+    stubs <- get bh+    files <- get bh+    pure IfaceForeign {stubs, files}++  put_ bh IfaceForeign {stubs, files} = do+    put_ bh stubs+    put_ bh files++instance NFData IfaceForeign where+  rnf IfaceForeign {stubs, files} = rnf stubs `seq` rnf files
compiler/GHC/Unit/State.hs view
@@ -68,8 +68,7 @@         pprWithUnitState,          -- * Utils-        unwireUnit,-        implicitPackageDeps)+        unwireUnit) where  import GHC.Prelude@@ -116,7 +115,6 @@ import Data.Monoid (First(..)) import qualified Data.Semigroup as Semigroup import qualified Data.Set as Set-import GHC.LanguageExtensions import Control.Applicative  -- ---------------------------------------------------------------------------@@ -366,9 +364,9 @@         autoLink          | not (gopt Opt_AutoLinkPackages dflags) = []-         -- By default we add base & rts to the preload units (when they are+         -- By default we add ghc-internal & rts to the preload units (when they are          -- found in the unit database) except when we are building them-         | otherwise = filter (hu_id /=) [baseUnitId, rtsUnitId]+         | otherwise = filter (hu_id /=) [ghcInternalUnitId, rtsUnitId]         -- if the home unit is indefinite, it means we are type-checking it only        -- (not producing any code). Hence we can use virtual units instantiated@@ -2268,11 +2266,3 @@ pprWithUnitState state = updSDocContext (\ctx -> ctx    { sdocUnitIdForUser = \fs -> pprUnitIdForUser state (UnitId fs)    })---- | Add package dependencies on the wired-in packages we use-implicitPackageDeps :: DynFlags -> [UnitId]-implicitPackageDeps dflags-   = [thUnitId | xopt TemplateHaskellQuotes dflags]-   -- TODO: Should also include `base` and `ghc-prim` if we use those implicitly, but-   -- it is possible to not depend on base (for example, see `ghc-prim`)-
compiler/GHC/Unit/Types.hs view
@@ -63,9 +63,7 @@    , primUnitId    , bignumUnitId    , ghcInternalUnitId-   , baseUnitId    , rtsUnitId-   , thUnitId    , mainUnitId    , thisGhcUnitId    , interactiveUnitId@@ -73,13 +71,10 @@    , primUnit    , bignumUnit    , ghcInternalUnit-   , baseUnit    , rtsUnit-   , thUnit    , mainUnit    , thisGhcUnit    , interactiveUnit-   , experimentalUnit     , isInteractiveModule    , wiredInUnitIds@@ -89,6 +84,8 @@    , GenWithIsBoot (..)    , ModuleNameWithIsBoot    , ModuleWithIsBoot+   , InstalledModuleWithIsBoot+   , notBoot    ) where @@ -126,6 +123,12 @@    }    deriving (Eq,Ord,Data,Functor) +instance Data ModuleName where+  -- don't traverse?+  toConstr _   = abstractConstr "ModuleName"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "ModuleName"+ -- | A Module is a pair of a 'Unit' and a 'ModuleName'. type Module = GenModule Unit @@ -595,32 +598,25 @@  -} -bignumUnitId, primUnitId, ghcInternalUnitId, baseUnitId, rtsUnitId,-  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId,-  experimentalUnitId :: UnitId+bignumUnitId, primUnitId, ghcInternalUnitId, rtsUnitId,+  mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId -bignumUnit, primUnit, ghcInternalUnit, baseUnit, rtsUnit,-  thUnit, mainUnit, thisGhcUnit, interactiveUnit, experimentalUnit  :: Unit+bignumUnit, primUnit, ghcInternalUnit, rtsUnit,+  mainUnit, thisGhcUnit, interactiveUnit :: Unit  primUnitId        = UnitId (fsLit "ghc-prim") bignumUnitId      = UnitId (fsLit "ghc-bignum") ghcInternalUnitId = UnitId (fsLit "ghc-internal")-baseUnitId        = UnitId (fsLit "base") rtsUnitId         = UnitId (fsLit "rts") thisGhcUnitId     = UnitId (fsLit cProjectUnitId) -- See Note [GHC's Unit Id] interactiveUnitId = UnitId (fsLit "interactive")-thUnitId          = UnitId (fsLit "template-haskell")-experimentalUnitId = UnitId (fsLit "ghc-experimental") -thUnit            = RealUnit (Definite thUnitId) primUnit          = RealUnit (Definite primUnitId) bignumUnit        = RealUnit (Definite bignumUnitId) ghcInternalUnit   = RealUnit (Definite ghcInternalUnitId)-baseUnit          = RealUnit (Definite baseUnitId) rtsUnit           = RealUnit (Definite rtsUnitId) thisGhcUnit       = RealUnit (Definite thisGhcUnitId) interactiveUnit   = RealUnit (Definite interactiveUnitId)-experimentalUnit  = RealUnit (Definite experimentalUnitId)  -- | This is the package Id for the current program.  It is the default -- package Id if you don't specify a package name.  We don't add this prefix@@ -636,10 +632,7 @@    [ primUnitId    , bignumUnitId    , ghcInternalUnitId-   , baseUnitId    , rtsUnitId-   , thUnitId-   , experimentalUnitId    ]    -- NB: ghc is no longer part of the wired-in units since its unit-id, given    -- by hadrian or cabal, is no longer overwritten and now matches both the@@ -727,6 +720,8 @@  type ModuleWithIsBoot = GenWithIsBoot Module +type InstalledModuleWithIsBoot = GenWithIsBoot InstalledModule+ instance Binary a => Binary (GenWithIsBoot a) where   put_ bh (GWIB { gwib_mod, gwib_isBoot }) = do     put_ bh gwib_mod@@ -740,3 +735,6 @@   ppr (GWIB  { gwib_mod, gwib_isBoot }) = hsep $ ppr gwib_mod : case gwib_isBoot of     IsBoot -> [ text "{-# SOURCE #-}" ]     NotBoot -> []++notBoot :: mod -> GenWithIsBoot mod+notBoot gwib_mod = GWIB {gwib_mod, gwib_isBoot = NotBoot}
compiler/GHC/Utils/Binary.hs view
@@ -19,1256 +19,1808 @@ --     http://www.cs.york.ac.uk/fp/nhc98/  module GHC.Utils.Binary-  ( {-type-}  Bin,-    {-class-} Binary(..),-    {-type-}  BinHandle,-    SymbolTable, Dictionary,--   BinData(..), dataHandle, handleData,-   unsafeUnpackBinBuffer,--   openBinMem,---   closeBin,--   seekBin,-   tellBin,-   castBin,-   withBinBuffer,--   foldGet, foldGet',--   writeBinMem,-   readBinMem,-   readBinMemN,--   putAt, getAt,-   forwardPut, forwardPut_, forwardGet,--   -- * For writing instances-   putByte,-   getByte,-   putByteString,-   getByteString,--   -- * Variable length encodings-   putULEB128,-   getULEB128,-   putSLEB128,-   getSLEB128,--   -- * Fixed length encoding-   FixedLengthEncoding(..),--   -- * Lazy Binary I/O-   lazyGet,-   lazyPut,-   lazyGetMaybe,-   lazyPutMaybe,--   -- * User data-   UserData(..), getUserData, setUserData,-   newReadState, newWriteState, noUserData,--   -- * String table ("dictionary")-   putDictionary, getDictionary, putFS,-   FSTable, initFSTable, getDictFastString, putDictFastString,--   -- * Newtype wrappers-   BinSpan(..), BinSrcSpan(..), BinLocated(..)-  ) where--import GHC.Prelude--import Language.Haskell.Syntax.Module.Name (ModuleName(..))--import {-# SOURCE #-} GHC.Types.Name (Name)-import GHC.Data.FastString-import GHC.Utils.Panic.Plain-import GHC.Types.Unique.FM-import GHC.Data.FastMutInt-import GHC.Utils.Fingerprint-import GHC.Types.SrcLoc-import GHC.Types.Unique-import qualified GHC.Data.Strict as Strict-import GHC.Utils.Outputable( JoinPointHood(..) )--import Control.DeepSeq-import Foreign hiding (shiftL, shiftR, void)-import Data.Array-import Data.Array.IO-import Data.Array.Unsafe-import Data.ByteString (ByteString)-import qualified Data.ByteString.Internal as BS-import qualified Data.ByteString.Unsafe   as BS-import Data.IORef-import Data.Char                ( ord, chr )-import Data.List.NonEmpty       ( NonEmpty(..))-import qualified Data.List.NonEmpty as NonEmpty-import Data.Set                 ( Set )-import qualified Data.Set as Set-import Data.Time-import Data.List (unfoldr)-import Control.Monad            ( when, (<$!>), unless, forM_, void )-import System.IO as IO-import System.IO.Unsafe         ( unsafeInterleaveIO )-import System.IO.Error          ( mkIOError, eofErrorType )-import GHC.Real                 ( Ratio(..) )-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-#if MIN_VERSION_base(4,15,0)-import GHC.ForeignPtr           ( unsafeWithForeignPtr )-#endif--type BinArray = ForeignPtr Word8--#if !MIN_VERSION_base(4,15,0)-unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b-unsafeWithForeignPtr = withForeignPtr-#endif-------------------------------------------------------------------- BinData------------------------------------------------------------------data BinData = BinData Int BinArray--instance NFData BinData where-  rnf (BinData sz _) = rnf sz--instance Binary BinData where-  put_ bh (BinData sz dat) = do-    put_ bh sz-    putPrim bh sz $ \dest ->-      unsafeWithForeignPtr dat $ \orig ->-        copyBytes dest orig sz-  ---  get bh = do-    sz <- get bh-    dat <- mallocForeignPtrBytes sz-    getPrim bh sz $ \orig ->-      unsafeWithForeignPtr dat $ \dest ->-        copyBytes dest orig sz-    return (BinData sz dat)--dataHandle :: BinData -> IO BinHandle-dataHandle (BinData size bin) = do-  ixr <- newFastMutInt 0-  szr <- newFastMutInt size-  binr <- newIORef bin-  return (BinMem noUserData ixr szr binr)--handleData :: BinHandle -> IO BinData-handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr-------------------------------------------------------------------- BinHandle------------------------------------------------------------------data BinHandle-  = BinMem {                     -- binary data stored in an unboxed array-     bh_usr :: UserData,         -- sigh, need parameterized modules :-)-     _off_r :: !FastMutInt,      -- the current offset-     _sz_r  :: !FastMutInt,      -- size of the array (cached)-     _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1))-    }-        -- XXX: should really store a "high water mark" for dumping out-        -- the binary data to a file.--getUserData :: BinHandle -> UserData-getUserData bh = bh_usr bh--setUserData :: BinHandle -> UserData -> BinHandle-setUserData bh us = bh { bh_usr = us }---- | Get access to the underlying buffer.-withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a-withBinBuffer (BinMem _ ix_r _ arr_r) action = do-  arr <- readIORef arr_r-  ix <- readFastMutInt ix_r-  action $ BS.fromForeignPtr arr 0 ix--unsafeUnpackBinBuffer :: ByteString -> IO BinHandle-unsafeUnpackBinBuffer (BS.BS arr len) = do-  arr_r <- newIORef arr-  ix_r <- newFastMutInt 0-  sz_r <- newFastMutInt len-  return (BinMem noUserData ix_r sz_r arr_r)-------------------------------------------------------------------- Bin------------------------------------------------------------------newtype Bin a = BinPtr Int-  deriving (Eq, Ord, Show, Bounded)--castBin :: Bin a -> Bin b-castBin (BinPtr i) = BinPtr i-------------------------------------------------------------------- class Binary-------------------------------------------------------------------- | Do not rely on instance sizes for general types,--- we use variable length encoding for many of them.-class Binary a where-    put_   :: BinHandle -> a -> IO ()-    put    :: BinHandle -> a -> IO (Bin a)-    get    :: BinHandle -> IO a--    -- define one of put_, put.  Use of put_ is recommended because it-    -- is more likely that tail-calls can kick in, and we rarely need the-    -- position return value.-    put_ bh a = do _ <- put bh a; return ()-    put bh a  = do p <- tellBin bh; put_ bh a; return p--putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()-putAt bh p x = do seekBin bh p; put_ bh x; return ()--getAt  :: Binary a => BinHandle -> Bin a -> IO a-getAt bh p = do seekBin bh p; get bh--openBinMem :: Int -> IO BinHandle-openBinMem size- | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0"- | otherwise = do-   arr <- mallocForeignPtrBytes size-   arr_r <- newIORef arr-   ix_r <- newFastMutInt 0-   sz_r <- newFastMutInt size-   return (BinMem noUserData ix_r sz_r arr_r)--tellBin :: BinHandle -> IO (Bin a)-tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)--seekBin :: BinHandle -> Bin a -> IO ()-seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do-  sz <- readFastMutInt sz_r-  if (p > sz)-        then do expandBin h p; writeFastMutInt ix_r p-        else writeFastMutInt ix_r p---- | 'seekBinNoExpand' moves the index pointer to the location pointed to--- by 'Bin a'.--- This operation may 'panic', if the pointer location is out of bounds of the--- buffer of 'BinHandle'.-seekBinNoExpand :: BinHandle -> Bin a -> IO ()-seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do-  sz <- readFastMutInt sz_r-  if (p > sz)-        then panic "seekBinNoExpand: seek out of range"-        else writeFastMutInt ix_r p--writeBinMem :: BinHandle -> FilePath -> IO ()-writeBinMem (BinMem _ ix_r _ arr_r) fn = do-  h <- openBinaryFile fn WriteMode-  arr <- readIORef arr_r-  ix  <- readFastMutInt ix_r-  unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix-  hClose h--readBinMem :: FilePath -> IO BinHandle-readBinMem filename = do-  withBinaryFile filename ReadMode $ \h -> do-    filesize' <- hFileSize h-    let filesize = fromIntegral filesize'-    readBinMem_ filesize h--readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle)-readBinMemN size filename = do-  withBinaryFile filename ReadMode $ \h -> do-    filesize' <- hFileSize h-    let filesize = fromIntegral filesize'-    if filesize < size-      then pure Nothing-      else Just <$> readBinMem_ size h--readBinMem_ :: Int -> Handle -> IO BinHandle-readBinMem_ filesize h = do-  arr <- mallocForeignPtrBytes filesize-  count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize-  when (count /= filesize) $-       error ("Binary.readBinMem: only read " ++ show count ++ " bytes")-  arr_r <- newIORef arr-  ix_r <- newFastMutInt 0-  sz_r <- newFastMutInt filesize-  return (BinMem noUserData ix_r sz_r arr_r)---- expand the size of the array to include a specified offset-expandBin :: BinHandle -> Int -> IO ()-expandBin (BinMem _ _ sz_r arr_r) !off = do-   !sz <- readFastMutInt sz_r-   let !sz' = getSize sz-   arr <- readIORef arr_r-   arr' <- mallocForeignPtrBytes sz'-   withForeignPtr arr $ \old ->-     withForeignPtr arr' $ \new ->-       copyBytes new old sz-   writeFastMutInt sz_r sz'-   writeIORef arr_r arr'-   where-    getSize :: Int -> Int-    getSize !sz-      | sz > off-      = sz-      | otherwise-      = getSize (sz * 2)--foldGet-  :: Binary a-  => Word -- n elements-  -> BinHandle-  -> b -- initial accumulator-  -> (Word -> a -> b -> IO b)-  -> IO b-foldGet n bh init_b f = go 0 init_b-  where-    go i b-      | i == n    = return b-      | otherwise = do-          a <- get bh-          b' <- f i a b-          go (i+1) b'--foldGet'-  :: Binary a-  => Word -- n elements-  -> BinHandle-  -> b -- initial accumulator-  -> (Word -> a -> b -> IO b)-  -> IO b-{-# INLINE foldGet' #-}-foldGet' n bh init_b f = go 0 init_b-  where-    go i !b-      | i == n    = return b-      | otherwise = do-          !a  <- get bh-          b'  <- f i a b-          go (i+1) b'----- -------------------------------------------------------------------------------- Low-level reading/writing of bytes---- | Takes a size and action writing up to @size@ bytes.---   After the action has run advance the index to the buffer---   by size bytes.-putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()-putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do-  ix <- readFastMutInt ix_r-  sz <- readFastMutInt sz_r-  when (ix + size > sz) $-    expandBin h (ix + size)-  arr <- readIORef arr_r-  unsafeWithForeignPtr arr $ \op -> f (op `plusPtr` ix)-  writeFastMutInt ix_r (ix + size)---- -- | Similar to putPrim but advances the index by the actual number of--- -- bytes written.--- putPrimMax :: BinHandle -> Int -> (Ptr Word8 -> IO Int) -> IO ()--- putPrimMax h@(BinMem _ ix_r sz_r arr_r) size f = do---   ix <- readFastMutInt ix_r---   sz <- readFastMutInt sz_r---   when (ix + size > sz) $---     expandBin h (ix + size)---   arr <- readIORef arr_r---   written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix)---   writeFastMutInt ix_r (ix + written)--getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a-getPrim (BinMem _ ix_r sz_r arr_r) size f = do-  ix <- readFastMutInt ix_r-  sz <- readFastMutInt sz_r-  when (ix + size > sz) $-      ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)-  arr <- readIORef arr_r-  w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix)-    -- This is safe WRT #17760 as we we guarantee that the above line doesn't-    -- diverge-  writeFastMutInt ix_r (ix + size)-  return w--putWord8 :: BinHandle -> Word8 -> IO ()-putWord8 h !w = putPrim h 1 (\op -> poke op w)--getWord8 :: BinHandle -> IO Word8-getWord8 h = getPrim h 1 peek--putWord16 :: BinHandle -> Word16 -> IO ()-putWord16 h w = putPrim h 2 (\op -> do-  pokeElemOff op 0 (fromIntegral (w `shiftR` 8))-  pokeElemOff op 1 (fromIntegral (w .&. 0xFF))-  )--getWord16 :: BinHandle -> IO Word16-getWord16 h = getPrim h 2 (\op -> do-  w0 <- fromIntegral <$> peekElemOff op 0-  w1 <- fromIntegral <$> peekElemOff op 1-  return $! w0 `shiftL` 8 .|. w1-  )--putWord32 :: BinHandle -> Word32 -> IO ()-putWord32 h w = putPrim h 4 (\op -> do-  pokeElemOff op 0 (fromIntegral (w `shiftR` 24))-  pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))-  pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))-  pokeElemOff op 3 (fromIntegral (w .&. 0xFF))-  )--getWord32 :: BinHandle -> IO Word32-getWord32 h = getPrim h 4 (\op -> do-  w0 <- fromIntegral <$> peekElemOff op 0-  w1 <- fromIntegral <$> peekElemOff op 1-  w2 <- fromIntegral <$> peekElemOff op 2-  w3 <- fromIntegral <$> peekElemOff op 3--  return $! (w0 `shiftL` 24) .|.-            (w1 `shiftL` 16) .|.-            (w2 `shiftL` 8)  .|.-            w3-  )--putWord64 :: BinHandle -> Word64 -> IO ()-putWord64 h w = putPrim h 8 (\op -> do-  pokeElemOff op 0 (fromIntegral (w `shiftR` 56))-  pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))-  pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))-  pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))-  pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))-  pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))-  pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))-  pokeElemOff op 7 (fromIntegral (w .&. 0xFF))-  )--getWord64 :: BinHandle -> IO Word64-getWord64 h = getPrim h 8 (\op -> do-  w0 <- fromIntegral <$> peekElemOff op 0-  w1 <- fromIntegral <$> peekElemOff op 1-  w2 <- fromIntegral <$> peekElemOff op 2-  w3 <- fromIntegral <$> peekElemOff op 3-  w4 <- fromIntegral <$> peekElemOff op 4-  w5 <- fromIntegral <$> peekElemOff op 5-  w6 <- fromIntegral <$> peekElemOff op 6-  w7 <- fromIntegral <$> peekElemOff op 7--  return $! (w0 `shiftL` 56) .|.-            (w1 `shiftL` 48) .|.-            (w2 `shiftL` 40) .|.-            (w3 `shiftL` 32) .|.-            (w4 `shiftL` 24) .|.-            (w5 `shiftL` 16) .|.-            (w6 `shiftL` 8)  .|.-            w7-  )--putByte :: BinHandle -> Word8 -> IO ()-putByte bh !w = putWord8 bh w--getByte :: BinHandle -> IO Word8-getByte h = getWord8 h---- -------------------------------------------------------------------------------- Encode numbers in LEB128 encoding.--- Requires one byte of space per 7 bits of data.------ There are signed and unsigned variants.--- Do NOT use the unsigned one for signed values, at worst it will--- result in wrong results, at best it will lead to bad performance--- when coercing negative values to an unsigned type.------ We mark them as SPECIALIZE as it's extremely critical that they get specialized--- to their specific types.------ TODO: Each use of putByte performs a bounds check,---       we should use putPrimMax here. However it's quite hard to return---       the number of bytes written into putPrimMax without allocating an---       Int for it, while the code below does not allocate at all.---       So we eat the cost of the bounds check instead of increasing allocations---       for now.---- Unsigned numbers-{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-}-{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-}-putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO ()-putULEB128 bh w =-#if defined(DEBUG)-    (if w < 0 then panic "putULEB128: Signed number" else id) $-#endif-    go w-  where-    go :: a -> IO ()-    go w-      | w <= (127 :: a)-      = putByte bh (fromIntegral w :: Word8)-      | otherwise = do-        -- bit 7 (8th bit) indicates more to come.-        let !byte = setBit (fromIntegral w) 7 :: Word8-        putByte bh byte-        go (w `unsafeShiftR` 7)--{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-}-{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-}-getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a-getULEB128 bh =-    go 0 0-  where-    go :: Int -> a -> IO a-    go shift w = do-        b <- getByte bh-        let !hasMore = testBit b 7-        let !val = w .|. ((clearBit (fromIntegral b) 7) `unsafeShiftL` shift) :: a-        if hasMore-            then do-                go (shift+7) val-            else-                return $! val---- Signed numbers-{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-}-{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-}-putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO ()-putSLEB128 bh initial = go initial-  where-    go :: a -> IO ()-    go val = do-        let !byte = fromIntegral (clearBit val 7) :: Word8-        let !val' = val `unsafeShiftR` 7-        let !signBit = testBit byte 6-        let !done =-                -- Unsigned value, val' == 0 and last value can-                -- be discriminated from a negative number.-                ((val' == 0 && not signBit) ||-                -- Signed value,-                 (val' == -1 && signBit))--        let !byte' = if done then byte else setBit byte 7-        putByte bh byte'--        unless done $ go val'--{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-}-{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-}-getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a-getSLEB128 bh = do-    (val,shift,signed) <- go 0 0-    if signed && (shift < finiteBitSize val )-        then return $! ((complement 0 `unsafeShiftL` shift) .|. val)-        else return val-    where-        go :: Int -> a -> IO (a,Int,Bool)-        go shift val = do-            byte <- getByte bh-            let !byteVal = fromIntegral (clearBit byte 7) :: a-            let !val' = val .|. (byteVal `unsafeShiftL` shift)-            let !more = testBit byte 7-            let !shift' = shift+7-            if more-                then go (shift') val'-                else do-                    let !signed = testBit byte 6-                    return (val',shift',signed)---- -------------------------------------------------------------------------------- Fixed length encoding instances---- Sometimes words are used to represent a certain bit pattern instead--- of a number. Using FixedLengthEncoding we will write the pattern as--- is to the interface file without the variable length encoding we usually--- apply.---- | Encode the argument in its full length. This is different from many default--- binary instances which make no guarantee about the actual encoding and--- might do things using variable length encoding.-newtype FixedLengthEncoding a-  = FixedLengthEncoding { unFixedLength :: a }-  deriving (Eq,Ord,Show)--instance Binary (FixedLengthEncoding Word8) where-  put_ h (FixedLengthEncoding x) = putByte h x-  get h = FixedLengthEncoding <$> getByte h--instance Binary (FixedLengthEncoding Word16) where-  put_ h (FixedLengthEncoding x) = putWord16 h x-  get h = FixedLengthEncoding <$> getWord16 h--instance Binary (FixedLengthEncoding Word32) where-  put_ h (FixedLengthEncoding x) = putWord32 h x-  get h = FixedLengthEncoding <$> getWord32 h--instance Binary (FixedLengthEncoding Word64) where-  put_ h (FixedLengthEncoding x) = putWord64 h x-  get h = FixedLengthEncoding <$> getWord64 h---- -------------------------------------------------------------------------------- Primitive Word writes--instance Binary Word8 where-  put_ bh !w = putWord8 bh w-  get  = getWord8--instance Binary Word16 where-  put_ = putULEB128-  get  = getULEB128--instance Binary Word32 where-  put_ = putULEB128-  get  = getULEB128--instance Binary Word64 where-  put_ = putULEB128-  get = getULEB128---- -------------------------------------------------------------------------------- Primitive Int writes--instance Binary Int8 where-  put_ h w = put_ h (fromIntegral w :: Word8)-  get h    = do w <- get h; return $! (fromIntegral (w::Word8))--instance Binary Int16 where-  put_ = putSLEB128-  get = getSLEB128--instance Binary Int32 where-  put_ = putSLEB128-  get = getSLEB128--instance Binary Int64 where-  put_ h w = putSLEB128 h w-  get h    = getSLEB128 h---- -------------------------------------------------------------------------------- Instances for standard types--instance Binary () where-    put_ _ () = return ()-    get  _    = return ()--instance Binary Bool where-    put_ bh b = putByte bh (fromIntegral (fromEnum b))-    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))--instance Binary Char where-    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)-    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))--instance Binary Int where-    put_ bh i = put_ bh (fromIntegral i :: Int64)-    get  bh = do-        x <- get bh-        return $! (fromIntegral (x :: Int64))--instance Binary a => Binary [a] where-    put_ bh l = do-        let len = length l-        put_ bh len-        mapM_ (put_ bh) l-    get bh = do-        len <- get bh :: IO Int -- Int is variable length encoded so only-                                -- one byte for small lists.-        let loop 0 = return []-            loop n = do a <- get bh; as <- loop (n-1); return (a:as)-        loop len---- | This instance doesn't rely on the determinism of the keys' 'Ord' instance,--- so it works e.g. for 'Name's too.-instance (Binary a, Ord a) => Binary (Set a) where-  put_ bh s = put_ bh (Set.toList s)-  get bh = Set.fromList <$> get bh--instance Binary a => Binary (NonEmpty a) where-    put_ bh = put_ bh . NonEmpty.toList-    get bh = NonEmpty.fromList <$> get bh--instance (Ix a, Binary a, Binary b) => Binary (Array a b) where-    put_ bh arr = do-        put_ bh $ bounds arr-        put_ bh $ elems arr-    get bh = do-        bounds <- get bh-        xs <- get bh-        return $ listArray bounds xs--instance (Binary a, Binary b) => Binary (a,b) where-    put_ bh (a,b) = do put_ bh a; put_ bh b-    get bh        = do a <- get bh-                       b <- get bh-                       return (a,b)--instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where-    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c-    get bh          = do a <- get bh-                         b <- get bh-                         c <- get bh-                         return (a,b,c)--instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where-    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d-    get bh            = do a <- get bh-                           b <- get bh-                           c <- get bh-                           d <- get bh-                           return (a,b,c,d)--instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d, e) where-    put_ bh (a,b,c,d, e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e;-    get bh               = do a <- get bh-                              b <- get bh-                              c <- get bh-                              d <- get bh-                              e <- get bh-                              return (a,b,c,d,e)--instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d, e, f) where-    put_ bh (a,b,c,d, e, f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f;-    get bh                  = do a <- get bh-                                 b <- get bh-                                 c <- get bh-                                 d <- get bh-                                 e <- get bh-                                 f <- get bh-                                 return (a,b,c,d,e,f)--instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a,b,c,d,e,f,g) where-    put_ bh (a,b,c,d,e,f,g) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f; put_ bh g-    get bh                  = do a <- get bh-                                 b <- get bh-                                 c <- get bh-                                 d <- get bh-                                 e <- get bh-                                 f <- get bh-                                 g <- get bh-                                 return (a,b,c,d,e,f,g)--instance Binary a => Binary (Maybe a) where-    put_ bh Nothing  = putByte bh 0-    put_ bh (Just a) = do putByte bh 1; put_ bh a-    get bh           = do h <- getWord8 bh-                          case h of-                            0 -> return Nothing-                            _ -> do x <- get bh; return (Just x)--instance Binary a => Binary (Strict.Maybe a) where-    put_ bh Strict.Nothing = putByte bh 0-    put_ bh (Strict.Just a) = do putByte bh 1; put_ bh a-    get bh =-      do h <- getWord8 bh-         case h of-           0 -> return Strict.Nothing-           _ -> do x <- get bh; return (Strict.Just x)--instance (Binary a, Binary b) => Binary (Either a b) where-    put_ bh (Left  a) = do putByte bh 0; put_ bh a-    put_ bh (Right b) = do putByte bh 1; put_ bh b-    get bh            = do h <- getWord8 bh-                           case h of-                             0 -> do a <- get bh ; return (Left a)-                             _ -> do b <- get bh ; return (Right b)--instance Binary UTCTime where-    put_ bh u = do put_ bh (utctDay u)-                   put_ bh (utctDayTime u)-    get bh = do day <- get bh-                dayTime <- get bh-                return $ UTCTime { utctDay = day, utctDayTime = dayTime }--instance Binary Day where-    put_ bh d = put_ bh (toModifiedJulianDay d)-    get bh = do i <- get bh-                return $ ModifiedJulianDay { toModifiedJulianDay = i }--instance Binary DiffTime where-    put_ bh dt = put_ bh (toRational dt)-    get bh = do r <- get bh-                return $ fromRational r--instance Binary JoinPointHood where-    put_ bh NotJoinPoint = putByte bh 0-    put_ bh (JoinPoint ar) = do-        putByte bh 1-        put_ bh ar-    get bh = do-        h <- getByte bh-        case h of-            0 -> return NotJoinPoint-            _ -> do { ar <- get bh; return (JoinPoint ar) }--{--Finally - a reasonable portable Integer instance.--We used to encode values in the Int32 range as such,-falling back to a string of all things. In either case-we stored a tag byte to discriminate between the two cases.--This made some sense as it's highly portable but also not very-efficient.--However GHC stores a surprisingly large number of large Integer-values. In the examples looked at between 25% and 50% of Integers-serialized were outside of the Int32 range.--Consider a value like `2724268014499746065`, some sort of hash-actually generated by GHC.-In the old scheme this was encoded as a list of 19 chars. This-gave a size of 77 Bytes, one for the length of the list and 76-since we encode chars as Word32 as well.--We can easily do better. The new plan is:--* Start with a tag byte-  * 0 => Int64 (LEB128 encoded)-  * 1 => Negative large integer-  * 2 => Positive large integer-* Followed by the value:-  * Int64 is encoded as usual-  * Large integers are encoded as a list of bytes (Word8).-    We use Data.Bits which defines a bit order independent of the representation.-    Values are stored LSB first.--This means our example value `2724268014499746065` is now only 10 bytes large.-* One byte tag-* One byte for the length of the [Word8] list.-* 8 bytes for the actual date.--The new scheme also does not depend in any way on-architecture specific details.--We still use this scheme even with LEB128 available,-as it has less overhead for truly large numbers. (> maxBound :: Int64)--The instance is used for in Binary Integer and Binary Rational in GHC.Types.Literal--}--instance Binary Integer where-    put_ bh i-      | i >= lo64 && i <= hi64 = do-          putWord8 bh 0-          put_ bh (fromIntegral i :: Int64)-      | otherwise = do-          if i < 0-            then putWord8 bh 1-            else putWord8 bh 2-          put_ bh (unroll $ abs i)-      where-        lo64 = fromIntegral (minBound :: Int64)-        hi64 = fromIntegral (maxBound :: Int64)-    get bh = do-      int_kind <- getWord8 bh-      case int_kind of-        0 -> fromIntegral <$!> (get bh :: IO Int64)-        -- Large integer-        1 -> negate <$!> getInt-        2 -> getInt-        _ -> panic "Binary Integer - Invalid byte"-        where-          getInt :: IO Integer-          getInt = roll <$!> (get bh :: IO [Word8])--unroll :: Integer -> [Word8]-unroll = unfoldr step-  where-    step 0 = Nothing-    step i = Just (fromIntegral i, i `shiftR` 8)--roll :: [Word8] -> Integer-roll   = foldl' unstep 0 . reverse-  where-    unstep a b = a `shiftL` 8 .|. fromIntegral b---    {--    -- This code is currently commented out.-    -- See https://gitlab.haskell.org/ghc/ghc/issues/3379#note_104346 for-    -- discussion.--    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)-    put_ bh (J# s# a#) = do-        putByte bh 1-        put_ bh (I# s#)-        let sz# = sizeofByteArray# a#  -- in *bytes*-        put_ bh (I# sz#)  -- in *bytes*-        putByteArray bh a# sz#--    get bh = do-        b <- getByte bh-        case b of-          0 -> do (I# i#) <- get bh-                  return (S# i#)-          _ -> do (I# s#) <- get bh-                  sz <- get bh-                  (BA a#) <- getByteArray bh sz-                  return (J# s# a#)--putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()-putByteArray bh a s# = loop 0#-  where loop n#-           | n# ==# s# = return ()-           | otherwise = do-                putByte bh (indexByteArray a n#)-                loop (n# +# 1#)--getByteArray :: BinHandle -> Int -> IO ByteArray-getByteArray bh (I# sz) = do-  (MBA arr) <- newByteArray sz-  let loop n-           | n ==# sz = return ()-           | otherwise = do-                w <- getByte bh-                writeByteArray arr n w-                loop (n +# 1#)-  loop 0#-  freezeByteArray arr-    -}--{--data ByteArray = BA ByteArray#-data MBA = MBA (MutableByteArray# RealWorld)--newByteArray :: Int# -> IO MBA-newByteArray sz = IO $ \s ->-  case newByteArray# sz s of { (# s, arr #) ->-  (# s, MBA arr #) }--freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray-freezeByteArray arr = IO $ \s ->-  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->-  (# s, BA arr #) }--writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()-writeByteArray arr i (W8# w) = IO $ \s ->-  case writeWord8Array# arr i w s of { s ->-  (# s, () #) }--indexByteArray :: ByteArray# -> Int# -> Word8-indexByteArray a# n# = W8# (indexWord8Array# a# n#)---}-instance (Binary a) => Binary (Ratio a) where-    put_ bh (a :% b) = do put_ bh a; put_ bh b-    get bh = do a <- get bh; b <- get bh; return (a :% b)---- Instance uses fixed-width encoding to allow inserting--- Bin placeholders in the stream.-instance Binary (Bin a) where-  put_ bh (BinPtr i) = putWord32 bh (fromIntegral i :: Word32)-  get bh = do i <- getWord32 bh; return (BinPtr (fromIntegral (i :: Word32)))----- -------------------------------------------------------------------------------- Forward reading/writing---- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B--- by using a forward reference-forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b)-forwardPut bh put_A put_B = do-  -- write placeholder pointer to A-  pre_a <- tellBin bh-  put_ bh pre_a--  -- write B-  r_b <- put_B--  -- update A's pointer-  a <- tellBin bh-  putAt bh pre_a a-  seekBinNoExpand bh a--  -- write A-  r_a <- put_A r_b-  pure (r_a,r_b)--forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO ()-forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B---- | Read a value stored using a forward reference-forwardGet :: BinHandle -> IO a -> IO a-forwardGet bh get_A = do-    -- read forward reference-    p <- get bh -- a BinPtr-    -- store current position-    p_a <- tellBin bh-    -- go read the forward value, then seek back-    seekBinNoExpand bh p-    r <- get_A-    seekBinNoExpand bh p_a-    pure r---- -------------------------------------------------------------------------------- Lazy reading/writing--lazyPut :: Binary a => BinHandle -> a -> IO ()-lazyPut bh a = do-    -- output the obj with a ptr to skip over it:-    pre_a <- tellBin bh-    put_ bh pre_a       -- save a slot for the ptr-    put_ bh a           -- dump the object-    q <- tellBin bh     -- q = ptr to after object-    putAt bh pre_a q    -- fill in slot before a with ptr to q-    seekBin bh q        -- finally carry on writing at q--lazyGet :: Binary a => BinHandle -> IO a-lazyGet bh = do-    p <- get bh -- a BinPtr-    p_a <- tellBin bh-    a <- unsafeInterleaveIO $ do-        -- NB: Use a fresh off_r variable in the child thread, for thread-        -- safety.-        off_r <- newFastMutInt 0-        getAt bh { _off_r = off_r } p_a-    seekBin bh p -- skip over the object for now-    return a---- | Serialize the constructor strictly but lazily serialize a value inside a--- 'Just'.------ This way we can check for the presence of a value without deserializing the--- value itself.-lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO ()-lazyPutMaybe bh Nothing  = putWord8 bh 0-lazyPutMaybe bh (Just x) = do-  putWord8 bh 1-  lazyPut bh x---- | Deserialize a value serialized by 'lazyPutMaybe'.-lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a)-lazyGetMaybe bh = do-  h <- getWord8 bh-  case h of-    0 -> pure Nothing-    _ -> Just <$> lazyGet bh---- -------------------------------------------------------------------------------- UserData--- --------------------------------------------------------------------------------- | Information we keep around during interface file--- serialization/deserialization. Namely we keep the functions for serializing--- and deserializing 'Name's and 'FastString's. We do this because we actually--- use serialization in two distinct settings,------ * When serializing interface files themselves------ * When computing the fingerprint of an IfaceDecl (which we computing by---   hashing its Binary serialization)------ These two settings have different needs while serializing Names:------ * Names in interface files are serialized via a symbol table (see Note---   [Symbol table representation of names] in "GHC.Iface.Binary").------ * During fingerprinting a binding Name is serialized as the OccName and a---   non-binding Name is serialized as the fingerprint of the thing they---   represent. See Note [Fingerprinting IfaceDecls] for further discussion.----data UserData =-   UserData {-        -- for *deserialising* only:-        ud_get_name :: BinHandle -> IO Name,-        ud_get_fs   :: BinHandle -> IO FastString,--        -- for *serialising* only:-        ud_put_nonbinding_name :: BinHandle -> Name -> IO (),-        -- ^ serialize a non-binding 'Name' (e.g. a reference to another-        -- binding).-        ud_put_binding_name :: BinHandle -> Name -> IO (),-        -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl)-        ud_put_fs   :: BinHandle -> FastString -> IO ()-   }--newReadState :: (BinHandle -> IO Name)   -- ^ how to deserialize 'Name's-             -> (BinHandle -> IO FastString)-             -> UserData-newReadState get_name get_fs-  = UserData { ud_get_name = get_name,-               ud_get_fs   = get_fs,-               ud_put_nonbinding_name = undef "put_nonbinding_name",-               ud_put_binding_name    = undef "put_binding_name",-               ud_put_fs   = undef "put_fs"-             }--newWriteState :: (BinHandle -> Name -> IO ())-                 -- ^ how to serialize non-binding 'Name's-              -> (BinHandle -> Name -> IO ())-                 -- ^ how to serialize binding 'Name's-              -> (BinHandle -> FastString -> IO ())-              -> UserData-newWriteState put_nonbinding_name put_binding_name put_fs-  = UserData { ud_get_name = undef "get_name",-               ud_get_fs   = undef "get_fs",-               ud_put_nonbinding_name = put_nonbinding_name,-               ud_put_binding_name    = put_binding_name,-               ud_put_fs   = put_fs-             }--noUserData :: UserData-noUserData = UserData-  { ud_get_name            = undef "get_name"-  , ud_get_fs              = undef "get_fs"-  , ud_put_nonbinding_name = undef "put_nonbinding_name"-  , ud_put_binding_name    = undef "put_binding_name"-  , ud_put_fs              = undef "put_fs"-  }--undef :: String -> a-undef s = panic ("Binary.UserData: no " ++ s)-------------------------------------------------------------- The Dictionary------------------------------------------------------------type Dictionary = Array Int FastString -- The dictionary-                                       -- Should be 0-indexed--putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO ()-putDictionary bh sz dict = do-  put_ bh sz-  mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict)))-    -- It's OK to use nonDetEltsUFM here because the elements have indices-    -- that array uses to create order--getDictionary :: BinHandle -> IO Dictionary-getDictionary bh = do-  sz <- get bh :: IO Int-  mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString)-  forM_ [0..(sz-1)] $ \i -> do-    fs <- getFS bh-    writeArray mut_arr i fs-  unsafeFreeze mut_arr--getDictFastString :: Dictionary -> BinHandle -> IO FastString-getDictFastString dict bh = do-    j <- get bh-    return $! (dict ! fromIntegral (j :: Word32))---initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int)-initFSTable bh = do-  dict_next_ref <- newFastMutInt 0-  dict_map_ref <- newIORef emptyUFM-  let bin_dict = FSTable-        { fs_tab_next = dict_next_ref-        , fs_tab_map  = dict_map_ref-        }-  let put_dict = do-        fs_count <- readFastMutInt dict_next_ref-        dict_map  <- readIORef dict_map_ref-        putDictionary bh fs_count dict_map-        pure fs_count--  -- BinHandle with FastString writing support-  let ud = getUserData bh-  let ud_fs = ud { ud_put_fs = putDictFastString bin_dict }-  let bh_fs = setUserData bh ud_fs--  return (bh_fs,bin_dict,put_dict)--putDictFastString :: FSTable -> BinHandle -> FastString -> IO ()-putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh--allocateFastString :: FSTable -> FastString -> IO Word32-allocateFastString FSTable { fs_tab_next = j_r-                           , fs_tab_map  = out_r-                           } f = do-    out <- readIORef out_r-    let !uniq = getUnique f-    case lookupUFM_Directly out uniq of-        Just (j, _)  -> return (fromIntegral j :: Word32)-        Nothing -> do-           j <- readFastMutInt j_r-           writeFastMutInt j_r (j + 1)-           writeIORef out_r $! addToUFM_Directly out uniq (j, f)-           return (fromIntegral j :: Word32)---- FSTable is an exact copy of Haddock.InterfaceFile.BinDictionary. We rename to--- avoid a collision and copy to avoid a dependency.-data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use-                       , fs_tab_map  :: !(IORef (UniqFM FastString (Int,FastString)))-                                -- indexed by FastString-  }--------------------------------------------------------------- The Symbol Table-------------------------------------------------------------- On disk, the symbol table is an array of IfExtName, when--- reading it in we turn it into a SymbolTable.--type SymbolTable = Array Int Name-------------------------------------------------------------- Reading and writing FastStrings------------------------------------------------------------putFS :: BinHandle -> FastString -> IO ()-putFS bh fs = putBS bh $ bytesFS fs--getFS :: BinHandle -> IO FastString-getFS bh = do-  l  <- get bh :: IO Int-  getPrim bh l (\src -> pure $! mkFastStringBytes src l )---- | Put a ByteString without its length (can't be read back without knowing the--- length!)-putByteString :: BinHandle -> ByteString -> IO ()-putByteString bh bs =-  BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do-    putPrim bh l (\op -> copyBytes op (castPtr ptr) l)---- | Get a ByteString whose length is known-getByteString :: BinHandle -> Int -> IO ByteString-getByteString bh l =-  BS.create l $ \dest -> do-    getPrim bh l (\src -> copyBytes dest src l)--putBS :: BinHandle -> ByteString -> IO ()-putBS bh bs =-  BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do-    put_ bh l-    putPrim bh l (\op -> copyBytes op (castPtr ptr) l)--getBS :: BinHandle -> IO ByteString-getBS bh = do-  l <- get bh :: IO Int-  BS.create l $ \dest -> do-    getPrim bh l (\src -> copyBytes dest src l)--instance Binary ByteString where-  put_ bh f = putBS bh f-  get bh = getBS bh--instance Binary FastString where-  put_ bh f =-    case getUserData bh of-        UserData { ud_put_fs = put_fs } -> put_fs bh f--  get bh =-    case getUserData bh of-        UserData { ud_get_fs = get_fs } -> get_fs bh+  ( {-type-}  Bin, RelBin(..), getRelBin,+    {-class-} Binary(..),+    {-type-}  ReadBinHandle, WriteBinHandle,+    SymbolTable, Dictionary,++   BinData(..), dataHandle, handleData,+   unsafeUnpackBinBuffer,++   openBinMem,+--   closeBin,++   seekBinWriter,+   seekBinReader,+   seekBinReaderRel,+   tellBinReader,+   tellBinWriter,+   castBin,+   withBinBuffer,+   freezeWriteHandle,+   shrinkBinBuffer,+   thawReadHandle,++   foldGet, foldGet',++   writeBinMem,+   readBinMem,+   readBinMemN,++   putAt, getAt,+   putAtRel,+   forwardPut, forwardPut_, forwardGet,+   forwardPutRel, forwardPutRel_, forwardGetRel,++   -- * For writing instances+   putByte,+   getByte,+   putByteString,+   getByteString,++   -- * Variable length encodings+   putULEB128,+   getULEB128,+   putSLEB128,+   getSLEB128,++   -- * Fixed length encoding+   FixedLengthEncoding(..),++   -- * Lazy Binary I/O+   lazyGet,+   lazyPut,+   lazyGet',+   lazyPut',+   lazyGetMaybe,+   lazyPutMaybe,++   -- * User data+   ReaderUserData, getReaderUserData, setReaderUserData, noReaderUserData,+   WriterUserData, getWriterUserData, setWriterUserData, noWriterUserData,+   mkWriterUserData, mkReaderUserData,+   newReadState, newWriteState,+   addReaderToUserData, addWriterToUserData,+   findUserDataReader, findUserDataWriter,+   -- * Binary Readers & Writers+   BinaryReader(..), BinaryWriter(..),+   mkWriter, mkReader,+   SomeBinaryReader, SomeBinaryWriter,+   mkSomeBinaryReader, mkSomeBinaryWriter,+   -- * Tables+   ReaderTable(..),+   WriterTable(..),+   -- * String table ("dictionary")+   initFastStringReaderTable, initFastStringWriterTable,+   putDictionary, getDictionary, putFS,+   FSTable(..), getDictFastString, putDictFastString,+   -- * Generic deduplication table+   GenericSymbolTable(..),+   initGenericSymbolTable,+   getGenericSymtab, putGenericSymTab,+   getGenericSymbolTable, putGenericSymbolTable,+   -- * Newtype wrappers+   BinSpan(..), BinSrcSpan(..), BinLocated(..),+   -- * Newtypes for types that have canonically more than one valid encoding+   BindingName(..),+   simpleBindingNameWriter,+   simpleBindingNameReader,+   FullBinData(..), freezeBinHandle, thawBinHandle, putFullBinData,+   BinArray,+  ) where++import GHC.Prelude++import Language.Haskell.Syntax.Module.Name (ModuleName(..))++import {-# SOURCE #-} GHC.Types.Name (Name)+import GHC.Data.FastString+import GHC.Data.TrieMap+import GHC.Utils.Panic.Plain+import GHC.Types.Unique.FM+import GHC.Data.FastMutInt+import GHC.Utils.Fingerprint+import GHC.Types.SrcLoc+import GHC.Types.Unique+import qualified GHC.Data.Strict as Strict+import GHC.Utils.Outputable( JoinPointHood(..) )++import Control.DeepSeq+import Control.Monad            ( when, (<$!>), unless, forM_, void )+import Foreign hiding (bit, setBit, clearBit, shiftL, shiftR, void)+import Data.Array+import Data.Array.IO+import Data.Array.Unsafe+import Data.ByteString (ByteString, copy)+import Data.Coerce+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe   as BS+import Data.IORef+import Data.Char                ( ord, chr )+import Data.List.NonEmpty       ( NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Proxy+import Data.Set                 ( Set )+import qualified Data.Set as Set+import Data.Time+import Data.List (unfoldr)+import System.IO as IO+import System.IO.Unsafe         ( unsafeInterleaveIO )+import System.IO.Error          ( mkIOError, eofErrorType )+import Type.Reflection          ( Typeable, SomeTypeRep(..) )+import qualified Type.Reflection as Refl+import GHC.Real                 ( Ratio(..) )+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+#if MIN_VERSION_base(4,15,0)+import GHC.ForeignPtr           ( unsafeWithForeignPtr )+#endif++import Unsafe.Coerce (unsafeCoerce)++type BinArray = ForeignPtr Word8++#if !MIN_VERSION_base(4,15,0)+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+unsafeWithForeignPtr = withForeignPtr+#endif++---------------------------------------------------------------+-- BinData+---------------------------------------------------------------++data BinData = BinData Int BinArray++instance NFData BinData where+  rnf (BinData sz _) = rnf sz++instance Binary BinData where+  put_ bh (BinData sz dat) = do+    put_ bh sz+    putPrim bh sz $ \dest ->+      unsafeWithForeignPtr dat $ \orig ->+        copyBytes dest orig sz+  --+  get bh = do+    sz <- get bh+    dat <- mallocForeignPtrBytes sz+    getPrim bh sz $ \orig ->+      unsafeWithForeignPtr dat $ \dest ->+        copyBytes dest orig sz+    return (BinData sz dat)++dataHandle :: BinData -> IO ReadBinHandle+dataHandle (BinData size bin) = do+  ixr <- newFastMutInt 0+  return (ReadBinMem noReaderUserData ixr size bin)++handleData :: WriteBinHandle -> IO BinData+handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr++---------------------------------------------------------------+-- FullBinData+---------------------------------------------------------------++-- | 'FullBinData' stores a slice to a 'BinArray'.+--+-- It requires less memory than 'ReadBinHandle', and can be constructed from+-- a 'ReadBinHandle' via 'freezeBinHandle' and turned back into a+-- 'ReadBinHandle' using 'thawBinHandle'.+-- Additionally, the byte array slice can be put into a 'WriteBinHandle' without extra+-- conversions via 'putFullBinData'.+data FullBinData = FullBinData+  { fbd_readerUserData :: ReaderUserData+  -- ^ 'ReaderUserData' that can be used to resume reading.+  , fbd_off_s :: {-# UNPACK #-} !Int+  -- ^ start offset+  , fbd_off_e :: {-# UNPACK #-} !Int+  -- ^ end offset+  , fbd_size :: {-# UNPACK #-} !Int+  -- ^ total buffer size+  , fbd_buffer :: {-# UNPACK #-} !BinArray+  }++-- Equality and Ord assume that two distinct buffers are different, even if they compare the same things.+instance Eq FullBinData where+  (FullBinData _ b c d e) == (FullBinData _ b1 c1 d1 e1) = b == b1 && c == c1 && d == d1 && e == e1++instance Ord FullBinData where+  compare (FullBinData _ b c d e) (FullBinData _ b1 c1 d1 e1) =+    compare b b1 `mappend` compare c c1 `mappend` compare d d1 `mappend` compare e e1++-- | Write the 'FullBinData' slice into the 'WriteBinHandle'.+putFullBinData :: WriteBinHandle -> FullBinData -> IO ()+putFullBinData bh (FullBinData _ o1 o2 _sz ba) = do+  let sz = o2 - o1+  putPrim bh sz $ \dest ->+    unsafeWithForeignPtr (ba `plusForeignPtr` o1) $ \orig ->+    copyBytes dest orig sz++-- | Freeze a 'ReadBinHandle' and a start index into a 'FullBinData'.+--+-- 'FullBinData' stores a slice starting from the 'Bin a' location to the current+-- offset of the 'ReadBinHandle'.+freezeBinHandle :: ReadBinHandle -> Bin a -> IO FullBinData+freezeBinHandle (ReadBinMem user_data ixr sz binr) (BinPtr start) = do+  ix <- readFastMutInt ixr+  pure (FullBinData user_data start ix sz binr)++-- | Turn the 'FullBinData' into a 'ReadBinHandle', setting the 'ReadBinHandle'+-- offset to the start of the 'FullBinData' and restore the 'ReaderUserData' that was+-- obtained from 'freezeBinHandle'.+thawBinHandle :: FullBinData -> IO ReadBinHandle+thawBinHandle (FullBinData user_data ix _end sz ba) = do+  ixr <- newFastMutInt ix+  return $ ReadBinMem user_data ixr sz ba++---------------------------------------------------------------+-- BinHandle+---------------------------------------------------------------++-- | A write-only handle that can be used to serialise binary data into a buffer.+--+-- The buffer is an unboxed binary array.+data WriteBinHandle+  = WriteBinMem {+     wbm_userData :: WriterUserData,+     -- ^ User data for writing binary outputs.+     -- Allows users to overwrite certain 'Binary' instances.+     -- This is helpful when a non-canonical 'Binary' instance is required,+     -- such as in the case of 'Name'.+     wbm_off_r    :: !FastMutInt,      -- ^ the current offset+     wbm_sz_r     :: !FastMutInt,      -- ^ size of the array (cached)+     wbm_arr_r    :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1))+    }++-- | A read-only handle that can be used to deserialise binary data from a buffer.+--+-- The buffer is an unboxed binary array.+data ReadBinHandle+  = ReadBinMem {+     rbm_userData :: ReaderUserData,+     -- ^ User data for reading binary inputs.+     -- Allows users to overwrite certain 'Binary' instances.+     -- This is helpful when a non-canonical 'Binary' instance is required,+     -- such as in the case of 'Name'.+     rbm_off_r    :: !FastMutInt,     -- ^ the current offset+     rbm_sz_r     :: !Int,            -- ^ size of the array (cached)+     rbm_arr_r    :: !BinArray        -- ^ the array (bounds: (0,size-1))+    }++getReaderUserData :: ReadBinHandle -> ReaderUserData+getReaderUserData bh = rbm_userData bh++getWriterUserData :: WriteBinHandle -> WriterUserData+getWriterUserData bh = wbm_userData bh++setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle+setWriterUserData bh us = bh { wbm_userData = us }++setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle+setReaderUserData bh us = bh { rbm_userData = us }++-- | Add 'SomeBinaryReader' as a known binary decoder.+-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData',+-- it is overwritten.+addReaderToUserData :: forall a. Typeable a => BinaryReader a -> ReadBinHandle -> ReadBinHandle+addReaderToUserData reader bh = bh+  { rbm_userData = (rbm_userData bh)+      { ud_reader_data =+          let+            typRep = Refl.typeRep @a+          in+            Map.insert (SomeTypeRep typRep) (SomeBinaryReader typRep reader) (ud_reader_data (rbm_userData bh))+      }+  }++-- | Add 'SomeBinaryWriter' as a known binary encoder.+-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData',+-- it is overwritten.+addWriterToUserData :: forall a . Typeable a => BinaryWriter a -> WriteBinHandle -> WriteBinHandle+addWriterToUserData writer bh = bh+  { wbm_userData = (wbm_userData bh)+      { ud_writer_data =+          let+            typRep = Refl.typeRep @a+          in+            Map.insert (SomeTypeRep typRep) (SomeBinaryWriter typRep writer) (ud_writer_data (wbm_userData bh))+      }+  }++-- | Get access to the underlying buffer.+withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a+withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do+  ix <- readFastMutInt ix_r+  arr <- readIORef arr_r+  action $ BS.fromForeignPtr arr 0 ix++unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle+unsafeUnpackBinBuffer (BS.BS arr len) = do+  ix_r <- newFastMutInt 0+  return (ReadBinMem noReaderUserData ix_r len arr)++---------------------------------------------------------------+-- Bin+---------------------------------------------------------------++newtype Bin a = BinPtr Int+  deriving (Eq, Ord, Show, Bounded)++-- | Like a 'Bin' but is used to store relative offset pointers.+-- Relative offset pointers store a relative location, but also contain an+-- anchor that allow to obtain the absolute offset.+data RelBin a = RelBin+  { relBin_anchor :: {-# UNPACK #-} !(Bin a)+  -- ^ Absolute position from where we read 'relBin_offset'.+  , relBin_offset :: {-# UNPACK #-} !(RelBinPtr a)+  -- ^ Relative offset to 'relBin_anchor'.+  -- The absolute position of the 'RelBin' is @relBin_anchor + relBin_offset@+  }+  deriving (Eq, Ord, Show, Bounded)++-- | A 'RelBinPtr' is like a 'Bin', but contains a relative offset pointer+-- instead of an absolute offset.+newtype RelBinPtr a = RelBinPtr (Bin a)+  deriving (Eq, Ord, Show, Bounded)++castBin :: Bin a -> Bin b+castBin (BinPtr i) = BinPtr i++-- | Read a relative offset location and wrap it in 'RelBin'.+--+-- The resulting 'RelBin' can be translated into an absolute offset location using+-- 'makeAbsoluteBin'+getRelBin :: ReadBinHandle -> IO (RelBin a)+getRelBin bh = do+  start <- tellBinReader bh+  off <- get bh+  pure $ RelBin start off++makeAbsoluteBin ::  RelBin a -> Bin a+makeAbsoluteBin (RelBin (BinPtr !start) (RelBinPtr (BinPtr !offset))) =+  BinPtr $ start + offset++makeRelativeBin :: RelBin a -> RelBinPtr a+makeRelativeBin (RelBin _ offset) = offset++toRelBin :: Bin (RelBinPtr a) -> Bin a -> RelBin a+toRelBin (BinPtr !start) (BinPtr !goal) =+  RelBin (BinPtr start) (RelBinPtr $ BinPtr $ goal - start)++---------------------------------------------------------------+-- class Binary+---------------------------------------------------------------++-- | Do not rely on instance sizes for general types,+-- we use variable length encoding for many of them.+class Binary a where+    put_   :: WriteBinHandle -> a -> IO ()+    put    :: WriteBinHandle -> a -> IO (Bin a)+    get    :: ReadBinHandle -> IO a++    -- define one of put_, put.  Use of put_ is recommended because it+    -- is more likely that tail-calls can kick in, and we rarely need the+    -- position return value.+    put_ bh a = do _ <- put bh a; return ()+    put bh a  = do p <- tellBinWriter bh; put_ bh a; return p++putAt  :: Binary a => WriteBinHandle -> Bin a -> a -> IO ()+putAt bh p x = do seekBinWriter bh p; put_ bh x; return ()++putAtRel :: WriteBinHandle -> Bin (RelBinPtr a) -> Bin a -> IO ()+putAtRel bh from to = putAt bh from (makeRelativeBin $ toRelBin from to)++getAt  :: Binary a => ReadBinHandle -> Bin a -> IO a+getAt bh p = do seekBinReader bh p; get bh++openBinMem :: Int -> IO WriteBinHandle+openBinMem size+ | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0"+ | otherwise = do+   arr <- mallocForeignPtrBytes size+   arr_r <- newIORef arr+   ix_r <- newFastMutInt 0+   sz_r <- newFastMutInt size+   return WriteBinMem+    { wbm_userData = noWriterUserData+    , wbm_off_r = ix_r+    , wbm_sz_r = sz_r+    , wbm_arr_r = arr_r+    }++-- | Freeze the given 'WriteBinHandle' and turn it into an equivalent 'ReadBinHandle'.+--+-- The current offset of the 'WriteBinHandle' is maintained in the new 'ReadBinHandle'.+freezeWriteHandle :: WriteBinHandle -> IO ReadBinHandle+freezeWriteHandle wbm = do+  rbm_off_r <- newFastMutInt =<< readFastMutInt (wbm_off_r wbm)+  rbm_sz_r <- readFastMutInt (wbm_sz_r wbm)+  rbm_arr_r <- readIORef (wbm_arr_r wbm)+  pure $ ReadBinMem+    { rbm_userData = noReaderUserData+    , rbm_off_r = rbm_off_r+    , rbm_sz_r = rbm_sz_r+    , rbm_arr_r = rbm_arr_r+    }++-- | Copy the BinBuffer to a new BinBuffer which is exactly the right size.+-- This performs a copy of the underlying buffer.+-- The buffer may be truncated if the offset is not at the end of the written+-- output.+--+-- UserData is also discarded during the copy+-- You should just use this when translating a Put handle into a Get handle.+shrinkBinBuffer :: WriteBinHandle -> IO ReadBinHandle+shrinkBinBuffer bh = withBinBuffer bh $ \bs -> do+  unsafeUnpackBinBuffer (copy bs)++thawReadHandle :: ReadBinHandle -> IO WriteBinHandle+thawReadHandle rbm = do+  wbm_off_r <- newFastMutInt =<< readFastMutInt (rbm_off_r rbm)+  wbm_sz_r <- newFastMutInt (rbm_sz_r rbm)+  wbm_arr_r <- newIORef (rbm_arr_r rbm)+  pure $ WriteBinMem+    { wbm_userData = noWriterUserData+    , wbm_off_r = wbm_off_r+    , wbm_sz_r = wbm_sz_r+    , wbm_arr_r = wbm_arr_r+    }++tellBinWriter :: WriteBinHandle -> IO (Bin a)+tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)++tellBinReader :: ReadBinHandle -> IO (Bin a)+tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)++seekBinWriter :: WriteBinHandle -> Bin a -> IO ()+seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do+  sz <- readFastMutInt sz_r+  if (p > sz)+        then do expandBin h p; writeFastMutInt ix_r p+        else writeFastMutInt ix_r p++-- | 'seekBinNoExpandWriter' moves the index pointer to the location pointed to+-- by 'Bin a'.+-- This operation may 'panic', if the pointer location is out of bounds of the+-- buffer of 'BinHandle'.+seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO ()+seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do+  sz <- readFastMutInt sz_r+  if (p > sz)+        then panic "seekBinNoExpandWriter: seek out of range"+        else writeFastMutInt ix_r p++-- | SeekBin but without calling expandBin+seekBinReader :: ReadBinHandle -> Bin a -> IO ()+seekBinReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do+  if (p > sz_r)+        then panic "seekBinReader: seek out of range"+        else writeFastMutInt ix_r p++seekBinReaderRel :: ReadBinHandle -> RelBin a -> IO ()+seekBinReaderRel (ReadBinMem _ ix_r sz_r _) relBin = do+  let (BinPtr !p) = makeAbsoluteBin relBin+  if (p > sz_r)+        then panic "seekBinReaderRel: seek out of range"+        else writeFastMutInt ix_r p++writeBinMem :: WriteBinHandle -> FilePath -> IO ()+writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do+  h <- openBinaryFile fn WriteMode+  arr <- readIORef arr_r+  ix  <- readFastMutInt ix_r+  unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix+  hClose h++readBinMem :: FilePath -> IO ReadBinHandle+readBinMem filename = do+  withBinaryFile filename ReadMode $ \h -> do+    filesize' <- hFileSize h+    let filesize = fromIntegral filesize'+    readBinMem_ filesize h++readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle)+readBinMemN size filename = do+  withBinaryFile filename ReadMode $ \h -> do+    filesize' <- hFileSize h+    let filesize = fromIntegral filesize'+    if filesize < size+      then pure Nothing+      else Just <$> readBinMem_ size h++readBinMem_ :: Int -> Handle -> IO ReadBinHandle+readBinMem_ filesize h = do+  arr <- mallocForeignPtrBytes filesize+  count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize+  when (count /= filesize) $+       error ("Binary.readBinMem: only read " ++ show count ++ " bytes")+  ix_r <- newFastMutInt 0+  return ReadBinMem+    { rbm_userData = noReaderUserData+    , rbm_off_r = ix_r+    , rbm_sz_r = filesize+    , rbm_arr_r = arr+    }++-- expand the size of the array to include a specified offset+expandBin :: WriteBinHandle -> Int -> IO ()+expandBin (WriteBinMem _ _ sz_r arr_r) !off = do+   !sz <- readFastMutInt sz_r+   let !sz' = getSize sz+   arr <- readIORef arr_r+   arr' <- mallocForeignPtrBytes sz'+   withForeignPtr arr $ \old ->+     withForeignPtr arr' $ \new ->+       copyBytes new old sz+   writeFastMutInt sz_r sz'+   writeIORef arr_r arr'+   where+    getSize :: Int -> Int+    getSize !sz+      | sz > off+      = sz+      | otherwise+      = getSize (sz * 2)++foldGet+  :: Binary a+  => Word -- n elements+  -> ReadBinHandle+  -> b -- initial accumulator+  -> (Word -> a -> b -> IO b)+  -> IO b+foldGet n bh init_b f = go 0 init_b+  where+    go i b+      | i == n    = return b+      | otherwise = do+          a <- get bh+          b' <- f i a b+          go (i+1) b'++foldGet'+  :: Binary a+  => Word -- n elements+  -> ReadBinHandle+  -> b -- initial accumulator+  -> (Word -> a -> b -> IO b)+  -> IO b+{-# INLINE foldGet' #-}+foldGet' n bh init_b f = go 0 init_b+  where+    go i !b+      | i == n    = return b+      | otherwise = do+          !a  <- get bh+          b'  <- f i a b+          go (i+1) b'+++-- -----------------------------------------------------------------------------+-- Low-level reading/writing of bytes++-- | Takes a size and action writing up to @size@ bytes.+--   After the action has run advance the index to the buffer+--   by size bytes.+putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()+putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do+  ix <- readFastMutInt ix_r+  sz <- readFastMutInt sz_r+  when (ix + size > sz) $+    expandBin h (ix + size)+  arr <- readIORef arr_r+  unsafeWithForeignPtr arr $ \op -> f (op `plusPtr` ix)+  writeFastMutInt ix_r (ix + size)++-- -- | Similar to putPrim but advances the index by the actual number of+-- -- bytes written.+-- putPrimMax :: BinHandle -> Int -> (Ptr Word8 -> IO Int) -> IO ()+-- putPrimMax h@(BinMem _ ix_r sz_r arr_r) size f = do+--   ix <- readFastMutInt ix_r+--   sz <- readFastMutInt sz_r+--   when (ix + size > sz) $+--     expandBin h (ix + size)+--   arr <- readIORef arr_r+--   written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix)+--   writeFastMutInt ix_r (ix + written)++getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a+getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do+  ix <- readFastMutInt ix_r+  when (ix + size > sz_r) $+      ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)+  w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)+    -- This is safe WRT #17760 as we we guarantee that the above line doesn't+    -- diverge+  writeFastMutInt ix_r (ix + size)+  return w++putWord8 :: WriteBinHandle -> Word8 -> IO ()+putWord8 h !w = putPrim h 1 (\op -> poke op w)++getWord8 :: ReadBinHandle -> IO Word8+getWord8 h = getPrim h 1 peek++putWord16 :: WriteBinHandle -> Word16 -> IO ()+putWord16 h w = putPrim h 2 (\op -> do+  pokeElemOff op 0 (fromIntegral (w `shiftR` 8))+  pokeElemOff op 1 (fromIntegral (w .&. 0xFF))+  )++getWord16 :: ReadBinHandle -> IO Word16+getWord16 h = getPrim h 2 (\op -> do+  w0 <- fromIntegral <$> peekElemOff op 0+  w1 <- fromIntegral <$> peekElemOff op 1+  return $! w0 `shiftL` 8 .|. w1+  )++putWord32 :: WriteBinHandle -> Word32 -> IO ()+putWord32 h w = putPrim h 4 (\op -> do+  pokeElemOff op 0 (fromIntegral (w `shiftR` 24))+  pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))+  pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))+  pokeElemOff op 3 (fromIntegral (w .&. 0xFF))+  )++getWord32 :: ReadBinHandle -> IO Word32+getWord32 h = getPrim h 4 (\op -> do+  w0 <- fromIntegral <$> peekElemOff op 0+  w1 <- fromIntegral <$> peekElemOff op 1+  w2 <- fromIntegral <$> peekElemOff op 2+  w3 <- fromIntegral <$> peekElemOff op 3++  return $! (w0 `shiftL` 24) .|.+            (w1 `shiftL` 16) .|.+            (w2 `shiftL` 8)  .|.+            w3+  )++putWord64 :: WriteBinHandle -> Word64 -> IO ()+putWord64 h w = putPrim h 8 (\op -> do+  pokeElemOff op 0 (fromIntegral (w `shiftR` 56))+  pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))+  pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))+  pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))+  pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))+  pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))+  pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))+  pokeElemOff op 7 (fromIntegral (w .&. 0xFF))+  )++getWord64 :: ReadBinHandle -> IO Word64+getWord64 h = getPrim h 8 (\op -> do+  w0 <- fromIntegral <$> peekElemOff op 0+  w1 <- fromIntegral <$> peekElemOff op 1+  w2 <- fromIntegral <$> peekElemOff op 2+  w3 <- fromIntegral <$> peekElemOff op 3+  w4 <- fromIntegral <$> peekElemOff op 4+  w5 <- fromIntegral <$> peekElemOff op 5+  w6 <- fromIntegral <$> peekElemOff op 6+  w7 <- fromIntegral <$> peekElemOff op 7++  return $! (w0 `shiftL` 56) .|.+            (w1 `shiftL` 48) .|.+            (w2 `shiftL` 40) .|.+            (w3 `shiftL` 32) .|.+            (w4 `shiftL` 24) .|.+            (w5 `shiftL` 16) .|.+            (w6 `shiftL` 8)  .|.+            w7+  )++putByte :: WriteBinHandle -> Word8 -> IO ()+putByte bh !w = putWord8 bh w++getByte :: ReadBinHandle -> IO Word8+getByte h = getWord8 h++-- -----------------------------------------------------------------------------+-- Encode numbers in LEB128 encoding.+-- Requires one byte of space per 7 bits of data.+--+-- There are signed and unsigned variants.+-- Do NOT use the unsigned one for signed values, at worst it will+-- result in wrong results, at best it will lead to bad performance+-- when coercing negative values to an unsigned type.+--+-- We mark them as SPECIALIZE as it's extremely critical that they get specialized+-- to their specific types.+--+-- TODO: Each use of putByte performs a bounds check,+--       we should use putPrimMax here. However it's quite hard to return+--       the number of bytes written into putPrimMax without allocating an+--       Int for it, while the code below does not allocate at all.+--       So we eat the cost of the bounds check instead of increasing allocations+--       for now.++-- Unsigned numbers+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-}+{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-}+putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO ()+putULEB128 bh w =+#if defined(DEBUG)+    (if w < 0 then panic "putULEB128: Signed number" else id) $+#endif+    go w+  where+    go :: a -> IO ()+    go w+      | w <= (127 :: a)+      = putByte bh (fromIntegral w :: Word8)+      | otherwise = do+        -- bit 7 (8th bit) indicates more to come.+        let !byte = setBit (fromIntegral w) 7 :: Word8+        putByte bh byte+        go (w `unsafeShiftR` 7)++{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-}+{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-}+getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a+getULEB128 bh =+    go 0 0+  where+    go :: Int -> a -> IO a+    go shift w = do+        b <- getByte bh+        let !hasMore = testBit b 7+        let !val = w .|. ((clearBit (fromIntegral b) 7) `unsafeShiftL` shift) :: a+        if hasMore+            then do+                go (shift+7) val+            else+                return $! val++-- Signed numbers+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-}+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-}+putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO ()+putSLEB128 bh initial = go initial+  where+    go :: a -> IO ()+    go val = do+        let !byte = fromIntegral (clearBit val 7) :: Word8+        let !val' = val `unsafeShiftR` 7+        let !signBit = testBit byte 6+        let !done =+                -- Unsigned value, val' == 0 and last value can+                -- be discriminated from a negative number.+                ((val' == 0 && not signBit) ||+                -- Signed value,+                 (val' == -1 && signBit))++        let !byte' = if done then byte else setBit byte 7+        putByte bh byte'++        unless done $ go val'++{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-}+{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-}+getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a+getSLEB128 bh = do+    (val,shift,signed) <- go 0 0+    if signed && (shift < finiteBitSize val )+        then return $! ((complement 0 `unsafeShiftL` shift) .|. val)+        else return val+    where+        go :: Int -> a -> IO (a,Int,Bool)+        go shift val = do+            byte <- getByte bh+            let !byteVal = fromIntegral (clearBit byte 7) :: a+            let !val' = val .|. (byteVal `unsafeShiftL` shift)+            let !more = testBit byte 7+            let !shift' = shift+7+            if more+                then go (shift') val'+                else do+                    let !signed = testBit byte 6+                    return (val',shift',signed)++-- -----------------------------------------------------------------------------+-- Fixed length encoding instances++-- Sometimes words are used to represent a certain bit pattern instead+-- of a number. Using FixedLengthEncoding we will write the pattern as+-- is to the interface file without the variable length encoding we usually+-- apply.++-- | Encode the argument in its full length. This is different from many default+-- binary instances which make no guarantee about the actual encoding and+-- might do things using variable length encoding.+newtype FixedLengthEncoding a+  = FixedLengthEncoding { unFixedLength :: a }+  deriving (Eq,Ord,Show)++instance Binary (FixedLengthEncoding Word8) where+  put_ h (FixedLengthEncoding x) = putByte h x+  get h = FixedLengthEncoding <$> getByte h++instance Binary (FixedLengthEncoding Word16) where+  put_ h (FixedLengthEncoding x) = putWord16 h x+  get h = FixedLengthEncoding <$> getWord16 h++instance Binary (FixedLengthEncoding Word32) where+  put_ h (FixedLengthEncoding x) = putWord32 h x+  get h = FixedLengthEncoding <$> getWord32 h++instance Binary (FixedLengthEncoding Word64) where+  put_ h (FixedLengthEncoding x) = putWord64 h x+  get h = FixedLengthEncoding <$> getWord64 h++-- -----------------------------------------------------------------------------+-- Primitive Word writes++instance Binary Word8 where+  put_ bh !w = putWord8 bh w+  get  = getWord8++instance Binary Word16 where+  put_ = putULEB128+  get  = getULEB128++instance Binary Word32 where+  put_ = putULEB128+  get  = getULEB128++instance Binary Word64 where+  put_ = putULEB128+  get = getULEB128++-- -----------------------------------------------------------------------------+-- Primitive Int writes++instance Binary Int8 where+  put_ h w = put_ h (fromIntegral w :: Word8)+  get h    = do w <- get h; return $! (fromIntegral (w::Word8))++instance Binary Int16 where+  put_ = putSLEB128+  get = getSLEB128++instance Binary Int32 where+  put_ = putSLEB128+  get = getSLEB128++instance Binary Int64 where+  put_ h w = putSLEB128 h w+  get h    = getSLEB128 h++-- -----------------------------------------------------------------------------+-- Instances for standard types++instance Binary () where+    put_ _ () = return ()+    get  _    = return ()++instance Binary Bool where+    put_ bh b = putByte bh (fromIntegral (fromEnum b))+    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))++instance Binary Char where+    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)+    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))++instance Binary Int where+    put_ bh i = put_ bh (fromIntegral i :: Int64)+    get  bh = do+        x <- get bh+        return $! (fromIntegral (x :: Int64))++instance Binary a => Binary [a] where+    put_ bh l = do+        let len = length l+        put_ bh len+        mapM_ (put_ bh) l+    get bh = do+        len <- get bh :: IO Int -- Int is variable length encoded so only+                                -- one byte for small lists.+        let loop 0 = return []+            loop n = do a <- get bh; as <- loop (n-1); return (a:as)+        loop len++-- | This instance doesn't rely on the determinism of the keys' 'Ord' instance,+-- so it works e.g. for 'Name's too.+instance (Binary a, Ord a) => Binary (Set a) where+  put_ bh s = put_ bh (Set.toList s)+  get bh = Set.fromList <$> get bh++instance Binary a => Binary (NonEmpty a) where+    put_ bh = put_ bh . NonEmpty.toList+    get bh = NonEmpty.fromList <$> get bh++instance (Ix a, Binary a, Binary b) => Binary (Array a b) where+    put_ bh arr = do+        put_ bh $ bounds arr+        put_ bh $ elems arr+    get bh = do+        bounds <- get bh+        xs <- get bh+        return $ listArray bounds xs++instance (Binary a, Binary b) => Binary (a,b) where+    put_ bh (a,b) = do put_ bh a; put_ bh b+    get bh        = do a <- get bh+                       b <- get bh+                       return (a,b)++instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where+    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c+    get bh          = do a <- get bh+                         b <- get bh+                         c <- get bh+                         return (a,b,c)++instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where+    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d+    get bh            = do a <- get bh+                           b <- get bh+                           c <- get bh+                           d <- get bh+                           return (a,b,c,d)++instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d, e) where+    put_ bh (a,b,c,d, e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e;+    get bh               = do a <- get bh+                              b <- get bh+                              c <- get bh+                              d <- get bh+                              e <- get bh+                              return (a,b,c,d,e)++instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d, e, f) where+    put_ bh (a,b,c,d, e, f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f;+    get bh                  = do a <- get bh+                                 b <- get bh+                                 c <- get bh+                                 d <- get bh+                                 e <- get bh+                                 f <- get bh+                                 return (a,b,c,d,e,f)++instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a,b,c,d,e,f,g) where+    put_ bh (a,b,c,d,e,f,g) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f; put_ bh g+    get bh                  = do a <- get bh+                                 b <- get bh+                                 c <- get bh+                                 d <- get bh+                                 e <- get bh+                                 f <- get bh+                                 g <- get bh+                                 return (a,b,c,d,e,f,g)++instance Binary a => Binary (Maybe a) where+    put_ bh Nothing  = putByte bh 0+    put_ bh (Just a) = do putByte bh 1; put_ bh a+    get bh           = do h <- getWord8 bh+                          case h of+                            0 -> return Nothing+                            _ -> do x <- get bh; return (Just x)++instance Binary a => Binary (Strict.Maybe a) where+    put_ bh Strict.Nothing = putByte bh 0+    put_ bh (Strict.Just a) = do putByte bh 1; put_ bh a+    get bh =+      do h <- getWord8 bh+         case h of+           0 -> return Strict.Nothing+           _ -> do x <- get bh; return (Strict.Just x)++instance (Binary a, Binary b) => Binary (Either a b) where+    put_ bh (Left  a) = do putByte bh 0; put_ bh a+    put_ bh (Right b) = do putByte bh 1; put_ bh b+    get bh            = do h <- getWord8 bh+                           case h of+                             0 -> do a <- get bh ; return (Left a)+                             _ -> do b <- get bh ; return (Right b)++instance Binary UTCTime where+    put_ bh u = do put_ bh (utctDay u)+                   put_ bh (utctDayTime u)+    get bh = do day <- get bh+                dayTime <- get bh+                return $ UTCTime { utctDay = day, utctDayTime = dayTime }++instance Binary Day where+    put_ bh d = put_ bh (toModifiedJulianDay d)+    get bh = do i <- get bh+                return $ ModifiedJulianDay { toModifiedJulianDay = i }++instance Binary DiffTime where+    put_ bh dt = put_ bh (toRational dt)+    get bh = do r <- get bh+                return $ fromRational r++instance Binary JoinPointHood where+    put_ bh NotJoinPoint = putByte bh 0+    put_ bh (JoinPoint ar) = do+        putByte bh 1+        put_ bh ar+    get bh = do+        h <- getByte bh+        case h of+            0 -> return NotJoinPoint+            _ -> do { ar <- get bh; return (JoinPoint ar) }++{-+Finally - a reasonable portable Integer instance.++We used to encode values in the Int32 range as such,+falling back to a string of all things. In either case+we stored a tag byte to discriminate between the two cases.++This made some sense as it's highly portable but also not very+efficient.++However GHC stores a surprisingly large number of large Integer+values. In the examples looked at between 25% and 50% of Integers+serialized were outside of the Int32 range.++Consider a value like `2724268014499746065`, some sort of hash+actually generated by GHC.+In the old scheme this was encoded as a list of 19 chars. This+gave a size of 77 Bytes, one for the length of the list and 76+since we encode chars as Word32 as well.++We can easily do better. The new plan is:++* Start with a tag byte+  * 0 => Int64 (LEB128 encoded)+  * 1 => Negative large integer+  * 2 => Positive large integer+* Followed by the value:+  * Int64 is encoded as usual+  * Large integers are encoded as a list of bytes (Word8).+    We use Data.Bits which defines a bit order independent of the representation.+    Values are stored LSB first.++This means our example value `2724268014499746065` is now only 10 bytes large.+* One byte tag+* One byte for the length of the [Word8] list.+* 8 bytes for the actual date.++The new scheme also does not depend in any way on+architecture specific details.++We still use this scheme even with LEB128 available,+as it has less overhead for truly large numbers. (> maxBound :: Int64)++The instance is used for in Binary Integer and Binary Rational in GHC.Types.Literal+-}++instance Binary Integer where+    put_ bh i+      | i >= lo64 && i <= hi64 = do+          putWord8 bh 0+          put_ bh (fromIntegral i :: Int64)+      | otherwise = do+          if i < 0+            then putWord8 bh 1+            else putWord8 bh 2+          put_ bh (unroll $ abs i)+      where+        lo64 = fromIntegral (minBound :: Int64)+        hi64 = fromIntegral (maxBound :: Int64)+    get bh = do+      int_kind <- getWord8 bh+      case int_kind of+        0 -> fromIntegral <$!> (get bh :: IO Int64)+        -- Large integer+        1 -> negate <$!> getInt+        2 -> getInt+        _ -> panic "Binary Integer - Invalid byte"+        where+          getInt :: IO Integer+          getInt = roll <$!> (get bh :: IO [Word8])++unroll :: Integer -> [Word8]+unroll = unfoldr step+  where+    step 0 = Nothing+    step i = Just (fromIntegral i, i `shiftR` 8)++roll :: [Word8] -> Integer+roll   = foldl' unstep 0 . reverse+  where+    unstep a b = a `shiftL` 8 .|. fromIntegral b+++    {-+    -- This code is currently commented out.+    -- See https://gitlab.haskell.org/ghc/ghc/issues/3379#note_104346 for+    -- discussion.++    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)+    put_ bh (J# s# a#) = do+        putByte bh 1+        put_ bh (I# s#)+        let sz# = sizeofByteArray# a#  -- in *bytes*+        put_ bh (I# sz#)  -- in *bytes*+        putByteArray bh a# sz#++    get bh = do+        b <- getByte bh+        case b of+          0 -> do (I# i#) <- get bh+                  return (S# i#)+          _ -> do (I# s#) <- get bh+                  sz <- get bh+                  (BA a#) <- getByteArray bh sz+                  return (J# s# a#)++putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()+putByteArray bh a s# = loop 0#+  where loop n#+           | n# ==# s# = return ()+           | otherwise = do+                putByte bh (indexByteArray a n#)+                loop (n# +# 1#)++getByteArray :: BinHandle -> Int -> IO ByteArray+getByteArray bh (I# sz) = do+  (MBA arr) <- newByteArray sz+  let loop n+           | n ==# sz = return ()+           | otherwise = do+                w <- getByte bh+                writeByteArray arr n w+                loop (n +# 1#)+  loop 0#+  freezeByteArray arr+    -}++{-+data ByteArray = BA ByteArray#+data MBA = MBA (MutableByteArray# RealWorld)++newByteArray :: Int# -> IO MBA+newByteArray sz = IO $ \s ->+  case newByteArray# sz s of { (# s, arr #) ->+  (# s, MBA arr #) }++freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray+freezeByteArray arr = IO $ \s ->+  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->+  (# s, BA arr #) }++writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()+writeByteArray arr i (W8# w) = IO $ \s ->+  case writeWord8Array# arr i w s of { s ->+  (# s, () #) }++indexByteArray :: ByteArray# -> Int# -> Word8+indexByteArray a# n# = W8# (indexWord8Array# a# n#)++-}+instance (Binary a) => Binary (Ratio a) where+    put_ bh (a :% b) = do put_ bh a; put_ bh b+    get bh = do a <- get bh; b <- get bh; return (a :% b)++-- Instance uses fixed-width encoding to allow inserting+-- Bin placeholders in the stream.+instance Binary (Bin a) where+  put_ bh (BinPtr i) = putWord32 bh (fromIntegral i :: Word32)+  get bh = do i <- getWord32 bh; return (BinPtr (fromIntegral (i :: Word32)))++-- Instance uses fixed-width encoding to allow inserting+-- Bin placeholders in the stream.+instance Binary (RelBinPtr a) where+  put_ bh (RelBinPtr i) = put_ bh i+  get bh = RelBinPtr <$> get bh++-- -----------------------------------------------------------------------------+-- Forward reading/writing++-- | @'forwardPut' put_A put_B@ outputs A after B but allows A to be read before B+-- by using a forward reference.+forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b)+forwardPut bh put_A put_B = do+  -- write placeholder pointer to A+  pre_a <- tellBinWriter bh+  put_ bh pre_a++  -- write B+  r_b <- put_B++  -- update A's pointer+  a <- tellBinWriter bh+  putAt bh pre_a a+  seekBinNoExpandWriter bh a++  -- write A+  r_a <- put_A r_b+  pure (r_a,r_b)++forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO ()+forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B++-- | Read a value stored using a forward reference+--+-- The forward reference is expected to be an absolute offset.+forwardGet :: ReadBinHandle -> IO a -> IO a+forwardGet bh get_A = do+    -- read forward reference+    p <- get bh -- a BinPtr+    -- store current position+    p_a <- tellBinReader bh+    -- go read the forward value, then seek back+    seekBinReader bh p+    r <- get_A+    seekBinReader bh p_a+    pure r++-- | @'forwardPutRel' put_A put_B@ outputs A after B but allows A to be read before B+-- by using a forward reference.+--+-- This forward reference is a relative offset that allows us to skip over the+-- result of 'put_A'.+forwardPutRel :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b)+forwardPutRel bh put_A put_B = do+  -- write placeholder pointer to A+  pre_a <- tellBinWriter bh+  put_ bh pre_a++  -- write B+  r_b <- put_B++  -- update A's pointer+  a <- tellBinWriter bh+  putAtRel bh pre_a a+  seekBinNoExpandWriter bh a++  -- write A+  r_a <- put_A r_b+  pure (r_a,r_b)++-- | Like 'forwardGetRel', but discard the result.+forwardPutRel_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO ()+forwardPutRel_ bh put_A put_B = void $ forwardPutRel bh put_A put_B++-- | Read a value stored using a forward reference.+--+-- The forward reference is expected to be a relative offset.+forwardGetRel :: ReadBinHandle -> IO a -> IO a+forwardGetRel bh get_A = do+    -- read forward reference+    p <- getRelBin bh+    -- store current position+    p_a <- tellBinReader bh+    -- go read the forward value, then seek back+    seekBinReader bh $ makeAbsoluteBin p+    r <- get_A+    seekBinReader bh p_a+    pure r++-- -----------------------------------------------------------------------------+-- Lazy reading/writing++lazyPut :: Binary a => WriteBinHandle -> a -> IO ()+lazyPut = lazyPut' put_++lazyGet :: Binary a => ReadBinHandle -> IO a+lazyGet = lazyGet' get++lazyPut' :: (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> a -> IO ()+lazyPut' f bh a = do+    -- output the obj with a ptr to skip over it:+    pre_a <- tellBinWriter bh+    put_ bh pre_a       -- save a slot for the ptr+    f bh a           -- dump the object+    q <- tellBinWriter bh     -- q = ptr to after object+    putAtRel bh pre_a q    -- fill in slot before a with ptr to q+    seekBinWriter bh q        -- finally carry on writing at q++lazyGet' :: (ReadBinHandle -> IO a) -> ReadBinHandle -> IO a+lazyGet' f bh = do+    p <- getRelBin bh -- a BinPtr+    p_a <- tellBinReader bh+    a <- unsafeInterleaveIO $ do+        -- NB: Use a fresh rbm_off_r variable in the child thread, for thread+        -- safety.+        off_r <- newFastMutInt 0+        let bh' = bh { rbm_off_r = off_r }+        seekBinReader bh' p_a+        f bh'+    seekBinReader bh (makeAbsoluteBin p) -- skip over the object for now+    return a++-- | Serialize the constructor strictly but lazily serialize a value inside a+-- 'Just'.+--+-- This way we can check for the presence of a value without deserializing the+-- value itself.+lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO ()+lazyPutMaybe bh Nothing  = putWord8 bh 0+lazyPutMaybe bh (Just x) = do+  putWord8 bh 1+  lazyPut bh x++-- | Deserialize a value serialized by 'lazyPutMaybe'.+lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a)+lazyGetMaybe bh = do+  h <- getWord8 bh+  case h of+    0 -> pure Nothing+    _ -> Just <$> lazyGet bh++-- -----------------------------------------------------------------------------+-- UserData+-- -----------------------------------------------------------------------------++-- Note [Binary UserData]+-- ~~~~~~~~~~~~~~~~~~~~~~+-- Information we keep around during interface file+-- serialization/deserialization. Namely we keep the functions for serializing+-- and deserializing 'Name's and 'FastString's. We do this because we actually+-- use serialization in two distinct settings,+--+-- * When serializing interface files themselves+--+-- * When computing the fingerprint of an IfaceDecl (which we computing by+--   hashing its Binary serialization)+--+-- These two settings have different needs while serializing Names:+--+-- * Names in interface files are serialized via a symbol table (see Note+--   [Symbol table representation of names] in "GHC.Iface.Binary").+--+-- * During fingerprinting a binding Name is serialized as the OccName and a+--   non-binding Name is serialized as the fingerprint of the thing they+--   represent. See Note [Fingerprinting IfaceDecls] for further discussion.+--++-- | Newtype to serialise binding names differently to non-binding 'Name'.+-- See Note [Binary UserData]+newtype BindingName = BindingName { getBindingName :: Name }+  deriving ( Eq )++simpleBindingNameWriter :: BinaryWriter Name -> BinaryWriter BindingName+simpleBindingNameWriter = coerce++simpleBindingNameReader :: BinaryReader Name -> BinaryReader BindingName+simpleBindingNameReader = coerce++-- | Existential for 'BinaryWriter' with a type witness.+data SomeBinaryWriter = forall a . SomeBinaryWriter (Refl.TypeRep a) (BinaryWriter a)++-- | Existential for 'BinaryReader' with a type witness.+data SomeBinaryReader = forall a . SomeBinaryReader (Refl.TypeRep a) (BinaryReader a)++-- | UserData required to serialise symbols for interface files.+--+-- See Note [Binary UserData]+data WriterUserData =+   WriterUserData {+      ud_writer_data :: Map SomeTypeRep SomeBinaryWriter+      -- ^ A mapping from a type witness to the 'Writer' for the associated type.+      -- This is a 'Map' because microbenchmarks indicated this is more efficient+      -- than other representations for less than ten elements.+      --+      -- Considered representations:+      --+      -- * [(TypeRep, SomeBinaryWriter)]+      -- * bytehash (on hackage)+      -- * Map TypeRep SomeBinaryWriter+   }++-- | UserData required to deserialise symbols for interface files.+--+-- See Note [Binary UserData]+data ReaderUserData =+   ReaderUserData {+      ud_reader_data :: Map SomeTypeRep SomeBinaryReader+      -- ^ A mapping from a type witness to the 'Reader' for the associated type.+      -- This is a 'Map' because microbenchmarks indicated this is more efficient+      -- than other representations for less than ten elements.+      --+      -- Considered representations:+      --+      -- * [(TypeRep, SomeBinaryReader)]+      -- * bytehash (on hackage)+      -- * Map TypeRep SomeBinaryReader+   }++mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData+mkWriterUserData caches = noWriterUserData+  { ud_writer_data = Map.fromList $ map (\cache@(SomeBinaryWriter typRep _) -> (SomeTypeRep typRep, cache)) caches+  }++mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData+mkReaderUserData caches = noReaderUserData+  { ud_reader_data = Map.fromList $ map (\cache@(SomeBinaryReader typRep _) -> (SomeTypeRep typRep, cache)) caches+  }++mkSomeBinaryWriter :: forall a . Refl.Typeable a => BinaryWriter a -> SomeBinaryWriter+mkSomeBinaryWriter cb = SomeBinaryWriter (Refl.typeRep @a) cb++mkSomeBinaryReader :: forall a . Refl.Typeable a => BinaryReader a -> SomeBinaryReader+mkSomeBinaryReader cb = SomeBinaryReader (Refl.typeRep @a) cb++newtype BinaryReader s = BinaryReader+  { getEntry :: ReadBinHandle -> IO s+  } deriving (Functor)++newtype BinaryWriter s = BinaryWriter+  { putEntry :: WriteBinHandle -> s -> IO ()+  }++mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s+mkWriter f = BinaryWriter+  { putEntry = f+  }++mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s+mkReader f = BinaryReader+  { getEntry = f+  }++-- | Find the 'BinaryReader' for the 'Binary' instance for the type identified by 'Proxy a'.+--+-- If no 'BinaryReader' has been configured before, this function will panic.+findUserDataReader :: forall a . Refl.Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a+findUserDataReader query bh =+  case Map.lookup (Refl.someTypeRep query) (ud_reader_data $ getReaderUserData bh) of+    Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (Refl.someTypeRep query)+    Just (SomeBinaryReader _ (reader :: BinaryReader x)) ->+      unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader+      -- This 'unsafeCoerce' could be written safely like this:+      --+      -- @+      --   Just (SomeBinaryReader _ (reader :: BinaryReader x)) ->+      --     case testEquality (typeRep @a) tyRep of+      --       Just Refl -> coerce @(BinaryReader x) @(BinaryReader a) reader+      --       Nothing -> panic $ "Invariant violated"+      -- @+      --+      -- But it comes at a slight performance cost and this function is used in+      -- binary serialisation hot loops, thus, we prefer the small performance boost over+      -- the additional type safety.++-- | Find the 'BinaryWriter' for the 'Binary' instance for the type identified by 'Proxy a'.+--+-- If no 'BinaryWriter' has been configured before, this function will panic.+findUserDataWriter :: forall a . Refl.Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a+findUserDataWriter query bh =+  case Map.lookup (Refl.someTypeRep query) (ud_writer_data $ getWriterUserData bh) of+    Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (Refl.someTypeRep query)+    Just (SomeBinaryWriter _ (writer :: BinaryWriter x)) ->+      unsafeCoerce @(BinaryWriter x) @(BinaryWriter a) writer+      -- This 'unsafeCoerce' could be written safely like this:+      --+      -- @+      --   Just (SomeBinaryWriter tyRep (writer :: BinaryWriter x)) ->+      --     case testEquality (typeRep @a) tyRep of+      --       Just Refl -> coerce @(BinaryWriter x) @(BinaryWriter a) writer+      --       Nothing -> panic $ "Invariant violated"+      -- @+      --+      -- But it comes at a slight performance cost and this function is used in+      -- binary serialisation hot loops, thus, we prefer the small performance boost over+      -- the additional type safety.+++noReaderUserData :: ReaderUserData+noReaderUserData = ReaderUserData+  { ud_reader_data = Map.empty+  }++noWriterUserData :: WriterUserData+noWriterUserData = WriterUserData+  { ud_writer_data = Map.empty+  }++newReadState :: (ReadBinHandle -> IO Name)   -- ^ how to deserialize 'Name's+             -> (ReadBinHandle -> IO FastString)+             -> ReaderUserData+newReadState get_name get_fs =+  mkReaderUserData+    [ mkSomeBinaryReader $ mkReader get_name+    , mkSomeBinaryReader $ mkReader @BindingName (coerce get_name)+    , mkSomeBinaryReader $ mkReader get_fs+    ]++newWriteState :: (WriteBinHandle -> Name -> IO ())+                 -- ^ how to serialize non-binding 'Name's+              -> (WriteBinHandle -> Name -> IO ())+                 -- ^ how to serialize binding 'Name's+              -> (WriteBinHandle -> FastString -> IO ())+              -> WriterUserData+newWriteState put_non_binding_name put_binding_name put_fs =+  mkWriterUserData+    [ mkSomeBinaryWriter $ mkWriter (\bh name -> put_binding_name bh (getBindingName name))+    , mkSomeBinaryWriter $ mkWriter put_non_binding_name+    , mkSomeBinaryWriter $ mkWriter put_fs+    ]++-- ----------------------------------------------------------------------------+-- Types for lookup and deduplication tables.+-- ----------------------------------------------------------------------------++-- | A 'ReaderTable' describes how to deserialise a table from disk,+-- and how to create a 'BinaryReader' that looks up values in the deduplication table.+data ReaderTable a = ReaderTable+  { getTable :: ReadBinHandle -> IO (SymbolTable a)+  -- ^ Deserialise a list of elements into a 'SymbolTable'.+  , mkReaderFromTable :: SymbolTable a -> BinaryReader a+  -- ^ Given the table from 'getTable', create a 'BinaryReader'+  -- that reads values only from the 'SymbolTable'.+  }++-- | A 'WriterTable' is an interface any deduplication table can implement to+-- describe how the table can be written to disk.+newtype WriterTable = WriterTable+  { putTable :: WriteBinHandle -> IO Int+  -- ^ Serialise a table to disk. Returns the number of written elements.+  }++-- ----------------------------------------------------------------------------+-- Common data structures for constructing and maintaining lookup tables for+-- binary serialisation and deserialisation.+-- ----------------------------------------------------------------------------++-- | The 'GenericSymbolTable' stores a mapping from already seen elements to an index.+-- If an element wasn't seen before, it is added to the mapping together with a fresh+-- index.+--+-- 'GenericSymbolTable' is a variant of a 'BinSymbolTable' that is polymorphic in the table implementation.+-- As such it can be used with any container that implements the 'TrieMap' type class.+--+-- While 'GenericSymbolTable' is similar to the 'BinSymbolTable', it supports storing tree-like+-- structures such as 'Type' and 'IfaceType' more efficiently.+--+data GenericSymbolTable m = GenericSymbolTable+  { gen_symtab_next :: !FastMutInt+  -- ^ The next index to use.+  , gen_symtab_map  :: !(IORef (m Int))+  -- ^ Given a symbol, find the symbol and return its index.+  , gen_symtab_to_write :: !(IORef [Key m])+  -- ^ Reversed list of values to write into the buffer.+  -- This is an optimisation, as it allows us to write out quickly all+  -- newly discovered values that are discovered when serialising 'Key m'+  -- to disk.+  }++-- | Initialise a 'GenericSymbolTable', initialising the index to '0'.+initGenericSymbolTable :: TrieMap m => IO (GenericSymbolTable m)+initGenericSymbolTable = do+  symtab_next <- newFastMutInt 0+  symtab_map <- newIORef emptyTM+  symtab_todo <- newIORef []+  pure $ GenericSymbolTable+        { gen_symtab_next = symtab_next+        , gen_symtab_map  = symtab_map+        , gen_symtab_to_write = symtab_todo+        }++-- | Serialise the 'GenericSymbolTable' to disk.+--+-- Since 'GenericSymbolTable' stores tree-like structures, such as 'IfaceType',+-- serialising an element can add new elements to the mapping.+-- Thus, 'putGenericSymbolTable' first serialises all values, and then checks whether any+-- new elements have been discovered. If so, repeat the loop.+putGenericSymbolTable :: forall m. (TrieMap m) => GenericSymbolTable m -> (WriteBinHandle -> Key m -> IO ()) -> WriteBinHandle -> IO Int+{-# INLINE putGenericSymbolTable #-}+putGenericSymbolTable gen_sym_tab serialiser bh = do+  putGenericSymbolTable bh+  where+    symtab_next = gen_symtab_next gen_sym_tab+    symtab_to_write = gen_symtab_to_write gen_sym_tab+    putGenericSymbolTable :: WriteBinHandle -> IO Int+    putGenericSymbolTable bh  = do+      let loop = do+            vs <- atomicModifyIORef' symtab_to_write (\a -> ([], a))+            case vs of+              [] -> readFastMutInt symtab_next+              todo -> do+                mapM_ (\n -> serialiser bh n) (reverse todo)+                loop+      snd <$>+        (forwardPutRel bh (const $ readFastMutInt symtab_next >>= put_ bh) $+          loop)++-- | Read the elements of a 'GenericSymbolTable' from disk into a 'SymbolTable'.+getGenericSymbolTable :: forall a . (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a)+getGenericSymbolTable deserialiser bh = do+  sz <- forwardGetRel bh (get bh) :: IO Int+  mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a)+  forM_ [0..(sz-1)] $ \i -> do+    f <- deserialiser bh+    writeArray mut_arr i f+  unsafeFreeze mut_arr++-- | Write an element 'Key m' to the given 'WriteBinHandle'.+--+-- If the element was seen before, we simply write the index of that element to the+-- 'WriteBinHandle'. If we haven't seen it before, we add the element to+-- the 'GenericSymbolTable', increment the index, and return this new index.+putGenericSymTab :: (TrieMap m) => GenericSymbolTable m -> WriteBinHandle -> Key m -> IO ()+{-# INLINE putGenericSymTab #-}+putGenericSymTab GenericSymbolTable{+               gen_symtab_map = symtab_map_ref,+               gen_symtab_next = symtab_next,+               gen_symtab_to_write = symtab_todo }+        bh val = do+  symtab_map <- readIORef symtab_map_ref+  case lookupTM val symtab_map of+    Just off -> put_ bh (fromIntegral off :: Word32)+    Nothing -> do+      off <- readFastMutInt symtab_next+      writeFastMutInt symtab_next (off+1)+      writeIORef symtab_map_ref+          $! insertTM val off symtab_map+      atomicModifyIORef symtab_todo (\todo -> (val : todo, ()))+      put_ bh (fromIntegral off :: Word32)++-- | Read a value from a 'SymbolTable'.+getGenericSymtab :: Binary a => SymbolTable a -> ReadBinHandle -> IO a+getGenericSymtab symtab bh = do+  i :: Word32 <- get bh+  return $! symtab ! fromIntegral i++---------------------------------------------------------+-- The Dictionary+---------------------------------------------------------++-- | A 'SymbolTable' of 'FastString's.+type Dictionary = SymbolTable FastString++initFastStringReaderTable :: IO (ReaderTable FastString)+initFastStringReaderTable = do+  return $+    ReaderTable+      { getTable = getDictionary+      , mkReaderFromTable = \tbl -> mkReader (getDictFastString tbl)+      }++initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString)+initFastStringWriterTable = do+  dict_next_ref <- newFastMutInt 0+  dict_map_ref <- newIORef emptyUFM+  let bin_dict =+        FSTable+          { fs_tab_next = dict_next_ref+          , fs_tab_map = dict_map_ref+          }+  let put_dict bh = do+        fs_count <- readFastMutInt dict_next_ref+        dict_map <- readIORef dict_map_ref+        putDictionary bh fs_count dict_map+        pure fs_count++  return+    ( WriterTable+        { putTable = put_dict+        }+    , mkWriter $ putDictFastString bin_dict+    )++putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO ()+putDictionary bh sz dict = do+  put_ bh sz+  mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict)))+    -- It's OK to use nonDetEltsUFM here because the elements have indices+    -- that array uses to create order++getDictionary :: ReadBinHandle -> IO Dictionary+getDictionary bh = do+  sz <- get bh :: IO Int+  mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString)+  forM_ [0..(sz-1)] $ \i -> do+    fs <- getFS bh+    writeArray mut_arr i fs+  unsafeFreeze mut_arr++getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString+getDictFastString dict bh = do+    j <- get bh+    return $! (dict ! fromIntegral (j :: Word32))++putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO ()+putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh++allocateFastString :: FSTable -> FastString -> IO Word32+allocateFastString FSTable { fs_tab_next = j_r+                           , fs_tab_map  = out_r+                           } f = do+    out <- readIORef out_r+    let !uniq = getUnique f+    case lookupUFM_Directly out uniq of+        Just (j, _)  -> return (fromIntegral j :: Word32)+        Nothing -> do+           j <- readFastMutInt j_r+           writeFastMutInt j_r (j + 1)+           writeIORef out_r $! addToUFM_Directly out uniq (j, f)+           return (fromIntegral j :: Word32)++-- FSTable is an exact copy of Haddock.InterfaceFile.BinDictionary. We rename to+-- avoid a collision and copy to avoid a dependency.+data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use+                       , fs_tab_map  :: !(IORef (UniqFM FastString (Int,FastString)))+                                -- indexed by FastString+  }+++---------------------------------------------------------+-- The Symbol Table+---------------------------------------------------------++-- | Symbols that are read from disk.+-- The 'SymbolTable' index starts on '0'.+type SymbolTable a = Array Int a++---------------------------------------------------------+-- Reading and writing FastStrings+---------------------------------------------------------++putFS :: WriteBinHandle -> FastString -> IO ()+putFS bh fs = putBS bh $ bytesFS fs++getFS :: ReadBinHandle -> IO FastString+getFS bh = do+  l  <- get bh :: IO Int+  getPrim bh l (\src -> pure $! mkFastStringBytes src l )++-- | Put a ByteString without its length (can't be read back without knowing the+-- length!)+putByteString :: WriteBinHandle -> ByteString -> IO ()+putByteString bh bs =+  BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do+    putPrim bh l (\op -> copyBytes op (castPtr ptr) l)++-- | Get a ByteString whose length is known+getByteString :: ReadBinHandle -> Int -> IO ByteString+getByteString bh l =+  BS.create l $ \dest -> do+    getPrim bh l (\src -> copyBytes dest src l)++putBS :: WriteBinHandle -> ByteString -> IO ()+putBS bh bs =+  BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do+    put_ bh l+    putPrim bh l (\op -> copyBytes op (castPtr ptr) l)++getBS :: ReadBinHandle -> IO ByteString+getBS bh = do+  l <- get bh :: IO Int+  BS.create l $ \dest -> do+    getPrim bh l (\src -> copyBytes dest src l)++instance Binary ByteString where+  put_ bh f = putBS bh f+  get bh = getBS bh++instance Binary FastString where+  put_ bh f =+    case findUserDataWriter (Proxy :: Proxy FastString) bh of+      tbl -> putEntry tbl bh f++  get bh =+    case findUserDataReader (Proxy :: Proxy FastString) bh of+      tbl -> getEntry tbl bh  deriving instance Binary NonDetFastString deriving instance Binary LexicalFastString
compiler/GHC/Utils/Binary/Typeable.hs view
@@ -35,7 +35,7 @@     get bh =         mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep+getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do     tag <- get bh :: IO Word8     case tag of@@ -167,7 +167,7 @@           2 -> pure TypeLitChar           _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO ()+putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common   | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type)   = put_ bh (0 :: Word8)
compiler/GHC/Utils/FV.hs view
@@ -21,6 +21,7 @@         delFVs,         filterFV,         mapUnionFV,+        fvDVarSetSome,     ) where  import GHC.Prelude@@ -195,3 +196,7 @@ mkFVs vars fv_cand in_scope acc =   mapUnionFV unitFV vars fv_cand in_scope acc {-# INLINE mkFVs #-}++fvDVarSetSome :: InterestingVarFun -> FV -> DVarSet+fvDVarSetSome interesting_var fv =+  mkDVarSet $ fst $ fv interesting_var emptyVarSet ([], emptyVarSet)
compiler/GHC/Utils/Misc.hs view
@@ -23,7 +23,7 @@          dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, -        List.foldl1', foldl2, count, countWhile, all2,+        List.foldl1', foldl2, count, countWhile, all2, any2,          lengthExceeds, lengthIs, lengthIsNot,         lengthAtLeast, lengthAtMost, lengthLessThan,@@ -488,7 +488,7 @@ -- | Extract the single element of a list and panic with the given message if -- there are more elements or the list was empty. -- Like 'expectJust', but for lists.-expectOnly :: HasCallStack => String -> [a] -> a+expectOnly :: HasDebugCallStack => String -> [a] -> a {-# INLINE expectOnly #-} #if defined(DEBUG) expectOnly _   [a]   = a@@ -511,7 +511,7 @@ changeLast (x:xs) x' = x : changeLast xs x'  -- | Like @expectJust msg . nonEmpty@; a better alternative to 'NE.fromList'.-expectNonEmpty :: HasCallStack => String -> [a] -> NonEmpty a+expectNonEmpty :: HasDebugCallStack => String -> [a] -> NonEmpty a {-# INLINE expectNonEmpty #-} expectNonEmpty _   (x:xs) = x:|xs expectNonEmpty msg []     = expectNonEmptyPanic msg@@ -651,6 +651,12 @@ all2 _ []     []     = True all2 p (x:xs) (y:ys) = p x y && all2 p xs ys all2 _ _      _      = False++any2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool+-- True if any of the corresponding elements satisfy the predicate+-- Unlike `all2`, this ignores excess elements of the other list+any2 p (x:xs) (y:ys) = p x y || any2 p xs ys+any2 _ _      _      = False  -- Count the number of times a predicate is true
compiler/GHC/Utils/Monad.hs view
@@ -18,7 +18,7 @@         , concatMapM         , mapMaybeM         , anyM, allM, orM-        , foldlM, foldlM_, foldrM+        , foldlM, foldlM_, foldrM, foldMapM         , whenM, unlessM         , filterOutM         , partitionM@@ -37,6 +37,7 @@ import Data.Foldable (sequenceA_, foldlM, foldrM) import Data.List (unzip4, unzip5, zipWith4) import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid (Ap (Ap, getAp)) import Data.Tuple (swap)  -------------------------------------------------------------------------------@@ -227,6 +228,10 @@ -- | Monadic version of foldl that discards its result foldlM_ :: (Monad m, Foldable t) => (a -> b -> m a) -> a -> t b -> m () foldlM_ = foldM_++-- | Monadic version of 'foldMap'+foldMapM :: (Applicative m, Foldable t, Monoid b) => (a -> m b) -> t a -> m b+foldMapM f = getAp <$> foldMap (Ap . f)  -- | Monadic version of @when@, taking the condition in the monad whenM :: Monad m => m Bool -> m () -> m ()
compiler/GHC/Utils/Monad/State/Strict.hs view
@@ -4,7 +4,7 @@ -- | A state monad which is strict in its state. module GHC.Utils.Monad.State.Strict   ( -- * The State monad-    State(State)+    State(State, State' {- for deriving via purposes only -})   , state   , evalState   , execState@@ -78,8 +78,10 @@ forceState :: (# a, s #) -> (# a, s #) forceState (# a, !s #) = (# a, s #) +-- See Note [The one-shot state monad trick] for why we don't derive this. instance Functor (State s) where   fmap f m = State $ \s -> case runState' m s  of (# x, s' #) -> (# f x, s' #)+  {-# INLINE fmap #-}  instance Applicative (State s) where   pure x  = State $ \s -> (# x, s #)@@ -87,10 +89,20 @@     case runState' m s  of { (# f, s' #) ->     case runState' n s' of { (# x, s'' #) ->                              (# f x, s'' #) }}+  m *> n = State $ \s ->+    case runState' m s of { (# _, s' #) ->+    case runState' n s' of { (# x, s'' #) ->+                             (# x, s'' #) }}+  {-# INLINE pure #-}+  {-# INLINE (<*>) #-}+  {-# INLINE (*>) #-}  instance Monad (State s) where   m >>= n = State $ \s -> case runState' m s of     (# r, !s' #) -> runState' (n r) s'+  (>>) = (*>)+  {-# INLINE (>>=) #-}+  {-# INLINE (>>) #-}  state :: (s -> (a, s)) -> State s a state f = State $ \s -> case f s of (r, s') -> (# r, s' #)
compiler/GHC/Utils/Outputable.hs view
@@ -32,7 +32,8 @@         SDoc, runSDoc, PDoc(..),         docToSDoc,         interppSP, interpp'SP, interpp'SP',-        pprQuotedList, pprWithCommas,+        pprQuotedList, pprWithCommas, pprWithSemis,+        unquotedListWith,         quotedListWithOr, quotedListWithNor, quotedListWithAnd,         pprWithBars,         spaceIfSingleQuote,@@ -131,7 +132,7 @@ import GHC.Serialized import GHC.LanguageExtensions (Extension) import GHC.Utils.GlobalVars( unsafeHasPprDebug )-import GHC.Utils.Misc (lastMaybe)+import GHC.Utils.Misc (lastMaybe, snocView)  import Data.ByteString (ByteString) import qualified Data.ByteString as BS@@ -141,6 +142,7 @@ import qualified Data.IntMap as IM import Data.Set (Set) import qualified Data.Set as Set+import qualified Data.IntSet as IntSet import qualified GHC.Data.Word64Set as Word64Set import Data.String import Data.Word@@ -990,6 +992,9 @@ instance Outputable Word64Set.Word64Set where     ppr s = braces (pprWithCommas ppr (Word64Set.toList s)) +instance Outputable IntSet.IntSet where+    ppr s = braces (pprWithCommas ppr (IntSet.toList s))+ instance (Outputable a, Outputable b) => Outputable (a, b) where     ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) @@ -1199,6 +1204,9 @@ instance OutputableP env a => OutputableP env (Maybe a) where    pdoc env xs = ppr (fmap (pdoc env) xs) +instance OutputableP env () where+   pdoc _ _ = ppr ()+ instance (OutputableP env a, OutputableP env b) => OutputableP env (a, b) where     pdoc env (a,b) = ppr (pdoc env a, pdoc env b) @@ -1389,6 +1397,12 @@                              -- comma-separated and finally packed into a paragraph. pprWithCommas pp xs = fsep (punctuate comma (map pp xs)) +pprWithSemis :: (a -> SDoc) -- ^ The pretty printing function to use+              -> [a]         -- ^ The things to be pretty printed+              -> SDoc        -- ^ 'SDoc' where the things have been pretty printed,+                             -- semicolon-separated and finally packed into a paragraph.+pprWithSemis pp xs = fsep (punctuate semi (map pp xs))+ pprWithBars :: (a -> SDoc) -- ^ The pretty printing function to use             -> [a]         -- ^ The things to be pretty printed             -> SDoc        -- ^ 'SDoc' where the things have been pretty printed,@@ -1439,6 +1453,15 @@ -- [x,y,z]  ==>  `x', `y' and `z' quotedListWithAnd xs@(_:_:_) = quotedList (init xs) <+> text "and" <+> quotes (last xs) quotedListWithAnd xs = quotedList xs+++unquotedListWith :: SDoc -> [SDoc] -> SDoc+-- "whatever" [x,y,z] ==> x, y whatever z+unquotedListWith d xs+  | Just (fs@(_:_), l) <- snocView xs = unquotedList fs <+> d <+> l+  | otherwise                         = unquotedList xs+  where+    unquotedList = fsep . punctuate comma  {- ************************************************************************
compiler/GHC/Utils/Panic/Plain.hs view
@@ -99,12 +99,7 @@  -- | Panics and asserts. panic, sorry, pgmError :: HasCallStack => String -> a-panic    x = unsafeDupablePerformIO $ do-   stack <- ccsToStrings =<< getCurrentCCS x-   let doc = unlines $ fmap ("  "++) $ lines (prettyCallStack callStack)-   if null stack-      then throwPlainGhcException (PlainPanic (x ++ '\n' : doc))-      else throwPlainGhcException (PlainPanic (x ++ '\n' : renderStack stack))+panic    x = unsafeDupablePerformIO $ throwPlainGhcException (PlainPanic x)  sorry    x = throwPlainGhcException (PlainSorry x) pgmError x = throwPlainGhcException (PlainProgramError x)@@ -113,11 +108,7 @@ cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO  cmdLineErrorIO :: String -> IO a-cmdLineErrorIO x = do-  stack <- ccsToStrings =<< getCurrentCCS x-  if null stack-    then throwPlainGhcException (PlainCmdLineError x)-    else throwPlainGhcException (PlainCmdLineError (x ++ '\n' : renderStack stack))+cmdLineErrorIO x = throwPlainGhcException (PlainCmdLineError x)  -- | Throw a failed assertion exception for a given filename and line number. assertPanic :: String -> Int -> a@@ -127,12 +118,7 @@   assertPanic' :: HasCallStack => a-assertPanic' =-  let doc = unlines $ fmap ("  "++) $ lines (prettyCallStack callStack)-  in-  Exception.throw (Exception.AssertionFailed-           ("ASSERT failed!\n"-            ++ withFrozenCallStack doc))+assertPanic' = Exception.throw (Exception.AssertionFailed "ASSERT failed!")  assert :: HasCallStack => Bool -> a -> a {-# INLINE assert #-}
compiler/GHC/Utils/TmpFs.hs view
@@ -64,6 +64,8 @@       --       -- Shared with forked TmpFs. +  , tmp_dir_prefix :: String+   , tmp_files_to_clean :: IORef PathsToClean       -- ^ Files to clean (per session or per module)       --@@ -121,6 +123,7 @@         , tmp_subdirs_to_clean = subdirs         , tmp_dirs_to_clean    = dirs         , tmp_next_suffix      = next+        , tmp_dir_prefix       = "tmp"         }  -- | Initialise an empty TmpFs sharing unique numbers and per-process temporary@@ -132,11 +135,16 @@ forkTmpFsFrom old = do     files <- newIORef emptyPathsToClean     subdirs <- newIORef emptyPathsToClean+    counter <- newIORef 0+    prefix  <- newTempSuffix old++     return $ TmpFs         { tmp_files_to_clean   = files         , tmp_subdirs_to_clean = subdirs         , tmp_dirs_to_clean    = tmp_dirs_to_clean old-        , tmp_next_suffix      = tmp_next_suffix old+        , tmp_next_suffix      = counter+        , tmp_dir_prefix       = prefix         }  -- | Merge the first TmpFs into the second.@@ -259,10 +267,12 @@   addFilesToClean tmpfs lifetime existing_files  -- Return a unique numeric temp file suffix-newTempSuffix :: TmpFs -> IO Int-newTempSuffix tmpfs =-  atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n)+newTempSuffix :: TmpFs -> IO String+newTempSuffix tmpfs = do+  n <- atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n)+  return $ tmp_dir_prefix tmpfs ++ "_" ++ show n + -- Find a temporary name that doesn't already exist. newTempName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO FilePath newTempName logger tmpfs tmp_dir lifetime extn@@ -271,8 +281,8 @@   where     findTempName :: FilePath -> IO FilePath     findTempName prefix-      = do n <- newTempSuffix tmpfs-           let filename = prefix ++ show n <.> extn+      = do suffix <- newTempSuffix tmpfs+           let filename = prefix ++ suffix <.> extn            b <- doesFileExist filename            if b then findTempName prefix                 else do -- clean it up later@@ -295,8 +305,8 @@   where     findTempDir :: FilePath -> IO FilePath     findTempDir prefix-      = do n <- newTempSuffix tmpfs-           let name = prefix ++ show n+      = do suffix <- newTempSuffix tmpfs+           let name = prefix ++ suffix            b <- doesDirectoryExist name            if b then findTempDir prefix                 else (do@@ -314,8 +324,8 @@   where     findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)     findTempName dir prefix-      = do n <- newTempSuffix tmpfs -- See Note [Deterministic base name]-           let libname = prefix ++ show n+      = do suffix <- newTempSuffix tmpfs -- See Note [Deterministic base name]+           let libname = prefix ++ suffix                filename = dir </> "lib" ++ libname <.> extn            b <- doesFileExist filename            if b then findTempName dir prefix@@ -340,8 +350,8 @@      mkTempDir :: FilePath -> IO FilePath     mkTempDir prefix = do-        n <- newTempSuffix tmpfs-        let our_dir = prefix ++ show n+        suffix <- newTempSuffix tmpfs+        let our_dir = prefix ++ suffix          -- 1. Speculatively create our new directory.         createDirectory our_dir@@ -376,6 +386,11 @@ the process id).  This is ok, as the temporary directory used contains the pid (see getTempDir).++In addition to this, multiple threads can race against each other creating temporary+files. Therefore we supply a prefix when creating temporary files, when a thread is+forked, each thread must be given an TmpFs with a unique prefix. This is achieved+by forkTmpFsFrom creating a fresh prefix from the parent TmpFs. -}  manyWithTrace :: Logger -> String -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
compiler/GHC/Utils/Word64.hs view
@@ -6,14 +6,14 @@  import GHC.Prelude import GHC.Utils.Panic.Plain (assert)+import GHC.Utils.Misc (HasDebugCallStack)  import Data.Word-import GHC.Stack -intToWord64 :: HasCallStack => Int -> Word64+intToWord64 :: HasDebugCallStack => Int -> Word64 intToWord64 x = assert (0 <= x) (fromIntegral x) -word64ToInt :: HasCallStack => Word64 -> Int+word64ToInt :: HasDebugCallStack => Word64 -> Int word64ToInt x = assert (x <= fromIntegral (maxBound :: Int)) (fromIntegral x)  truncateWord64ToWord32 :: Word64 -> Word32
compiler/Language/Haskell/Syntax.hs view
@@ -66,16 +66,7 @@ -- -- All we actually declare here is the top-level structure for a module. data HsModule p-  =  -- | 'GHC.Parser.Annotation.AnnKeywordId's-     ---     --  - 'GHC.Parser.Annotation.AnnModule','GHC.Parser.Annotation.AnnWhere'-     ---     --  - 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnSemi',-     --    'GHC.Parser.Annotation.AnnClose' for explicit braces and semi around-     --    hsmodImports,hsmodDecls if this style is used.--     -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-    HsModule {+    = HsModule {       hsmodExt :: XCModule p,         -- ^ HsModule extension point       hsmodName :: Maybe (XRec p ModuleName),@@ -89,15 +80,8 @@         --  - @Just []@: export /nothing/         --         --  - @Just [...]@: as you would expect...-        ---        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'-        --                                   ,'GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation       hsmodImports :: [LImportDecl p],       hsmodDecls :: [LHsDecl p]         -- ^ Type, class, value, and interface signature decls    }   | XModule !(XXModule p)-
compiler/Language/Haskell/Syntax/Basic.hs view
@@ -81,6 +81,24 @@ ************************************************************************ -} +-- | Haskell Bang+--+-- Bangs on data constructor arguments written by the user.+--+-- @(HsBang SrcUnpack SrcLazy)@ and+-- @(HsBang SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we+-- emit a warning (in checkValidDataCon) and treat it like+-- @(HsBang NoSrcUnpack SrcLazy)@+--+-- 'GHC.Core.DataCon.HsSrcBang' is a wrapper around this, associating it with+-- a 'GHC.Types.SourceText.SourceText' as written by the user.+-- In the AST, the @SourceText@ is hidden inside the extension point+-- 'Language.Haskell.Syntax.Extension.XBangTy'.+data HsBang =+  HsBang SrcUnpackedness+         SrcStrictness+  deriving Data+ -- | Source Strictness -- -- What strictness annotation the user wrote@@ -96,3 +114,25 @@                      | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified                      | NoSrcUnpack -- ^ no unpack pragma      deriving (Eq, Data)++{-+************************************************************************+*                                                                      *+Fixity+*                                                                      *+************************************************************************+-}++-- | Captures the fixity of declarations as they are parsed. This is not+-- necessarily the same as the fixity declaration, as the normal fixity may be+-- overridden using parens or backticks.+data LexicalFixity = Prefix | Infix deriving (Eq, Data)++data FixityDirection+   = InfixL+   | InfixR+   | InfixN+   deriving (Eq, Data)++data Fixity = Fixity Int FixityDirection+  deriving (Eq, Data)
compiler/Language/Haskell/Syntax/Binds.hs view
@@ -33,7 +33,6 @@ import Language.Haskell.Syntax.Type  import GHC.Types.Fixity (Fixity)-import GHC.Data.Bag (Bag) import GHC.Types.Basic (InlinePragma)  import GHC.Data.BooleanFormula (LBooleanFormula)@@ -128,7 +127,7 @@ type HsBind   id = HsBindLR   id id  -- | Located Haskell Bindings with separate Left and Right identifier types-type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)+type LHsBindsLR idL idR = [LHsBindLR idL idR]  -- | Located Haskell Binding with separate Left and Right identifier types type LHsBindLR  idL idR = XRec idL (HsBindLR idL idR)@@ -204,15 +203,6 @@     -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their     -- 'MatchContext'. See Note [FunBind vs PatBind] for     -- details about the relationship between FunBind and PatBind.-    ---    --  'GHC.Parser.Annotation.AnnKeywordId's-    ---    --  - 'GHC.Parser.Annotation.AnnFunId', attached to each element of fun_matches-    ---    --  - 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',-    --    'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation     FunBind {          fun_ext :: XFunBind idL idR,@@ -229,13 +219,6 @@   -- That case is done by FunBind.   -- See Note [FunBind vs PatBind] for details about the   -- relationship between FunBind and PatBind.--  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang',-  --       'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',-  --       'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | PatBind {         pat_ext    :: XPatBind idL idR,         pat_lhs    :: LPat idL,@@ -258,23 +241,10 @@   | PatSynBind         (XPatSynBind idL idR)         (PatSynBind idL idR)-        -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',-        --          'GHC.Parser.Annotation.AnnLarrow','GHC.Parser.Annotation.AnnEqual',-        --          'GHC.Parser.Annotation.AnnWhere'-        --          'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@ -        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | XHsBindsLR !(XXHsBindsLR idL idR)  --- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',---             'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnLarrow',---             'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen' @'{'@,---             'GHC.Parser.Annotation.AnnClose' @'}'@,---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | Pattern Synonym binding data PatSynBind idL idR   = PSB { psb_ext  :: XPSB idL idR,@@ -319,16 +289,8 @@  -- | Located Implicit Parameter Binding type LIPBind id = XRec id (IPBind id)--- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a---   list --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | Implicit parameter bindings.------ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data IPBind id   = IPBind         (XCIPBind id)@@ -365,11 +327,6 @@       -- fresh meta vars in the type. Their names are stored in the type       -- signature that brought them into scope, in this third field to be       -- more specific.-      ---      --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon',-      --          'GHC.Parser.Annotation.AnnComma'--      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation     TypeSig        (XTypeSig pass)        [LIdP pass]           -- LHS of the signature; e.g.  f,g,h :: blah@@ -378,12 +335,6 @@       -- | A pattern synonym type signature       --       -- > pattern Single :: () => (Show a) => a -> [a]-      ---      --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',-      --           'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnForall'-      --           'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'--      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | PatSynSig (XPatSynSig pass) [LIdP pass] (LHsSigType pass)       -- P :: forall a b. Req => Prov => ty @@ -394,33 +345,16 @@       --          op :: a -> a                   -- Ordinary       --          default op :: Eq a => a -> a   -- Generic default       -- No wildcards allowed here-      ---      --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault',-      --           'GHC.Parser.Annotation.AnnDcolon'   | ClassOpSig (XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass)          -- | An ordinary fixity declaration         --         -- >     infixl 8 ***-        ---        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInfix',-        --           'GHC.Parser.Annotation.AnnVal'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | FixSig (XFixSig pass) (FixitySig pass)          -- | An inline pragma         --         -- > {#- INLINE f #-}-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' :-        --       'GHC.Parser.Annotation.AnnOpen' @'{-\# INLINE'@ and @'['@,-        --       'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnOpen',-        --       'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnTilde',-        --       'GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | InlineSig   (XInlineSig pass)                 (LIdP pass)        -- Function name                 InlinePragma       -- Never defaultInlinePragma@@ -428,15 +362,6 @@         -- | A specialisation pragma         --         -- > {-# SPECIALISE f :: Int -> Int #-}-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-        --      'GHC.Parser.Annotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,-        --      'GHC.Parser.Annotation.AnnTilde',-        --      'GHC.Parser.Annotation.AnnVal',-        --      'GHC.Parser.Annotation.AnnClose' @']'@ and @'\#-}'@,-        --      'GHC.Parser.Annotation.AnnDcolon'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | SpecSig     (XSpecSig pass)                 (LIdP pass)        -- Specialise a function or datatype  ...                 [LHsSigType pass]  -- ... to these types@@ -450,22 +375,11 @@         --         -- (Class tys); should be a specialisation of the         -- current instance declaration-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-        --      'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | SpecInstSig (XSpecInstSig pass) (LHsSigType pass)          -- | A minimal complete definition pragma         --         -- > {-# MINIMAL a | (b, c | (d | e)) #-}-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-        --      'GHC.Parser.Annotation.AnnVbar','GHC.Parser.Annotation.AnnComma',-        --      'GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | MinimalSig (XMinimalSig pass) (LBooleanFormula (LIdP pass))          -- | A "set cost centre" pragma for declarations
compiler/Language/Haskell/Syntax/Decls.hs view
@@ -98,19 +98,19 @@ import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Type import Language.Haskell.Syntax.Basic (Role)+import Language.Haskell.Syntax.Specificity (Specificity)  import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation                        ,TyConFlavour(..), TypeOrData(..)) import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec) import GHC.Types.Fixity (LexicalFixity) -import GHC.Core.Type (Specificity) import GHC.Unit.Module.Warnings (WarningTxt)-import GHC.Utils.Panic.Plain ( assert )  import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST  import Control.Monad+import Control.Exception (assert) import Data.Data        hiding (TyCon, Fixity, Infix) import Data.Void import Data.Maybe@@ -135,12 +135,7 @@  type LHsDecl p = XRec p (HsDecl p)         -- ^ When in a list this may have-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'-        -- --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | A Haskell Declaration data HsDecl p   = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration@@ -407,24 +402,9 @@ -- | A type or class declaration. data TyClDecl pass   = -- | @type/data family T :: *->*@-    ---    --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',-    --             'GHC.Parser.Annotation.AnnData',-    --             'GHC.Parser.Annotation.AnnFamily','GHC.Parser.Annotation.AnnDcolon',-    --             'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpenP',-    --             'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnCloseP',-    --             'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnRarrow',-    --             'GHC.Parser.Annotation.AnnVbar'--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation     FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }    | -- | @type@ declaration-    ---    --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',-    --             'GHC.Parser.Annotation.AnnEqual',--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation     SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renamer, FVs             , tcdLName  :: LIdP pass              -- ^ Type constructor             , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an@@ -434,14 +414,6 @@             , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration    | -- | @data@ declaration-    ---    --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnData',-    --              'GHC.Parser.Annotation.AnnFamily',-    --              'GHC.Parser.Annotation.AnnNewType',-    --              'GHC.Parser.Annotation.AnnNewType','GHC.Parser.Annotation.AnnDcolon'-    --              'GHC.Parser.Annotation.AnnWhere',--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation     DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs              , tcdLName    :: LIdP pass             -- ^ Type constructor              , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables@@ -449,13 +421,6 @@              , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration              , tcdDataDefn :: HsDataDefn pass } -    -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnClass',-    --           'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen',-    --           'GHC.Parser.Annotation.AnnClose'-    --   - The tcdFDs will have 'GHC.Parser.Annotation.AnnVbar',-    --                          'GHC.Parser.Annotation.AnnComma'-    --                          'GHC.Parser.Annotation.AnnRarrow'-    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs                 tcdCtxt    :: Maybe (LHsContext pass), -- ^ Context...                 tcdLName   :: LIdP pass,               -- ^ Name of the class@@ -790,24 +755,10 @@ -- | type Family Result Signature data FamilyResultSig pass = -- see Note [FamilyResultSig]     NoSig (XNoSig pass)-  -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | KindSig  (XCKindSig pass) (LHsKind pass)-  -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :-  --             'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon',-  --             'GHC.Parser.Annotation.AnnCloseP'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | TyVarSig (XTyVarSig pass) (LHsTyVarBndr () pass)-  -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :-  --             'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon',-  --             'GHC.Parser.Annotation.AnnCloseP', 'GHC.Parser.Annotation.AnnEqual'   | XFamilyResultSig !(XXFamilyResultSig pass) -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   -- | Located type Family Declaration@@ -826,16 +777,7 @@   , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann   }   | XFamilyDecl !(XXFamilyDecl pass)-  -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',-  --             'GHC.Parser.Annotation.AnnData', 'GHC.Parser.Annotation.AnnFamily',-  --             'GHC.Parser.Annotation.AnnWhere', 'GHC.Parser.Annotation.AnnOpenP',-  --             'GHC.Parser.Annotation.AnnDcolon', 'GHC.Parser.Annotation.AnnCloseP',-  --             'GHC.Parser.Annotation.AnnEqual', 'GHC.Parser.Annotation.AnnRarrow',-  --             'GHC.Parser.Annotation.AnnVbar' -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-- -- | Located Injectivity Annotation type LInjectivityAnn pass = XRec pass (InjectivityAnn pass) @@ -850,10 +792,6 @@ data InjectivityAnn pass   = InjectivityAnn (XCInjectivityAnn pass)                    (LIdP pass) [LIdP pass]-  -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :-  --             'GHC.Parser.Annotation.AnnRarrow', 'GHC.Parser.Annotation.AnnVbar'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | XInjectivityAnn !(XXInjectivityAnn pass)  data FamilyInfo pass@@ -939,11 +877,6 @@ type LHsDerivingClause pass = XRec pass (HsDerivingClause pass)  -- | A single @deriving@ clause of a data declaration.------  - 'GHC.Parser.Annotation.AnnKeywordId' :---       'GHC.Parser.Annotation.AnnDeriving', 'GHC.Parser.Annotation.AnnStock',---       'GHC.Parser.Annotation.AnnAnyClass', 'GHC.Parser.Annotation.AnnNewtype',---       'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose' data HsDerivingClause pass   -- See Note [Deriving strategies] in GHC.Tc.Deriv   = HsDerivingClause@@ -1045,11 +978,7 @@  -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass)-      -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when-      --   in a GADT constructor list -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | -- -- @@@ -1065,15 +994,7 @@ -- data T a where --      Int `MkT` Int :: T Int -- @------ - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',---            'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnCLose',---            'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnVbar',---            'GHC.Parser.Annotation.AnnDarrow','GHC.Parser.Annotation.AnnDarrow',---            'GHC.Parser.Annotation.AnnForall','GHC.Parser.Annotation.AnnDot' --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | data Constructor Declaration data ConDecl pass   = ConDeclGADT@@ -1280,11 +1201,7 @@  -- | Located Type Family Instance Equation type LTyFamInstEqn pass = XRec pass (TyFamInstEqn pass)-  -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'-  --   when in a list --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | HsFamEqnPats represents patterns on the left-hand side of a type instance, -- e.g. `type instance F @k (a :: k) = a` has patterns `@k` and `(a :: k)`. --@@ -1343,11 +1260,6 @@ data TyFamInstDecl pass   = TyFamInstDecl { tfid_xtn :: XCTyFamInstDecl pass                   , tfid_eqn :: TyFamInstEqn pass }-    -- ^-    --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',-    --           'GHC.Parser.Annotation.AnnInstance',--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | XTyFamInstDecl !(XXTyFamInstDecl pass)  ----------------- Data family instances -------------@@ -1358,15 +1270,7 @@ -- | Data Family Instance Declaration newtype DataFamInstDecl pass   = DataFamInstDecl { dfid_eqn :: FamEqn pass (HsDataDefn pass) }-    -- ^-    --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnData',-    --           'GHC.Parser.Annotation.AnnNewType','GHC.Parser.Annotation.AnnInstance',-    --           'GHC.Parser.Annotation.AnnDcolon'-    --           'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen',-    --           'GHC.Parser.Annotation.AnnClose' -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- ----------------- Family instances (common types) -------------  -- | Family Equation@@ -1384,22 +1288,14 @@        , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration        , feqn_rhs    :: rhs        }-    -- ^-    --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'   | XFamEqn !(XXFamEqn pass rhs) -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- ----------------- Class instances -------------  -- | Located Class Instance Declaration type LClsInstDecl pass = XRec pass (ClsInstDecl pass)  -- | Class Instance Declaration---  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInstance',---           'GHC.Parser.Annotation.AnnWhere',---           'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',--- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data ClsInstDecl pass   = ClsInstDecl       { cid_ext     :: XCClsInstDecl pass@@ -1411,10 +1307,6 @@       , cid_tyfam_insts   :: [LTyFamInstDecl pass]   -- Type family instances       , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances       , cid_overlap_mode  :: Maybe (XRec pass OverlapMode)-         -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-         --                                    'GHC.Parser.Annotation.AnnClose',--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation       }   | XClsInstDecl !(XXClsInstDecl pass) @@ -1464,12 +1356,6 @@          , deriv_strategy     :: Maybe (LDerivStrategy pass)         , deriv_overlap_mode :: Maybe (XRec pass OverlapMode)-         -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDeriving',-         --        'GHC.Parser.Annotation.AnnInstance', 'GHC.Parser.Annotation.AnnStock',-         --        'GHC.Parser.Annotation.AnnAnyClass', 'GHC.Parser.Annotation.AnnNewtype',-         --        'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation         }   | XDerivDecl !(XXDerivDecl pass) @@ -1505,22 +1391,18 @@ \subsection[DefaultDecl]{A @default@ declaration} *                                                                      * ************************************************************************--There can only be one default declaration per module, but it is hard-for the parser to check that; we pass them all through in the abstract-syntax, and that restriction must be checked in the front end. -}  -- | Located Default Declaration type LDefaultDecl pass = XRec pass (DefaultDecl pass) +-- See Note [Named default declarations] in GHC.Tc.Gen.Default -- | Default Declaration data DefaultDecl pass-  = DefaultDecl (XCDefaultDecl pass) [LHsType pass]-        -- ^ - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnDefault',-        --          'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation+  = DefaultDecl+      { defd_ext      :: XCDefaultDecl pass+      , defd_class    :: Maybe (LIdP pass)  -- Nothing in absence of NamedDefaults+      , defd_defaults :: [LHsType pass] }   | XDefaultDecl !(XXDefaultDecl pass)  {-@@ -1553,12 +1435,6 @@       , fd_name   :: LIdP pass             -- uses this name       , fd_sig_ty :: LHsSigType pass       -- sig_ty       , fd_fe     :: ForeignExport pass }-        -- ^-        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnForeign',-        --           'GHC.Parser.Annotation.AnnImport','GHC.Parser.Annotation.AnnExport',-        --           'GHC.Parser.Annotation.AnnDcolon'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | XForeignDecl !(XXForeignDecl pass)  {-@@ -1588,7 +1464,7 @@                           --  * `Safety' is irrelevant for `CLabel' and `CWrapper'                           --                           CImport  (XCImport pass)-                                   (XRec pass CCallConv) -- ccall or stdcall+                                   (XRec pass CCallConv) -- ccall                                    (XRec pass Safety)  -- interruptible, safe or unsafe                                    (Maybe Header)       -- name of C header                                    CImportSpec          -- details of the C entity@@ -1644,13 +1520,6 @@        , rd_lhs  :: XRec pass (HsExpr pass)        , rd_rhs  :: XRec pass (HsExpr pass)        }-    -- ^-    --  - 'GHC.Parser.Annotation.AnnKeywordId' :-    --           'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnTilde',-    --           'GHC.Parser.Annotation.AnnVal',-    --           'GHC.Parser.Annotation.AnnClose',-    --           'GHC.Parser.Annotation.AnnForall','GHC.Parser.Annotation.AnnDot',-    --           'GHC.Parser.Annotation.AnnEqual',   | XRuleDecl !(XXRuleDecl pass)  -- | Located Rule Binder@@ -1661,12 +1530,7 @@   = RuleBndr (XCRuleBndr pass)  (LIdP pass)   | RuleBndrSig (XRuleBndrSig pass) (LIdP pass) (HsPatSigType pass)   | XRuleBndr !(XXRuleBndr pass)-        -- ^-        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-        --     'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose' -        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass] collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs] @@ -1738,12 +1602,6 @@ data AnnDecl pass = HsAnnotation                       (XHsAnnotation pass)                       (AnnProvenance pass) (XRec pass (HsExpr pass))-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-      --           'GHC.Parser.Annotation.AnnType'-      --           'GHC.Parser.Annotation.AnnModule'-      --           'GHC.Parser.Annotation.AnnClose'--      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | XAnnDecl !(XXAnnDecl pass)  -- | Annotation Provenance@@ -1778,8 +1636,4 @@   = RoleAnnotDecl (XCRoleAnnotDecl pass)                   (LIdP pass)              -- type constructor                   [XRec pass (Maybe Role)] -- optional annotations-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',-      --           'GHC.Parser.Annotation.AnnRole'--      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | XRoleAnnotDecl !(XXRoleAnnotDecl pass)
compiler/Language/Haskell/Syntax/Expr.hs view
@@ -26,14 +26,13 @@ import Language.Haskell.Syntax.Pat import Language.Haskell.Syntax.Lit import Language.Haskell.Syntax.Extension+import Language.Haskell.Syntax.Module.Name (ModuleName) import Language.Haskell.Syntax.Type import Language.Haskell.Syntax.Binds  -- others:-import GHC.Types.Fixity (LexicalFixity(Infix), Fixity)-import GHC.Types.SourceText (StringLiteral, SourceText)+import GHC.Types.SourceText (StringLiteral) -import GHC.Unit.Module (ModuleName) import GHC.Data.FastString (FastString)  -- libraries:@@ -171,11 +170,7 @@  -- | Located Haskell Expression type LHsExpr p = XRec p (HsExpr p)-  -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when-  --   in a list -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- ------------------------- {- Note [NoSyntaxExpr] ~~~~~~~~~~~~~~~~~~~~~~@@ -260,6 +255,80 @@ transforms the record-selector Name to an Id. -} +{- Note [Types in terms]+~~~~~~~~~~~~~~~~~~~~~~~~+Types-in-terms is a notion introduced by GHC Proposal #281. It refers+to the extension of term syntax (HsExpr in the AST, infixexp2 in Parser.y)+with constructs that previously could only occur at the type level:++  * Function arrows: a -> b+  * Multiplicity-polymorphic function arrows: a %m -> b (LinearTypes)+  * Constraint arrows: a => b+  * Universal quantification: forall a. b+  * Visible universal quantification: forall a -> b++This syntax can't be used to construct a type at the term level because `Type`+is not inhabited by any terms. Its use is limited to required type arguments:++  -- Error:+  t :: Type+  t = (Int -> String)+    -- Not supported by GHC, `tcExpr` emits `TcRnIllegalTypeExpr`++  -- OK:+  s :: String+  s = vfun (Int -> String)+        -- Valid use in a required type argument,+        -- see `expr_to_type` (GHC.Tc.Gen.App)+    where+      vfun :: forall t -> Typeable t => String+      vfun t = show (typeRep @t)++In GHC, types-in-terms are implemented by the following additions to the AST of+expressions and their grammar:++  -- Language/Haskell/Syntax/Expr.hs+  data HsExpr p =+    ...+    | HsForAll (XForAll p) (HsForAllTelescope p) (LHsExpr p)+    | HsQual (XQual p) (XRec p [LHsExpr p]) (LHsExpr p)+    | HsFunArr (XFunArr p) (HsArrowOf (LHsExpr p) p) (LHsExpr p) (LHsExpr p)++  -- GHC/Parser.y+  infixexp2 :: { ECP }+    : infixexp %shift                  { ... }+    | infixexp         '->'  infixexp2 { ... }+    | infixexp expmult '->'  infixexp2 { ... }+    | infixexp         '->.' infixexp2 { ... }+    | expcontext       '=>'  infixexp2 { ... }+    | forall_telescope infixexp2       { ... }++These constructors and non-terminals mirror those found in HsType++     HsType      |  HsExpr+    -------------+-----------+     HsForAllTy  |  HsForAll+     HsFunTy     |  HsFunArr+     HsQualTy    |  HsQual++The resulting code duplication can be removed if we unify HsExpr and HsType+into one type (#25121).++Per the proposal, the constituents of types-in-terms are parsed and renamed+as terms, and forall-bound variables inhabit the term namespace. Example:++  h = \a -> g (forall a. Maybe a) a++To ensure that the `a` in `Maybe a` refers to the innermost binding (i.e. to the+forall-bound `a` and not to the lambda-bound `a`), we must consistently use the+term namespace `varName` throughout the expression. We set the correct namespace+using `setTelescopeBndrsNameSpace` in GHC.Parser.PostProcess and GHC.ThToHs.++`exprCtOrigin` returns `Shouldn'tHappenOrigin` for types-in-terms because+they either undergo the T2T translation `expr_to_type` in `tcVDQ` or result+in `TcRnIllegalTypeExpr`.+-}+ -- | A Haskell expression. data HsExpr p   = HsVar     (XVar p)@@ -278,14 +347,9 @@                              --   solving. See Note [Holes] in GHC.Tc.Types.Constraint.  -  | HsRecSel  (XRecSel p)-              (FieldOcc p) -- ^ Variable pointing to record selector-                           -- See Note [Non-overloaded record field selectors] and-                           -- Note [Record selectors in the AST] -  | HsOverLabel (XOverLabel p) SourceText FastString+  | HsOverLabel (XOverLabel p) FastString      -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)-     -- Note [Pragma source text] in GHC.Types.SourceText    | HsIPVar   (XIPVar p)               HsIPName   -- ^ Implicit parameter (not in use after typechecking)@@ -296,27 +360,13 @@               (HsLit p)      -- ^ Simple (non-overloaded) literals    -- | Lambda, Lambda-case, and Lambda-cases-  ---  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',-  --           'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen',-  --           'GHC.Parser.Annotation.AnnClose'-  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',-  --           'GHC.Parser.Annotation.AnnCases','GHC.Parser.Annotation.AnnOpen',-  --           'GHC.Parser.Annotation.AnnClose'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsLam     (XLam p)               HsLamVariant -- ^ Tells whether this is for lambda, \case, or \cases               (MatchGroup p (LHsExpr p))                        -- ^ LamSingle: one match of arity >= 1                        --   LamCase: many arity-1 matches                        --   LamCases: many matches of uniform arity >= 1-       ---       -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',-       --       'GHC.Parser.Annotation.AnnRarrow', -       -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application    | HsAppType (XAppTypeE p) -- After typechecking: the type argument@@ -325,8 +375,6 @@        --        -- Explicit type argument; e.g  f @Int x y        -- NB: Has wildcards, but no implicit quantification-       ---       -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt',    -- | Operator applications:   -- NB Bracketed ops such as (+) come out as Vars.@@ -341,18 +389,10 @@    -- | Negation operator. Contains the negated expression and the name   -- of 'negate'-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnMinus'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | NegApp      (XNegApp p)                 (LHsExpr p)                 (SyntaxExpr p) -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,-  --             'GHC.Parser.Annotation.AnnClose' @')'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsPar       (XPar p)                 (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn] @@ -364,11 +404,7 @@                 (LHsExpr p)    -- operand    -- | Used for explicit tuples and sections thereof-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-  --         'GHC.Parser.Annotation.AnnClose' -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   -- Note [ExplicitTuple]   | ExplicitTuple         (XExplicitTuple p)@@ -376,33 +412,16 @@         Boxity    -- | Used for unboxed sum types-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@,-  --          'GHC.Parser.Annotation.AnnVbar', 'GHC.Parser.Annotation.AnnClose' @'#)'@,-  ---  --  There will be multiple 'GHC.Parser.Annotation.AnnVbar', (1 - alternative) before-  --  the expression, (arity - alternative) after it   | ExplicitSum           (XExplicitSum p)           ConTag   --  Alternative (one-based)           SumWidth --  Sum arity           (LHsExpr p) -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase',-  --       'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@,-  --       'GHC.Parser.Annotation.AnnClose' @'}'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsCase      (XCase p)                 (LHsExpr p)                 (MatchGroup p (LHsExpr p)) -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf',-  --       'GHC.Parser.Annotation.AnnSemi',-  --       'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi',-  --       'GHC.Parser.Annotation.AnnElse',--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsIf        (XIf p)        -- GhcPs: this is a Bool; False <=> do not use                                --  rebindable syntax                 (LHsExpr p)    --  predicate@@ -410,64 +429,31 @@                 (LHsExpr p)    --  else part    -- | Multi-way if-  ---  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf'-  --       'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]    -- | let(rec)-  ---  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet',-  --       'GHC.Parser.Annotation.AnnOpen' @'{'@,-  --       'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsLet       (XLet p)                 (HsLocalBinds p)                 (LHsExpr  p) -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo',-  --             'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi',-  --             'GHC.Parser.Annotation.AnnVbar',-  --             'GHC.Parser.Annotation.AnnClose'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsDo        (XDo p)                  -- Type of the whole expression                 HsDoFlavour                 (XRec p [ExprLStmt p])   -- "do":one or more stmts    -- | Syntactic list: [a,b,c,...]-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,-  --              'GHC.Parser.Annotation.AnnClose' @']'@ -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   -- See Note [Empty lists]   | ExplicitList                 (XExplicitList p)  -- Gives type of components of list                 [LHsExpr p]    -- | Record construction-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,-  --         'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | RecordCon       { rcon_ext  :: XRecordCon p       , rcon_con  :: XRec p (ConLikeP p)  -- The constructor       , rcon_flds :: HsRecordBinds p }    -- The fields    -- | Record update-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,-  --         'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@-  --         'GHC.Parser.Annotation.AnnComma, 'GHC.Parser.Annotation.AnnDot',-  --         'GHC.Parser.Annotation.AnnClose' @'}'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | RecordUpd       { rupd_ext  :: XRecordUpd p       , rupd_expr :: LHsExpr p@@ -477,11 +463,7 @@   -- not the family tycon    -- | Record field selection e.g @z.x@.-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDot' -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   -- This case only arises when the OverloadedRecordDot langauge   -- extension is enabled. See Note [Record selectors in the AST].   | HsGetField {@@ -495,20 +477,12 @@   -- This case only arises when the OverloadedRecordDot langauge   -- extensions is enabled. See Note [Record selectors in the AST]. -  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenP'-  --         'GHC.Parser.Annotation.AnnDot', 'GHC.Parser.Annotation.AnnCloseP'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsProjection {         proj_ext :: XProjection p-      , proj_flds :: NonEmpty (XRec p (DotFieldOcc p))+      , proj_flds :: NonEmpty (DotFieldOcc p)       }    -- | Expression with an explicit type signature. @e :: type@-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | ExprWithTySig                 (XExprWithTySig p) @@ -516,12 +490,6 @@                 (LHsSigWcType (NoGhcTc p))    -- | Arithmetic sequence-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,-  --              'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnDotdot',-  --              'GHC.Parser.Annotation.AnnClose' @']'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | ArithSeq                 (XArithSeq p)                 (Maybe (SyntaxExpr p))@@ -533,18 +501,8 @@   -----------------------------------------------------------   -- MetaHaskell Extensions -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-  --         'GHC.Parser.Annotation.AnnOpenE','GHC.Parser.Annotation.AnnOpenEQ',-  --         'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnCloseQ'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsTypedBracket   (XTypedBracket p)   (LHsExpr p)   | HsUntypedBracket (XUntypedBracket p) (HsQuote p)--  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-  --         'GHC.Parser.Annotation.AnnClose'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsTypedSplice    (XTypedSplice p)   (LHsExpr p) -- `$$z` or `$$(f 4)`   | HsUntypedSplice  (XUntypedSplice p) (HsUntypedSplice p) @@ -552,11 +510,6 @@   -- Arrow notation extension    -- | @proc@ notation for Arrows-  ---  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnProc',-  --          'GHC.Parser.Annotation.AnnRarrow'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsProc      (XProc p)                 (LPat p)               -- arrow abstraction, proc                 (LHsCmdTop p)          -- body of the abstraction@@ -564,9 +517,6 @@    ---------------------------------------   -- static pointers extension-  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnStatic',--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsStatic (XStatic p) -- Free variables of the body, and type after typechecking              (LHsExpr p)        -- Body @@ -575,10 +525,25 @@   | HsPragE (XPragE p) (HsPragE p) (LHsExpr p)    -- Embed the syntax of types into expressions.-  -- Used with RequiredTypeArguments, e.g. fn (type (Int -> Bool))+  -- Used with @RequiredTypeArguments@, e.g. @fn (type (Int -> Bool))@.   | HsEmbTy   (XEmbTy p)               (LHsWcType (NoGhcTc p)) +  -- | Forall-types @forall tvs. t@ and @forall tvs -> t@.+  -- Used with @RequiredTypeArguments@, e.g. @fn (forall a. Proxy a)@.+  -- See Note [Types in terms]+  | HsForAll (XForAll p) (HsForAllTelescope p) (LHsExpr p)++  -- Constrained types @ctx => t@.+  -- Used with @RequiredTypeArguments@, e.g. @fn (Bounded a => a)@.+  -- See Note [Types in terms]+  | HsQual (XQual p) (XRec p [LHsExpr p]) (LHsExpr p)++  -- | Function types @a -> b@.+  -- Used with @RequiredTypeArguments@, e.g. @fn (Int -> Bool)@.+  -- See Note [Types in terms]+  | HsFunArr (XFunArr p) (HsArrowOf (LHsExpr p) p) (LHsExpr p) (LHsExpr p)+   | XExpr       !(XXExpr p)   -- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the   -- general idea, and Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr@@ -600,15 +565,6 @@   = HsPragSCC   (XSCC p)                 StringLiteral         -- "set cost centre" SCC pragma -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-  --       'GHC.Parser.Annotation.AnnOpen' @'{-\# GENERATED'@,-  --       'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnVal',-  --       'GHC.Parser.Annotation.AnnColon','GHC.Parser.Annotation.AnnVal',-  --       'GHC.Parser.Annotation.AnnMinus',-  --       'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnColon',-  --       'GHC.Parser.Annotation.AnnVal',-  --       'GHC.Parser.Annotation.AnnClose' @'\#-}'@-   | XHsPragE !(XXPragE p)  -- | Located Haskell Tuple Argument@@ -618,10 +574,7 @@ -- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@ -- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@ type LHsTupArg id = XRec id (HsTupArg id)--- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | Haskell Tuple Argument data HsTupArg id   = Present (XPresent id) (LHsExpr id)     -- ^ The argument@@ -807,11 +760,6 @@  -- | Haskell Command (e.g. a "statement" in an Arrow proc block) data HsCmd id-  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.Annlarrowtail',-  --          'GHC.Parser.Annotation.Annrarrowtail','GHC.Parser.Annotation.AnnLarrowtail',-  --          'GHC.Parser.Annotation.AnnRarrowtail'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)         (XCmdArrApp id)  -- type of the arrow expressions f,                          -- of the form a t t', where arg :: t@@ -821,10 +769,6 @@         Bool             -- True => right-to-left (f -< arg)                          -- False => left-to-right (arg >- f) -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenB' @'(|'@,-  --         'GHC.Parser.Annotation.AnnCloseB' @'|)'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)         (XCmdArrForm id)         (LHsExpr id)     -- The operator.@@ -832,8 +776,6 @@                          -- applied to the type of the local environment tuple         LexicalFixity    -- Whether the operator appeared prefix or infix when                          -- parsed.-        (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that-                         -- were converted from OpApp's by the renamer         [LHsCmdTop id]   -- argument commands    | HsCmdApp    (XCmdApp id)@@ -842,63 +784,29 @@    -- | Lambda-case   ---  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',-  --     'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen' @'{'@,-  --     'GHC.Parser.Annotation.AnnClose' @'}'@-  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',-  --     'GHC.Parser.Annotation.AnnCases','GHC.Parser.Annotation.AnnOpen' @'{'@,-  --     'GHC.Parser.Annotation.AnnClose' @'}'@--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | HsCmdLam (XCmdLamCase id) HsLamVariant              (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's    | HsCmdPar    (XCmdPar id)                 (LHsCmd id)                     -- parenthesised command-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,-    --             'GHC.Parser.Annotation.AnnClose' @')'@ -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsCmdCase   (XCmdCase id)                 (LHsExpr id)                 (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase',-    --       'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@,-    --       'GHC.Parser.Annotation.AnnClose' @'}'@ -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsCmdIf     (XCmdIf id)                 (SyntaxExpr id)         -- cond function                 (LHsExpr id)            -- predicate                 (LHsCmd id)             -- then part                 (LHsCmd id)             -- else part-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf',-    --       'GHC.Parser.Annotation.AnnSemi',-    --       'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi',-    --       'GHC.Parser.Annotation.AnnElse', -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsCmdLet    (XCmdLet id)                 (HsLocalBinds id)      -- let(rec)                 (LHsCmd  id)-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet',-    --       'GHC.Parser.Annotation.AnnOpen' @'{'@,-    --       'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn' -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsCmdDo     (XCmdDo id)                     -- Type of the whole expression                 (XRec id [CmdLStmt id])-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo',-    --             'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi',-    --             'GHC.Parser.Annotation.AnnVbar',-    --             'GHC.Parser.Annotation.AnnClose' -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | XCmd        !(XXCmd id)     -- Extension point; see Note [Trees That Grow]                                 -- in Language.Haskell.Syntax.Extension @@ -971,15 +879,12 @@  -- | Located Match type LMatch id body = XRec id (Match id body)--- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a---   list --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data Match p body   = Match {         m_ext   :: XCMatch p body,         m_ctxt  :: HsMatchContext (LIdP (NoGhcTc p)), -- See Note [m_ctxt in Match]-        m_pats  :: [LPat p],                          -- The patterns+        m_pats  :: XRec p [LPat p],                   -- The patterns         m_grhss :: (GRHSs p body)   }   | XMatch !(XXMatch p body)@@ -1026,13 +931,6 @@ -- | Guarded Right-Hand Sides -- -- GRHSs are used both for pattern bindings and for Matches------  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVbar',---        'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',---        'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'---        'GHC.Parser.Annotation.AnnRarrow','GHC.Parser.Annotation.AnnSemi'---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data GRHSs p body   = GRHSs {       grhssExt :: XCGRHSs p body,@@ -1095,13 +993,6 @@  -- The SyntaxExprs in here are used *only* for do-notation and monad -- comprehensions, which have rebindable syntax. Otherwise they are unused.--- | Exact print annotations when in qualifier lists or guards---  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVbar',---         'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnThen',---         'GHC.Parser.Annotation.AnnBy','GHC.Parser.Annotation.AnnBy',---         'GHC.Parser.Annotation.AnnGroup','GHC.Parser.Annotation.AnnUsing'---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data StmtLR idL idR body -- body should always be (LHs**** idR)   = LastStmt  -- Always the last Stmt in ListComp, MonadComp,               -- and (after the renamer, see GHC.Rename.Expr.checkLastStmt) DoExpr, MDoExpr@@ -1117,9 +1008,7 @@             -- For ListComp we use the baked-in 'return'             -- For DoExpr, MDoExpr, we don't apply a 'return' at all             -- See Note [Monad Comprehensions]-            -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLarrow' -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | BindStmt (XBindStmt idL idR body)              -- ^ Post renaming has optional fail and bind / (>>=) operator.              -- Post typechecking, also has multiplicity of the argument@@ -1129,20 +1018,6 @@              (LPat idL)              body -  -- | 'ApplicativeStmt' represents an applicative expression built with-  -- '<$>' and '<*>'.  It is generated by the renamer, and is desugared into the-  -- appropriate applicative expression by the desugarer, but it is intended-  -- to be invisible in error messages.-  ---  -- For full details, see Note [ApplicativeDo] in "GHC.Rename.Expr"-  ---  | ApplicativeStmt-             (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body-             [ ( SyntaxExpr idR-               , ApplicativeArg idL) ]-                      -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]-             (Maybe (SyntaxExpr idR))  -- 'join', if necessary-   | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type                                       -- of the RHS (used for arrows)              body              -- See Note [BodyStmt]@@ -1150,10 +1025,6 @@              (SyntaxExpr idR)  -- The `guard` operator; used only in MonadComp                                -- See notes [Monad Comprehensions] -  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet'-  --          'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@,--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | LetStmt  (XLetStmt idL idR body) (HsLocalBindsLR idL idR)    -- ParStmts only occur in a list/monad comprehension@@ -1189,9 +1060,6 @@     }                                 -- See Note [Monad Comprehensions]    -- Recursive statement (see Note [How RecStmt works] below)-  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRec'--  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | RecStmt      { recS_ext :: XRecStmt idL idR body      , recS_stmts :: XRec idR [LStmtLR idL idR body]@@ -1247,37 +1115,6 @@ -- '@BindStmt@'s should use the monadic fail and which shouldn't. type FailOperator id = Maybe (SyntaxExpr id) --- | Applicative Argument-data ApplicativeArg idL-  = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)-    { xarg_app_arg_one  :: XApplicativeArgOne idL-      -- ^ The fail operator, after renaming-      ---      -- The fail operator is needed if this is a BindStmt-      -- where the pattern can fail. E.g.:-      -- (Just a) <- stmt-      -- The fail operator will be invoked if the pattern-      -- match fails.-      -- It is also used for guards in MonadComprehensions.-      -- The fail operator is Nothing-      -- if the pattern match can't fail-    , app_arg_pattern   :: LPat idL -- WildPat if it was a BodyStmt (see below)-    , arg_expr          :: LHsExpr idL-    , is_body_stmt      :: Bool-      -- ^ True <=> was a BodyStmt,-      -- False <=> was a BindStmt.-      -- See Note [Applicative BodyStmt]-    }-  | ApplicativeArgMany     -- do { stmts; return vars }-    { xarg_app_arg_many :: XApplicativeArgMany idL-    , app_stmts         :: [ExprLStmt idL] -- stmts-    , final_expr        :: HsExpr idL    -- return (v1,..,vn), or just (v1,..,vn)-    , bv_pattern        :: LPat idL      -- (v1,...,vn)-    , stmt_context      :: HsDoFlavour-      -- ^ context of the do expression, used in pprArg-    }-  | XApplicativeArg !(XXApplicativeArg idL)- {- Note [The type of bind in Stmts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1538,6 +1375,7 @@       , mc_fixity     :: LexicalFixity -- ^ fixing of @f@       , mc_strictness :: SrcStrictness -- ^ was @f@ banged?                                        -- See Note [FunBind vs PatBind]+      , mc_an         :: XFunRhs       }   | CaseAlt                     -- ^Patterns and guards in a case alternative   | LamAlt HsLamVariant         -- ^Patterns and guards in @\@, @\case@ and @\cases@
compiler/Language/Haskell/Syntax/Expr.hs-boot view
@@ -9,7 +9,7 @@ import Language.Haskell.Syntax.Extension ( XRec ) import Data.Kind  ( Type ) -import GHC.Prelude (Eq)+import Prelude (Eq) import Data.Data (Data)  type role HsExpr nominal
compiler/Language/Haskell/Syntax/Extension.hs view
@@ -66,7 +66,7 @@ -}  -- | A placeholder type for TTG extension points that are not currently--- unused to represent any particular value.+-- used to represent any particular value. -- -- This should not be confused with 'DataConCantHappen', which are found in unused -- extension /constructors/ and therefore should never be inhabited. In@@ -448,9 +448,16 @@ type family XBinTick        x type family XPragE          x type family XEmbTy          x+type family XForAll         x+type family XQual           x+type family XFunArr         x type family XXExpr          x  -- -------------------------------------+-- HsMatchContext type families+type family XFunRhs++-- ------------------------------------- -- DotFieldOcc type families type family XCDotFieldOcc  x type family XXDotFieldOcc  x@@ -460,14 +467,7 @@ type family XSCC            x type family XXPragE         x - -- ---------------------------------------- AmbiguousFieldOcc type families-type family XUnambiguous        x-type family XAmbiguous          x-type family XXAmbiguousFieldOcc x---- ------------------------------------- -- HsTupArg type families type family XPresent  x type family XMissing  x@@ -518,7 +518,6 @@ -- StmtLR type families type family XLastStmt        x x' b type family XBindStmt        x x' b-type family XApplicativeStmt x x' b type family XBodyStmt        x x' b type family XLetStmt         x x' b type family XParStmt         x x' b@@ -546,18 +545,7 @@ type family XParStmtBlock  x x' type family XXParStmtBlock x x' --- ---------------------------------------- ApplicativeArg type families-type family XApplicativeArgOne   x-type family XApplicativeArgMany  x-type family XXApplicativeArg     x- -- =====================================================================--- Type families for the HsImpExp extension points---- TODO---- ===================================================================== -- Type families for the HsLit extension points  -- We define a type family for each extension point. This is based on prepending@@ -565,6 +553,7 @@ type family XHsChar x type family XHsCharPrim x type family XHsString x+type family XHsMultilineString x type family XHsStringPrim x type family XHsInt x type family XHsIntPrim x@@ -600,6 +589,7 @@ type family XListPat     x type family XTuplePat    x type family XSumPat      x+type family XOrPat       x type family XConPat      x type family XViewPat     x type family XSplicePat   x@@ -689,8 +679,7 @@  -- --------------------------------------------------------------------- -- HsTyVarBndr type families-type family XUserTyVar   x-type family XKindedTyVar x+type family XTyVarBndr   x type family XXTyVarBndr  x  -- ---------------------------------------------------------------------@@ -704,7 +693,7 @@ type family XXFieldOcc x  -- =====================================================================--- Type families for the HsImpExp type families+-- Type families for the HsImpExp extension points  -- ------------------------------------- -- ImportDecl type families@@ -727,6 +716,7 @@ -- ------------------------------------- -- IEWrappedName type families type family XIEName p+type family XIEDefault p type family XIEPattern p type family XIEType p type family XXIEWrappedName p
compiler/Language/Haskell/Syntax/ImpExp.hs view
@@ -14,6 +14,8 @@ import Data.String (String) import Data.Int (Int) +import Control.DeepSeq+ import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST  {-@@ -28,12 +30,7 @@  -- | Located Import Declaration type LImportDecl pass = XRec pass (ImportDecl pass)-        -- ^ When in a list this may have-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' -        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | If/how an import is 'qualified'. data ImportDeclQualifiedStyle   = QualifiedPre  -- ^ 'qualified' appears in prepositive position.@@ -48,15 +45,18 @@ data IsBootInterface = NotBoot | IsBoot     deriving (Eq, Ord, Show, Data) +instance NFData IsBootInterface where+  rnf = rwhnf+ -- | Import Declaration -- -- A single Haskell @import@ declaration. data ImportDecl pass   = ImportDecl {-      ideclExt        :: XCImportDecl pass,+      ideclExt        :: XCImportDecl pass, -- ^ Locations of keywords like @import@, @qualified@, etc. are captured here.       ideclName       :: XRec pass ModuleName, -- ^ Module name.       ideclPkgQual    :: ImportDeclPkgQual pass,  -- ^ Package qualifier.-      ideclSource     :: IsBootInterface,      -- ^ IsBoot <=> {-\# SOURCE \#-} import+      ideclSource     :: IsBootInterface,      -- ^ IsBoot \<=> {-\# SOURCE \#-} import       ideclSafe       :: Bool,          -- ^ True => safe import       ideclQualified  :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified.       ideclAs         :: Maybe (XRec pass ModuleName),  -- ^ as Module@@ -64,42 +64,25 @@                                        -- ^ Explicit import list (EverythingBut => hiding, names)     }   | XImportDecl !(XXImportDecl pass)-     -- ^-     --  'GHC.Parser.Annotation.AnnKeywordId's-     ---     --  - 'GHC.Parser.Annotation.AnnImport'-     ---     --  - 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnClose' for ideclSource-     ---     --  - 'GHC.Parser.Annotation.AnnSafe','GHC.Parser.Annotation.AnnQualified',-     --    'GHC.Parser.Annotation.AnnPackageName','GHC.Parser.Annotation.AnnAs',-     --    'GHC.Parser.Annotation.AnnVal'-     ---     --  - 'GHC.Parser.Annotation.AnnHiding','GHC.Parser.Annotation.AnnOpen',-     --    'GHC.Parser.Annotation.AnnClose' attached-     --     to location in ideclImportList -     -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation---- | Whether the import list is exactly what to import, or whether `hiding` was+-- | Whether the import list is exactly what to import, or whether @hiding@ was -- used, and therefore everything but what was listed should be imported data ImportListInterpretation = Exactly | EverythingBut     deriving (Eq, Data) +instance NFData ImportListInterpretation where+  rnf = rwhnf+ -- | Located Import or Export type LIE pass = XRec pass (IE pass)         -- ^ When in a list this may have-        ---        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' -        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | A docstring attached to an export list item. type ExportDoc pass = LHsDoc pass  -- | Imported or exported entity. data IE pass-  = IEVar       (XIEVar pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))+  = IEVar (XIEVar pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))         -- ^ Imported or exported variable         --         -- @@@ -107,36 +90,28 @@         -- import Mod ( test )         -- @ -  | IEThingAbs  (XIEThingAbs pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))+  | IEThingAbs (XIEThingAbs pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))         -- ^ Imported or exported Thing with absent subordinate list         ---        -- The thing is a typeclass or type (can't tell)-        --  - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern',-        --             'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal'+        -- The thing is a Class\/Type (can't tell)         --         -- @         -- module Mod ( Test )         -- import Mod ( Test )         -- @ -        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation         -- See Note [Located RdrNames] in GHC.Hs.Expr   | IEThingAll  (XIEThingAll pass) (LIEWrappedName pass) (Maybe (ExportDoc pass))-        -- ^ Imported or exported thing with wildcard subordinate list (e..g @(..)@)+        -- ^ Imported or exported thing with wildcard subordinate list (e.g. @(..)@)         ---        -- The thing is a Class/Type and the All refers to methods/constructors+        -- The thing is a Class\/Type and the All refers to methods\/constructors         ---        -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',-        --       'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose',-        --                                 'GHC.Parser.Annotation.AnnType'         -- @         -- module Mod ( Test(..) )         -- import Mod ( Test(..) )         -- @ -        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation         -- See Note [Located RdrNames] in GHC.Hs.Expr-   | IEThingWith (XIEThingWith pass)                 (LIEWrappedName pass)                 IEWildcard@@ -144,31 +119,20 @@                 (Maybe (ExportDoc pass))         -- ^ Imported or exported thing with explicit subordinate list.         ---        -- The thing is a Class/Type and the imported or exported things are+        -- The thing is a Class\/Type (can't tell) and the imported or exported things are         -- its children.-        -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',-        --                                   'GHC.Parser.Annotation.AnnClose',-        --                                   'GHC.Parser.Annotation.AnnComma',-        --                                   'GHC.Parser.Annotation.AnnType'+        --         -- @-        -- module Mod ( Test(..) )-        -- import Mod ( Test(..) )+        -- module Mod ( Test(f, g) )+        -- import Mod ( Test(f, g) )         -- @--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | IEModuleContents  (XIEModuleContents pass) (XRec pass ModuleName)-        -- ^ Imported or exported module contents-        ---        -- (Export Only)-        ---        -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule'+        -- ^ Export of entire module. Can only occur in export list.         --         -- @         -- module Mod ( module Mod2 )         -- @--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-  | IEGroup             (XIEGroup pass) Int (LHsDoc pass) -- ^ Doc section heading+  | IEGroup (XIEGroup pass) Int (LHsDoc pass)         -- ^ A Haddock section in an export list.         --         -- @@@ -177,7 +141,7 @@         --     ...         --   )         -- @-  | IEDoc               (XIEDoc pass) (LHsDoc pass)       -- ^ Some documentation+  | IEDoc (XIEDoc pass) (LHsDoc pass)         -- ^ A bit of unnamed documentation.         --         -- @@@ -186,7 +150,7 @@         --     ...         --   )         -- @-  | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc+  | IEDocNamed (XIEDocNamed pass) String         -- ^ A reference to a named documentation chunk.         --         -- @@@ -208,17 +172,17 @@  -- | A name in an import or export specification which may have -- adornments. Used primarily for accurate pretty printing of--- ParsedSource, and API Annotation placement. The--- 'GHC.Parser.Annotation' is the location of the adornment in--- the original source.+-- ParsedSource, and API Annotation placement. data IEWrappedName p-  = IEName    (XIEName p)    (LIdP p)  -- ^ no extra-  | IEPattern (XIEPattern p) (LIdP p)  -- ^ pattern X-  | IEType    (XIEType p)    (LIdP p)  -- ^ type (:+:)+  = IEName    (XIEName p)    (LIdP p)  -- ^ unadorned name, e.g @myFun@+  | IEDefault (XIEDefault p) (LIdP p)  -- ^ @default X ()@, see Note [Named default declarations] in GHC.Tc.Gen.Default+  | IEPattern (XIEPattern p) (LIdP p)  -- ^ @pattern X@+                                       --+                                       -- exactprint: the location of @pattern@ keyword is captured via 'GHC.Parser.Annotation.EpaLocation'+  | IEType    (XIEType p)    (LIdP p)  -- ^ @type (:+:)@+                                       --+                                       -- exactprint: the location of @type@ keyword is captured via 'GHC.Parser.Annotation.EpaLocation'   | XIEWrappedName !(XXIEWrappedName p)  -- | Located name with possible adornment--- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnType',---         'GHC.Parser.Annotation.AnnPattern' type LIEWrappedName p = XRec p (IEWrappedName p)--- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
compiler/Language/Haskell/Syntax/Lit.hs view
@@ -20,8 +20,7 @@  import Language.Haskell.Syntax.Extension -import GHC.Utils.Panic (panic)-import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText, negateIntegralLit, negateFractionalLit)+import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText) import GHC.Core.Type (Type)  import GHC.Data.FastString (FastString, lexicalCompareFS)@@ -54,6 +53,8 @@       -- ^ Unboxed character   | HsString (XHsString x) {- SourceText -} FastString       -- ^ String+  | HsMultilineString (XHsMultilineString x) {- SourceText -} FastString+      -- ^ String   | HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString       -- ^ Packed bytes   | HsInt (XHsInt x)  IntegralLit@@ -128,28 +129,11 @@   | HsIsString   !SourceText !FastString -- ^ String-looking literals   deriving Data -negateOverLitVal :: OverLitVal -> OverLitVal-negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)-negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)-negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"---- Comparison operations are needed when grouping literals--- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)-instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where-  (OverLit _ val1) == (OverLit _ val2) = val1 == val2-  (XOverLit  val1) == (XOverLit  val2) = val1 == val2-  _ == _ = panic "Eq HsOverLit"- instance Eq OverLitVal where   (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2   (HsFractional f1)   == (HsFractional f2)   = f1 == f2   (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2   _                   == _                   = False--instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where-  compare (OverLit _ val1)  (OverLit _ val2) = val1 `compare` val2-  compare (XOverLit  val1)  (XOverLit  val2) = val1 `compare` val2-  compare _ _ = panic "Ord HsOverLit"  instance Ord OverLitVal where   compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2
compiler/Language/Haskell/Syntax/Module/Name.hs view
@@ -2,13 +2,11 @@  import Prelude -import Data.Data import Data.Char (isAlphaNum) import Control.DeepSeq import qualified Text.ParserCombinators.ReadP as Parse import System.FilePath -import GHC.Utils.Misc (abstractConstr) import GHC.Data.FastString  -- | A ModuleName is essentially a simple string, e.g. @Data.List@.@@ -17,12 +15,6 @@ instance Ord ModuleName where   nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2 -instance Data ModuleName where-  -- don't traverse?-  toConstr _   = abstractConstr "ModuleName"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "ModuleName"- instance NFData ModuleName where   rnf x = x `seq` () @@ -56,5 +48,5 @@  parseModuleName :: Parse.ReadP ModuleName parseModuleName = fmap mkModuleName-                $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")+                $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.'")
compiler/Language/Haskell/Syntax/Pat.hs view
@@ -25,7 +25,7 @@          HsConPatDetails, hsConPatArgs, hsConPatTyArgs,         HsConPatTyArg(..), XConPatTyArg,-        HsRecFields(..), HsFieldBind(..), LHsFieldBind,+        HsRecFields(..), XHsRecFields, HsFieldBind(..), LHsFieldBind,         HsRecField, LHsRecField,         HsRecUpdField, LHsRecUpdField,         RecFieldsDotDot(..),@@ -52,66 +52,48 @@ import Data.Int import Data.Function import qualified Data.List+import Data.List.NonEmpty (NonEmpty)  type LPat p = XRec p (Pat p)  -- | Pattern------ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'---- For details on above see Note [exact print annotations] in GHC.Parser.Annotation data Pat p   =     ------------ Simple patterns ----------------    WildPat     (XWildPat p)        -- ^ Wildcard Pattern-        -- The sole reason for a type on a WildPat is to-        -- support hsPatType :: Pat Id -> Type+    WildPat     (XWildPat p)+    -- ^ Wildcard Pattern, i.e. @_@ -       -- AZ:TODO above comment needs to be updated   | VarPat      (XVarPat p)-                (LIdP p)     -- ^ Variable Pattern+                (LIdP p)+    -- ^ Variable Pattern, e.g. @x@ -                             -- See Note [Located RdrNames] in GHC.Hs.Expr+    -- See Note [Located RdrNames] in GHC.Hs.Expr   | LazyPat     (XLazyPat p)-                (LPat p)                -- ^ Lazy Pattern-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-+                (LPat p)+    -- ^ Lazy Pattern, e.g. @~x@   | AsPat       (XAsPat p)                 (LIdP p)-                (LPat p)    -- ^ As pattern-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-+                (LPat p)+    -- ^ As pattern, e.g. @x\@pat@   | ParPat      (XParPat p)-                (LPat p)                -- ^ Parenthesised pattern-                                        -- See Note [Parens in HsSyn] in GHC.Hs.Expr-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,-    --                                    'GHC.Parser.Annotation.AnnClose' @')'@+                (LPat p)+    -- ^ Parenthesised pattern, e.g. @(x)@ -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation+    -- See Note [Parens in HsSyn] in GHC.Hs.Expr   | BangPat     (XBangPat p)-                (LPat p)                -- ^ Bang pattern-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'--    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation+                (LPat p)+    -- ^ Bang pattern, e.g. @!x@          ------------ Lists, tuples, arrays ---------------   | ListPat     (XListPat p)                 [LPat p]--    -- ^ Syntactic List-    ---    -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,-    --                                    'GHC.Parser.Annotation.AnnClose' @']'@+    -- ^ Syntactic List, e.g. @[x]@ or @[x,y]@.+    -- Note that @[]@ and @(x:xs)@ patterns are both represented using 'ConPat'. -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation+  | -- | Tuple pattern, e.g. @(x, y)@ (boxed tuples) or @(# x, y #)@ (requires @-XUnboxedTuples@)+    TuplePat    (XTuplePat p)    -- ^ After typechecking, holds the types of the tuple components+                [LPat p]         -- ^ Tuple sub-patterns+                Boxity -  | TuplePat    (XTuplePat p)-                  -- after typechecking, holds the types of the tuple components-                [LPat p]         -- Tuple sub-patterns-                Boxity           -- UnitPat is TuplePat []         -- You might think that the post typechecking Type was redundant,         -- because we can get the pattern type by getting the types of the         -- sub-patterns.@@ -128,23 +110,19 @@         -- of the tuple is of type 'a' not Int.  See selectMatchVar         -- (June 14: I'm not sure this comment is right; the sub-patterns         --           will be wrapped in CoPats, no?)-    -- ^ Tuple sub-patterns++  | OrPat       (XOrPat p)+                (NonEmpty (LPat p))+    -- ^ Or Pattern, e.g. @(pat_1; ...; pat_n)@. Used by @-XOrPatterns@     ---    -- - 'GHC.Parser.Annotation.AnnKeywordId' :-    --            'GHC.Parser.Annotation.AnnOpen' @'('@ or @'(#'@,-    --            'GHC.Parser.Annotation.AnnClose' @')'@ or  @'#)'@+    -- @since 9.12.1    | SumPat      (XSumPat p)        -- after typechecker, types of the alternative                 (LPat p)           -- Sum sub-pattern                 ConTag             -- Alternative (one-based)                 SumWidth           -- Arity (INVARIANT: ≥ 2)-    -- ^ Anonymous sum pattern-    ---    -- - 'GHC.Parser.Annotation.AnnKeywordId' :-    --            'GHC.Parser.Annotation.AnnOpen' @'(#'@,-    --            'GHC.Parser.Annotation.AnnClose' @'#)'@ -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation+    -- ^ Anonymous sum pattern, e.g. @(# x | #)@. Used by @-XUnboxedSums@          ------------ Constructor patterns ---------------   | ConPat {@@ -152,35 +130,30 @@         pat_con     :: XRec p (ConLikeP p),         pat_args    :: HsConPatDetails p     }-    -- ^ Constructor Pattern+    -- ^ Constructor Pattern, e.g. @()@, @[]@ or @Nothing@          ------------ View patterns ----------------  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow' -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | ViewPat       (XViewPat p)                   (LHsExpr p)                   (LPat p)-    -- ^ View Pattern+    -- ^ View Pattern, e.g. @someFun -> pat@. Used by @-XViewPatterns@          ------------ Pattern splices ----------------  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@-  --        'GHC.Parser.Annotation.AnnClose' @')'@ -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | SplicePat       (XSplicePat p)-                    (HsUntypedSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)+                    (HsUntypedSplice p)+  -- ^  Splice Pattern, e.g. @$(pat)@          ------------ Literal and n+k patterns ---------------   | LitPat          (XLitPat p)-                    (HsLit p)           -- ^ Literal Pattern-                                        -- Used for *non-overloaded* literal patterns:-                                        -- Int#, Char#, Int, Char, String, etc.+                    (HsLit p)+    -- ^ Literal Pattern+    --+    -- Used for __non-overloaded__ literal patterns:+    -- Int#, Char#, Int, Char, String, etc. -  | NPat                -- Natural Pattern-                        -- Used for all overloaded literals,-                        -- including overloaded strings with -XOverloadedStrings-                    (XNPat p)            -- Overall type of pattern. Might be+  | NPat            (XNPat p)            -- Overall type of pattern. Might be                                          -- different than the literal's type                                          -- if (==) or negate changes the type                     (XRec p (HsOverLit p))     -- ALWAYS positive@@ -189,12 +162,11 @@                                            -- otherwise                     (SyntaxExpr p)       -- Equality checker, of type t->t->Bool -  -- ^ Natural Pattern-  ---  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVal' @'+'@+  -- ^ Natural Pattern, used for all overloaded literals, including overloaded Strings+  -- with @-XOverloadedStrings@ -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern+  | -- | n+k pattern, e.g. @n+1@, used by @-XNPlusKPatterns@+   NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern                     (LIdP p)                 -- n+k pattern                     (XRec p (HsOverLit p))   -- It'll always be an HsIntegral                     (HsOverLit p)            -- See Note [NPlusK patterns] in GHC.Tc.Gen.Pat@@ -203,31 +175,30 @@                      (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool                     (SyntaxExpr p)   -- Name of '-' (see GHC.Rename.Env.lookupSyntax)-  -- ^ n+k pattern          ------------ Pattern type signatures ----------------  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon' -  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | SigPat          (XSigPat p)             -- After typechecker: Type                     (LPat p)                -- Pattern with a type signature                     (HsPatSigType (NoGhcTc p)) --  Signature can bind both                                                --  kind and type vars -    -- ^ Pattern with a type signature+   -- ^ Pattern with a type signature, e.g. @x :: Int@ -  -- Embed the syntax of types into patterns.-  -- Used with RequiredTypeArguments, e.g. fn (type t) = rhs-  | EmbTyPat        (XEmbTyPat p)+  | -- | Embed the syntax of types into patterns, e.g. @fn (type t) = rhs@.+    -- Enabled by @-XExplicitNamespaces@ in conjunction with @-XRequiredTypeArguments@.+    EmbTyPat        (XEmbTyPat p)                     (HsTyPat (NoGhcTc p)) -  -- See Note [Invisible binders in functions] in GHC.Hs.Pat   | InvisPat (XInvisPat p) (HsTyPat (NoGhcTc p))+  -- ^ Type abstraction which brings into scope type variables associated with invisible forall.+  -- E.g. @fn \@t ... = rhs@. Used by @-XTypeAbstractions@. -  -- Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension-  | XPat-      !(XXPat p)+  -- See Note [Invisible binders in functions] in GHC.Hs.Pat +  | -- | TTG Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension+    XPat !(XXPat p)+ type family ConLikeP x  @@ -266,11 +237,14 @@ data HsRecFields p arg         -- A bunch of record fields                                 --      { x = 3, y = True }         -- Used for both expressions and patterns-  = HsRecFields { rec_flds   :: [LHsRecField p arg],+  = HsRecFields { rec_ext    :: !(XHsRecFields p),+                  rec_flds   :: [LHsRecField p arg],                   rec_dotdot :: Maybe (XRec p RecFieldsDotDot) }  -- Note [DotDot fields]   -- AZ:The XRec for LHsRecField makes the derivings fail.   -- deriving (Functor, Foldable, Traversable) +type family XHsRecFields p+ -- | Newtype to be able to have a specific XRec instance for the Int in `rec_dotdot` newtype RecFieldsDotDot = RecFieldsDotDot { unRecFieldsDotDot :: Int }     deriving (Data, Eq, Ord)@@ -295,20 +269,16 @@ -- | Located Haskell Record Field type LHsRecField  p arg = XRec p (HsRecField  p arg) --- | Located Haskell Record Update Field-type LHsRecUpdField p q = XRec p (HsRecUpdField p q)- -- | Haskell Record Field type HsRecField p arg   = HsFieldBind (LFieldOcc p) arg +-- | Located Haskell Record Update Field+type LHsRecUpdField p q = XRec p (HsRecUpdField p q)+ -- | Haskell Record Update Field-type HsRecUpdField p q  = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr q)+type HsRecUpdField p q  = HsFieldBind (LFieldOcc p) (LHsExpr q)  -- | Haskell Field Binding------ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual',------ For details on above see Note [exact print annotations] in GHC.Parser.Annotation data HsFieldBind lhs rhs = HsFieldBind {         hfbAnn :: XHsFieldBind lhs,         hfbLHS :: lhs,@@ -371,11 +341,11 @@ -- -- See also Note [Disambiguating record updates] in GHC.Rename.Pat. -hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [XCFieldOcc p]+hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [IdP p] hsRecFields rbinds = Data.List.map (hsRecFieldSel . unXRec @p) (rec_flds rbinds)  hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg] hsRecFieldsArgs rbinds = Data.List.map (hfbRHS . unXRec @p) (rec_flds rbinds) -hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p-hsRecFieldSel = foExt . unXRec @p . hfbLHS+hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> IdP p+hsRecFieldSel = unXRec @p . foLabel . unXRec @p . hfbLHS
+ compiler/Language/Haskell/Syntax/Specificity.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE MultiWayIf, PatternSynonyms #-}++-- TODO Everthing in this module should be moved to+-- Language.Haskell.Syntax.Decls++module Language.Haskell.Syntax.Specificity (+        -- * ForAllTyFlags+        ForAllTyFlag(Invisible,Required,Specified,Inferred),+        Specificity(..),+        isVisibleForAllTyFlag, isInvisibleForAllTyFlag, isInferredForAllTyFlag,+        isSpecifiedForAllTyFlag,+        coreTyLamForAllTyFlag,+        ) where++import Prelude++import Data.Data++-- | ForAllTyFlag+--+-- Is something required to appear in source Haskell ('Required'),+-- permitted by request ('Specified') (visible type application), or+-- prohibited entirely from appearing in source Haskell ('Inferred')?+-- See Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in "GHC.Core.TyCo.Rep"+data ForAllTyFlag = Invisible !Specificity+                  | Required+  deriving (Eq, Ord, Data)+  -- (<) on ForAllTyFlag means "is less visible than"++-- | Whether an 'Invisible' argument may appear in source Haskell.+data Specificity = InferredSpec+                   -- ^ the argument may not appear in source Haskell, it is+                   -- only inferred.+                 | SpecifiedSpec+                   -- ^ the argument may appear in source Haskell, but isn't+                   -- required.+  deriving (Eq, Ord, Data)++pattern Inferred, Specified :: ForAllTyFlag+pattern Inferred  = Invisible InferredSpec+pattern Specified = Invisible SpecifiedSpec++{-# COMPLETE Required, Specified, Inferred #-}++-- | Does this 'ForAllTyFlag' classify an argument that is written in Haskell?+isVisibleForAllTyFlag :: ForAllTyFlag -> Bool+isVisibleForAllTyFlag af = not (isInvisibleForAllTyFlag af)++-- | Does this 'ForAllTyFlag' classify an argument that is not written in Haskell?+isInvisibleForAllTyFlag :: ForAllTyFlag -> Bool+isInvisibleForAllTyFlag (Invisible {}) = True+isInvisibleForAllTyFlag Required       = False++isInferredForAllTyFlag :: ForAllTyFlag -> Bool+-- More restrictive than isInvisibleForAllTyFlag+isInferredForAllTyFlag (Invisible InferredSpec) = True+isInferredForAllTyFlag _                        = False++isSpecifiedForAllTyFlag :: ForAllTyFlag -> Bool+-- More restrictive than isInvisibleForAllTyFlag+isSpecifiedForAllTyFlag (Invisible SpecifiedSpec) = True+isSpecifiedForAllTyFlag _                         = False++coreTyLamForAllTyFlag :: ForAllTyFlag+-- ^ The ForAllTyFlag on a (Lam a e) term, where `a` is a type variable.+-- If you want other ForAllTyFlag, use a cast.+-- See Note [Required foralls in Core] in GHC.Core.TyCo.Rep+coreTyLamForAllTyFlag = Specified
compiler/Language/Haskell/Syntax/Type.hs view
@@ -22,12 +22,16 @@ module Language.Haskell.Syntax.Type (         HsScaled(..),         hsMult, hsScaledThing,-        HsArrow(..), XUnrestrictedArrow, XLinearArrow, XExplicitMult, XXArrow,+        HsArrow, HsArrowOf(..), XUnrestrictedArrow, XLinearArrow, XExplicitMult, XXArrow,          HsType(..), LHsType, HsKind, LHsKind,         HsBndrVis(..), XBndrRequired, XBndrInvisible, XXBndrVis,+        HsBndrVar(..), XBndrVar, XBndrWildCard, XXBndrVar,+        HsBndrKind(..), XBndrKind, XBndrNoKind, XXBndrKind,         isHsBndrInvisible,-        HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr,+        isHsBndrWildCard,+        HsForAllTelescope(..),+        HsTyVarBndr(..), LHsTyVarBndr,         LHsQTyVars(..),         HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,         HsWildCardBndrs(..),@@ -43,15 +47,14 @@         LHsTypeArg,          LBangType, BangType,-        HsSrcBang(..),+        HsBang(..),         PromotionFlag(..), isPromoted,          ConDeclField(..), LConDeclField, -        HsConDetails(..), noTypeArgs, conDetailsArity,+        HsConDetails(..), noTypeArgs,          FieldOcc(..), LFieldOcc,-        AmbiguousFieldOcc(..), LAmbiguousFieldOcc,          mapHsOuterImplicit,         hsQTvExplicit,@@ -61,12 +64,10 @@  import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice ) +import Language.Haskell.Syntax.Basic ( HsBang(..) ) import Language.Haskell.Syntax.Extension+import Language.Haskell.Syntax.Specificity -import GHC.Types.Name.Reader ( RdrName )-import GHC.Core.DataCon( HsSrcBang(..) )-import GHC.Core.Type (Specificity)-import GHC.Types.Basic (Arity)  import GHC.Hs.Doc (LHsDoc) import GHC.Data.FastString (FastString)@@ -77,7 +78,8 @@ import Data.Eq import Data.Bool import Data.Char-import Prelude (Integer, length)+import Prelude (Integer)+import Data.Ord (Ord)  {- ************************************************************************@@ -91,7 +93,7 @@ data PromotionFlag   = NotPromoted   | IsPromoted-  deriving ( Eq, Data )+  deriving ( Eq, Data, Ord )  isPromoted :: PromotionFlag -> Bool isPromoted IsPromoted  = True@@ -294,28 +296,19 @@  -- | Located Haskell Context type LHsContext pass = XRec pass (HsContext pass)-      -- ^ 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnUnit'-      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation  -- | Haskell Context type HsContext pass = [LHsType pass]  -- | Located Haskell Type type LHsType pass = XRec pass (HsType pass)-      -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when-      --   in a list -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | Haskell Kind type HsKind pass = HsType pass  -- | Located Haskell Kind type LHsKind pass = XRec pass (HsKind pass)-      -- ^ 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon' -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -------------------------------------------------- --             LHsQTyVars --  The explicitly-quantified binders in a data/type declaration@@ -700,27 +693,12 @@ --------------------------------------------------  -- | Haskell Type Variable Binder--- The flag annotates the binder. It is 'Specificity' in places where--- explicit specificity is allowed (e.g. x :: forall {a} b. ...) or--- '()' in other places.+-- See Note [Type variable binders] data HsTyVarBndr flag pass-  = UserTyVar        -- no explicit kinding-         (XUserTyVar pass)-         flag-         (LIdP pass)-        -- See Note [Located RdrNames] in GHC.Hs.Expr--  | KindedTyVar-         (XKindedTyVar pass)-         flag-         (LIdP pass)-         (LHsKind pass)  -- The user-supplied kind signature-        -- ^-        --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',-        --          'GHC.Parser.Annotation.AnnDcolon', 'GHC.Parser.Annotation.AnnClose'--        -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-+  = HsTvb { tvb_ext  :: XTyVarBndr pass+          , tvb_flag :: flag+          , tvb_var  :: HsBndrVar pass+          , tvb_kind :: HsBndrKind pass }   | XTyVarBndr       !(XXTyVarBndr pass) @@ -735,7 +713,7 @@       --     type KindOf @k (a :: k) = k       --                ^^^ -  | XXBndrVis !(XXBndrVis pass)+  | XBndrVis !(XXBndrVis pass)  type family XBndrRequired  p type family XBndrInvisible p@@ -744,14 +722,111 @@ isHsBndrInvisible :: HsBndrVis pass -> Bool isHsBndrInvisible HsBndrInvisible{} = True isHsBndrInvisible HsBndrRequired{}  = False-isHsBndrInvisible (XXBndrVis _)     = False+isHsBndrInvisible (XBndrVis _)      = False +data HsBndrVar pass+  = HsBndrVar !(XBndrVar pass) !(LIdP pass)+  | HsBndrWildCard !(XBndrWildCard pass)+  | XBndrVar !(XXBndrVar pass)++type family XBndrVar p+type family XBndrWildCard p+type family XXBndrVar p++isHsBndrWildCard :: HsBndrVar pass -> Bool+isHsBndrWildCard HsBndrWildCard{} = True+isHsBndrWildCard HsBndrVar{}      = False+isHsBndrWildCard (XBndrVar _)     = False++data HsBndrKind pass+  = HsBndrKind   !(XBndrKind pass) (LHsKind pass)+  | HsBndrNoKind !(XBndrNoKind pass)+  | XBndrKind    !(XXBndrKind pass)++type family XBndrKind   p+type family XBndrNoKind p+type family XXBndrKind  p+ -- | Does this 'HsTyVarBndr' come with an explicit kind annotation? isHsKindedTyVar :: HsTyVarBndr flag pass -> Bool-isHsKindedTyVar (UserTyVar {})   = False-isHsKindedTyVar (KindedTyVar {}) = True-isHsKindedTyVar (XTyVarBndr {})  = False+isHsKindedTyVar (HsTvb { tvb_kind = kind }) =+  case kind of+    HsBndrKind _ _ -> True+    HsBndrNoKind _ -> False+    XBndrKind    _ -> False+isHsKindedTyVar (XTyVarBndr {}) = False ++{- Note [Type variable binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Type variable binders, represented by the HsTyVarBndr type, can occur in the+following contexts:++1. On the left-hand sides of type/class declarations (TyClDecl)++      data D a b = ...       -- data types     (DataDecl)+      newtype N a b = ...    -- newtypes       (DataDecl)+      type T a b = ...       -- type synonyms  (SynDecl)+      class C a b where ...  -- classes        (ClassDecl)+      type family TF a b     -- type families  (FamDecl)+      data family DF a b     -- data families  (FamDecl)++   The `a` and `b` in these examples are type variable binders.++2. In forall telescopes (HsForAllTy and HsOuterTyVarBndrs)++    2-Invis. forall {a} b. ...    -- invisible forall (HsForAllInvis)+    2-Vis.   forall a b -> ...    -- visible forall   (HsForAllVis)++   Again, `a` and `b` are type variable binders.++3. In type family result signatures (FamilyResultSig), which are+   part of the TypeFamilyDependencies extension++      type family F a = r | r -> a  -- result sig (TyVarSig)++   The `r` immediately to the right of `=` is a type variable binder.++4. In constructor patterns, as long as the conditions outlined in+   Note [Type patterns: binders and unifiers] are satisfied++      fn (MkT @a @b x y) = ...  -- type arguments (HsConPatTyArg)+                                -- in constructor patterns (ConPat)++   Here, the `a` and `b` are type variable binders iff+   `GHC.Tc.Gen.HsType.tyPatToBndr` returns `Just`.++A type variable binder has three parts:+  * flag      (HsBndrVis, Specificity, or () -- depending on context)+  * variable  (HsBndrVar)+  * kind      (HsBndrKind)++Details about each part:++* The binder variable (HsBndrVar) is either a type variable name or a wildcard,+  i.e. `a` vs `_` (HsBndrVar vs HsBndrWildCard).++* The binder kind (HsBndrKind) stores the optional kind annotation,+  i.e. `a` vs `a :: k` (HsBndrNoKind vs HsBndrKind).++* The binder flag is instantiated to one of the following types,+  depending on the context where it occurs (contexts 1..4 are listed above)++    (a) flag=HsBndrVis records `a` vs `@a` (HsBndrRequired vs HsBndrInvisible)+          (used in contexts: 1)+    (b) flag=Specificity records `a` vs `{a}` (SpecifiedSpec vs InferredSpec)+          (used in contexts: 2-Invis)+    (c) flag=() is used when there is no distinction to record+          (used in contexts: 2-Vis, 3, 4)++All in all, we have the following forms of type variable binders in the language++  a, (a :: k), @a, @(a :: k), {a}, {a :: k}+  _, (_ :: k), @_, @(_ :: k)++The forms {_}, {_ :: k} are representable but never valid, see+Note [Wildcard binders in disallowed contexts] in GHC.Hs.Type -}+ -- | Haskell Type data HsType pass   = HsForAllTy   -- See Note [HsType binders]@@ -760,9 +835,6 @@                                      -- Explicit, user-supplied 'forall a {b} c'       , hst_body    :: LHsType pass  -- body type       }-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnForall',-      --         'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'-      -- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"    | HsQualTy   -- See Note [HsType binders]       { hst_xqual :: XQualTy pass@@ -776,17 +848,11 @@                   -- Type variable, type constructor, or data constructor                   -- see Note [Promotions (HsTyVar)]                   -- See Note [Located RdrNames] in GHC.Hs.Expr-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsAppTy             (XAppTy pass)                         (LHsType pass)                         (LHsType pass)-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsAppKindTy         (XAppKindTy pass) -- type level type app                         (LHsType pass)                         (LHsKind pass)@@ -795,134 +861,72 @@                         (HsArrow pass)                         (LHsType pass)   -- function type                         (LHsType pass)-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow', -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsListTy            (XListTy pass)                         (LHsType pass)  -- Element type-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,-      --         'GHC.Parser.Annotation.AnnClose' @']'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsTupleTy           (XTupleTy pass)                         HsTupleSort                         [LHsType pass]  -- Element types (length gives arity)-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(' or '(#'@,-    --         'GHC.Parser.Annotation.AnnClose' @')' or '#)'@ -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsSumTy             (XSumTy pass)                         [LHsType pass]  -- Element types (length gives arity)-    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@,-    --         'GHC.Parser.Annotation.AnnClose' '#)'@ -    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsOpTy              (XOpTy pass)                         PromotionFlag    -- Whether explicitly promoted,                                          -- for the pretty printer                         (LHsType pass) (LIdP pass) (LHsType pass)-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsParTy             (XParTy pass)                         (LHsType pass)   -- See Note [Parens in HsSyn] in GHC.Hs.Expr         -- Parenthesis preserved for the precedence re-arrangement in         -- GHC.Rename.HsType         -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,-      --         'GHC.Parser.Annotation.AnnClose' @')'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsIParamTy          (XIParamTy pass)                         (XRec pass HsIPName) -- (?x :: ty)                         (LHsType pass)   -- Implicit parameters as they occur in                                          -- contexts       -- ^       -- > (?x :: ty)-      ---      -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon' -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsStarTy            (XStarTy pass)                         Bool             -- Is this the Unicode variant?                                          -- Note [HsStarTy]-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None    | HsKindSig           (XKindSig pass)                         (LHsType pass)  -- (ty :: kind)                         (LHsKind pass)  -- A type with a kind signature       -- ^       -- > (ty :: kind)-      ---      -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,-      --         'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose' @')'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsSpliceTy          (XSpliceTy pass)                         (HsUntypedSplice pass)   -- Includes quasi-quotes-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@,-      --         'GHC.Parser.Annotation.AnnClose' @')'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsDocTy             (XDocTy pass)                         (LHsType pass) (LHsDoc pass) -- A documented type-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation--  | HsBangTy    (XBangTy pass)-                HsSrcBang (LHsType pass)   -- Bang-style type annotations-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :-      --         'GHC.Parser.Annotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,-      --         'GHC.Parser.Annotation.AnnClose' @'#-}'@-      --         'GHC.Parser.Annotation.AnnBang' @\'!\'@--      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation+  | HsBangTy    (XBangTy pass)          -- Contains the SourceText in GHC passes.+                HsBang (LHsType pass)   -- Bang-style type annotations    | HsRecTy     (XRecTy pass)                 [LConDeclField pass]    -- Only in data type declarations-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,-      --         'GHC.Parser.Annotation.AnnClose' @'}'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsExplicitListTy       -- A promoted explicit list         (XExplicitListTy pass)         PromotionFlag      -- whether explicitly promoted, for pretty printer         [LHsType pass]-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'["@,-      --         'GHC.Parser.Annotation.AnnClose' @']'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsExplicitTupleTy      -- A promoted explicit tuple         (XExplicitTupleTy pass)+        PromotionFlag      -- whether explicitly promoted, for pretty printer         [LHsType pass]-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'("@,-      --         'GHC.Parser.Annotation.AnnClose' @')'@ -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsTyLit (XTyLit pass) (HsTyLit pass)      -- A promoted numeric literal.-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   | HsWildCardTy (XWildCardTy pass)  -- A type wildcard       -- See Note [The wildcard story for types]-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation-   -- Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension   | XHsType       !(XXType pass)@@ -935,26 +939,28 @@   | HsCharTy (XCharTy pass) Char   | XTyLit   !(XXTyLit pass) +type HsArrow pass = HsArrowOf (LHsType pass) pass+ -- | Denotes the type of arrows in the surface language-data HsArrow pass-  = HsUnrestrictedArrow !(XUnrestrictedArrow pass)+data HsArrowOf mult pass+  = HsUnrestrictedArrow !(XUnrestrictedArrow mult pass)     -- ^ a -> b or a → b -  | HsLinearArrow !(XLinearArrow pass)+  | HsLinearArrow !(XLinearArrow mult pass)     -- ^ a %1 -> b or a %1 → b, or a ⊸ b -  | HsExplicitMult !(XExplicitMult pass) !(LHsType pass)+  | HsExplicitMult !(XExplicitMult mult pass) !mult     -- ^ a %m -> b or a %m → b (very much including `a %Many -> b`!     -- This is how the programmer wrote it). It is stored as an     -- `HsType` so as to preserve the syntax as written in the     -- program. -  | XArrow !(XXArrow pass)+  | XArrow !(XXArrow mult pass) -type family XUnrestrictedArrow p-type family XLinearArrow       p-type family XExplicitMult      p-type family XXArrow            p+type family XUnrestrictedArrow mult p+type family XLinearArrow       mult p+type family XExplicitMult      mult p+type family XXArrow            mult p  -- | This is used in the syntax. In constructor declaration. It must keep the -- arrow representation.@@ -1006,7 +1012,7 @@ wrote '*' or 'Type', and lose the parse/ppr roundtrip property.  As a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type')-and then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type).+and then desugar it to 'Data.Kind.Type' in the typechecker (see tcHsType). When '*' is a regular type operator (StarIsType is disabled), HsStarTy is not involved. @@ -1063,11 +1069,7 @@  -- | Located Constructor Declaration Field type LConDeclField pass = XRec pass (ConDeclField pass)-      -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when-      --   in a list -      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation- -- | Constructor Declaration Field data ConDeclField pass  -- Record fields have Haddock docs on them   = ConDeclField { cd_fld_ext  :: XConDeclField pass,@@ -1075,9 +1077,6 @@                                    -- ^ See Note [ConDeclField pass]                    cd_fld_type :: LBangType pass,                    cd_fld_doc  :: Maybe (LHsDoc pass)}-      -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'--      -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation   | XConDeclField !(XXConDeclField pass)  -- | Describes the arguments to a data constructor. This is a common@@ -1107,12 +1106,6 @@ noTypeArgs :: [Void] noTypeArgs = [] -conDetailsArity :: (rec -> Arity) -> HsConDetails tyarg arg rec -> Arity-conDetailsArity recToArity = \case-  PrefixCon _ args -> length args-  RecCon rec -> recToArity rec-  InfixCon _ _ -> 2- {- Note [ConDeclField pass] ~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1285,37 +1278,22 @@ -- We store both the 'RdrName' the user originally wrote, and after -- the renamer we use the extension field to store the selector -- function.+--+-- There is a wrinkle in that update field occurances are sometimes+-- ambiguous during the rename stage. See note+-- [Ambiguous FieldOcc in record updates] to see how we currently+-- handle this. data FieldOcc pass   = FieldOcc {         foExt :: XCFieldOcc pass-      , foLabel :: XRec pass RdrName -- See Note [Located RdrNames] in Language.Haskell.Syntax.Expr+      , foLabel :: LIdP pass       }   | XFieldOcc !(XXFieldOcc pass) deriving instance (-    Eq (XRec pass RdrName)+    Eq (LIdP pass)   , Eq (XCFieldOcc pass)   , Eq (XXFieldOcc pass)   ) => Eq (FieldOcc pass)---- | Located Ambiguous Field Occurrence-type LAmbiguousFieldOcc pass = XRec pass (AmbiguousFieldOcc pass)---- | Ambiguous Field Occurrence------ Represents an *occurrence* of a field that is potentially--- ambiguous after the renamer, with the ambiguity resolved by the--- typechecker.  We always store the 'RdrName' that the user--- originally wrote, and store the selector function after the renamer--- (for unambiguous occurrences) or the typechecker (for ambiguous--- occurrences).------ See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat".--- See Note [Located RdrNames] in "GHC.Hs.Expr".-data AmbiguousFieldOcc pass-  = Unambiguous (XUnambiguous pass) (XRec pass RdrName)-  | Ambiguous   (XAmbiguous pass)   (XRec pass RdrName)-  | XAmbiguousFieldOcc !(XXAmbiguousFieldOcc pass)-  {- ************************************************************************
compiler/Language/Haskell/Syntax/Type.hs-boot view
@@ -2,6 +2,7 @@  import Data.Bool import Data.Eq+import Data.Ord  {- ************************************************************************@@ -17,5 +18,6 @@   | IsPromoted  instance Eq PromotionFlag+instance Ord PromotionFlag  isPromoted :: PromotionFlag -> Bool
compiler/cbits/genSym.c view
@@ -9,19 +9,7 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built.--#if MIN_VERSION_GLASGOW_HASKELL(9,9,0,0)-// Unique64 patch was present in 9.10 and later-#define HAVE_UNIQUE64 1-#elif !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) && MIN_VERSION_GLASGOW_HASKELL(9,8,4,0)-// Unique64 patch was backported to 9.8.4-#define HAVE_UNIQUE64 1-#elif !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) && MIN_VERSION_GLASGOW_HASKELL(9,6,7,0)-// Unique64 patch was backported to 9.6.7-#define HAVE_UNIQUE64 1-#endif--#if !defined(HAVE_UNIQUE64)+#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
compiler/ghc.cabal view
@@ -3,7 +3,7 @@ -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.  Name: ghc-Version: 9.10.3+Version: 9.12.1 License: BSD-3-Clause License-File: LICENSE Author: The GHC Team@@ -82,6 +82,15 @@     Default: False     Manual: True +Flag bootstrap+        Description:+          Enabled when building the stage1 compiler in order to vendor the in-tree+          `ghc-boot-th` library, and through that the in-tree TH AST defintions from+          `ghc-internal`.+          See Note [Bootstrapping Template Haskell]+        Default: False+        Manual: True+ Library     Default-Language: GHC2021     Exposed: False@@ -105,26 +114,33 @@         extra-libraries: zstd       CPP-Options: -DHAVE_LIBZSTD -    Build-Depends: base       >= 4.11 && < 4.21,+    Build-Depends: base       >= 4.11 && < 4.22,                    deepseq    >= 1.4 && < 1.6,                    directory  >= 1   && < 1.4,                    process    >= 1   && < 1.7,                    bytestring >= 0.11 && < 0.13,                    binary     == 0.8.*,-                   time       >= 1.4 && < 1.13,+                   time       >= 1.4 && < 1.15,                    containers >= 0.6.2.1 && < 0.8,                    array      >= 0.1 && < 0.6,-                   filepath   >= 1   && < 1.6,-                   template-haskell == 2.22.*,+                   filepath   >= 1.5 && < 1.6,+                   os-string  >= 2.0.1 && < 2.1,                    hpc        >= 0.6 && < 0.8,                    transformers >= 0.5 && < 0.7,                    exceptions == 0.10.*,                    semaphore-compat,                    stm,-                   ghc-boot   == 9.10.3,-                   ghc-heap   == 9.10.3,-                   ghci == 9.10.3+                   ghc-boot   == 9.12.1,+                   ghc-heap   == 9.12.1,+                   ghci == 9.12.1 +    if flag(bootstrap)+      Build-Depends:+        ghc-boot-th-next     == 9.12.1+    else+      Build-Depends:+        ghc-boot-th          == 9.12.1+     if os(windows)         Build-Depends: Win32  >= 2.3 && < 2.15     else@@ -245,6 +261,7 @@         GHC.Cmm.Switch         GHC.Cmm.Switch.Implement         GHC.Cmm.ThreadSanitizer+        GHC.Cmm.UniqueRenamer         GHC.CmmToAsm         GHC.Cmm.LRegSet         GHC.CmmToAsm.AArch64@@ -290,6 +307,7 @@         GHC.CmmToAsm.Reg.Linear.FreeRegs         GHC.CmmToAsm.Reg.Linear.JoinToTargets         GHC.CmmToAsm.Reg.Linear.PPC+        GHC.CmmToAsm.Reg.Linear.RV64         GHC.CmmToAsm.Reg.Linear.StackMap         GHC.CmmToAsm.Reg.Linear.State         GHC.CmmToAsm.Reg.Linear.Stats@@ -298,6 +316,13 @@         GHC.CmmToAsm.Reg.Liveness         GHC.CmmToAsm.Reg.Target         GHC.CmmToAsm.Reg.Utils+        GHC.CmmToAsm.RV64+        GHC.CmmToAsm.RV64.CodeGen+        GHC.CmmToAsm.RV64.Cond+        GHC.CmmToAsm.RV64.Instr+        GHC.CmmToAsm.RV64.Ppr+        GHC.CmmToAsm.RV64.RegInfo+        GHC.CmmToAsm.RV64.Regs         GHC.CmmToAsm.Types         GHC.CmmToAsm.Utils         GHC.CmmToAsm.X86@@ -429,6 +454,7 @@         GHC.Data.List.SetOps         GHC.Data.Maybe         GHC.Data.OrdList+        GHC.Data.OsPath         GHC.Data.Pair         GHC.Data.SmallArray         GHC.Data.Stream@@ -506,6 +532,7 @@         GHC.Driver.Ppr         GHC.Driver.Session         GHC.Hs+        GHC.Hs.Basic         GHC.Hs.Binds         GHC.Hs.Decls         GHC.Hs.Doc@@ -518,6 +545,7 @@         GHC.Hs.Instances         GHC.Hs.Lit         GHC.Hs.Pat+        GHC.Hs.Specificity         GHC.Hs.Stats         GHC.HsToCore         GHC.HsToCore.Arrows@@ -577,6 +605,7 @@         GHC.Iface.Syntax         GHC.Iface.Tidy         GHC.Iface.Tidy.StaticPtrTable+        GHC.Iface.Warnings         GHC.IfaceToCore         GHC.Iface.Type         GHC.JS.Ident@@ -617,6 +646,7 @@         GHC.Parser.HaddockLex         GHC.Parser.PostProcess         GHC.Parser.PostProcess.Haddock+        GHC.Parser.String         GHC.Parser.Types         GHC.Parser.Utils         GHC.Platform@@ -629,6 +659,9 @@         GHC.Platform.Profile         GHC.Platform.Reg         GHC.Platform.Reg.Class+        GHC.Platform.Reg.Class.NoVectors+        GHC.Platform.Reg.Class.Separate+        GHC.Platform.Reg.Class.Unified         GHC.Platform.Regs         GHC.Platform.RISCV64         GHC.Platform.S390X@@ -661,6 +694,7 @@         GHC.Runtime.Interpreter.JS         GHC.Runtime.Interpreter.Process         GHC.Runtime.Interpreter.Types+        GHC.Runtime.Interpreter.Wasm         GHC.Runtime.Loader         GHC.Runtime.Utils         GHC.Settings@@ -681,6 +715,7 @@         GHC.Stg.InferTags.Rewrite         GHC.Stg.InferTags.TagSig         GHC.Stg.InferTags.Types+        GHC.Stg.Make         GHC.Stg.Pipeline         GHC.Stg.Stats         GHC.Stg.Subst@@ -806,7 +841,7 @@         GHC.Tc.Types.EvTerm         GHC.Tc.Types.Origin         GHC.Tc.Types.Rank-        GHC.Tc.Types.CtLocEnv+        GHC.Tc.Types.CtLoc         GHC.Tc.Types.ErrCtxt         GHC.Tc.Types.LclEnv         GHC.Tc.Types.TH@@ -834,6 +869,7 @@         GHC.Types.CostCentre         GHC.Types.CostCentre.State         GHC.Types.Cpr+        GHC.Types.DefaultEnv         GHC.Types.Demand         GHC.Types.Error         GHC.Types.Error.Codes@@ -868,6 +904,7 @@         GHC.Types.SourceError         GHC.Types.SourceFile         GHC.Types.SourceText+        GHC.Types.SptEntry         GHC.Types.SrcLoc         GHC.Types.Target         GHC.Types.Tickish@@ -876,6 +913,7 @@         GHC.Types.Unique         GHC.Types.Unique.DFM         GHC.Types.Unique.DSet+        GHC.Types.Unique.DSM         GHC.Types.Unique.FM         GHC.Types.Unique.Map         GHC.Types.Unique.MemoFun@@ -959,6 +997,7 @@         Language.Haskell.Syntax.Lit         Language.Haskell.Syntax.Module.Name         Language.Haskell.Syntax.Pat+        Language.Haskell.Syntax.Specificity         Language.Haskell.Syntax.Type      autogen-modules: GHC.Platform.Constants
ghc-lib-parser.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: ghc-lib-parser-version: 9.10.3.20250912+version: 9.12.1.20241218 license: BSD-3-Clause license-file: LICENSE category: Development@@ -45,6 +45,7 @@     ghc-lib/stage0/compiler/build/primop-docs.hs-incl     ghc-lib/stage0/compiler/build/primop-is-work-free.hs-incl     ghc-lib/stage0/compiler/build/primop-is-cheap.hs-incl+    ghc-lib/stage0/compiler/build/primop-deprecations.hs-incl     ghc-lib/stage0/compiler/build/GHC/Platform/Constants.hs     ghc-lib/stage0/compiler/build/GHC/Settings/Config.hs     ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs@@ -91,21 +92,22 @@     if flag(threaded-rts)         ghc-options: -fobject-code -package=ghc-boot-th -optc-DTHREADED_RTS         cc-options: -DTHREADED_RTS-        cpp-options: -DTHREADED_RTS+        cpp-options: -DTHREADED_RTS   -DBOOTSTRAP_TH     else         ghc-options: -fobject-code -package=ghc-boot-th-        cpp-options:+        cpp-options:   -DBOOTSTRAP_TH     if !os(windows)         build-depends: unix     else         build-depends: Win32     build-depends:-        base >= 4.18 && < 4.21,-        ghc-prim > 0.2 && < 0.13,+        base >= 4.19 && < 4.22,+        ghc-prim > 0.2 && < 0.14,         containers >= 0.6.2.1 && < 0.8,         bytestring >= 0.11.4 && < 0.13,         time >= 1.4 && < 1.15,-        filepath >= 1 && < 1.6,+        filepath >= 1.5 && < 1.6,+        os-string >= 2.0.1 && < 2.1,         exceptions == 0.10.*,         parsec,         binary == 0.8.*,@@ -152,7 +154,6 @@         UnboxedTuples         UndecidableInstances     default-extensions:-        ImplicitPrelude         MonoLocalBinds         NoImplicitPrelude     if impl(ghc >= 9.2.2)@@ -185,6 +186,7 @@         GHC.Builtin.PrimOps         GHC.Builtin.PrimOps.Ids         GHC.Builtin.Types+        GHC.Builtin.Types.Literals         GHC.Builtin.Types.Prim         GHC.Builtin.Uniques         GHC.ByteCode.Types@@ -200,8 +202,11 @@         GHC.Cmm.Reg         GHC.Cmm.Switch         GHC.Cmm.Type+        GHC.Cmm.Utils         GHC.CmmToAsm.CFG.Weight         GHC.CmmToLlvm.Config+        GHC.CmmToLlvm.Version+        GHC.CmmToLlvm.Version.Bounds         GHC.CmmToLlvm.Version.Type         GHC.Core         GHC.Core.Class@@ -277,6 +282,7 @@         GHC.Data.List.SetOps         GHC.Data.Maybe         GHC.Data.OrdList+        GHC.Data.OsPath         GHC.Data.Pair         GHC.Data.ShortText         GHC.Data.SizedSeq@@ -338,6 +344,7 @@         GHC.ForeignSrcLang         GHC.ForeignSrcLang.Type         GHC.Hs+        GHC.Hs.Basic         GHC.Hs.Binds         GHC.Hs.Decls         GHC.Hs.Doc@@ -349,6 +356,7 @@         GHC.Hs.Instances         GHC.Hs.Lit         GHC.Hs.Pat+        GHC.Hs.Specificity         GHC.Hs.Type         GHC.Hs.Utils         GHC.HsToCore.Errors.Ppr@@ -387,6 +395,7 @@         GHC.Parser.Lexer         GHC.Parser.PostProcess         GHC.Parser.PostProcess.Haddock+        GHC.Parser.String         GHC.Parser.Types         GHC.Platform         GHC.Platform.AArch64@@ -400,6 +409,9 @@         GHC.Platform.RISCV64         GHC.Platform.Reg         GHC.Platform.Reg.Class+        GHC.Platform.Reg.Class.NoVectors+        GHC.Platform.Reg.Class.Separate+        GHC.Platform.Reg.Class.Unified         GHC.Platform.Regs         GHC.Platform.S390X         GHC.Platform.Wasm32@@ -420,10 +432,12 @@         GHC.Stg.InferTags.TagSig         GHC.Stg.Lift.Types         GHC.Stg.Syntax+        GHC.StgToCmm.CgUtils         GHC.StgToCmm.Config         GHC.StgToCmm.Types         GHC.StgToJS.Linker.Types         GHC.StgToJS.Object+        GHC.StgToJS.Symbols         GHC.StgToJS.Types         GHC.SysTools.BaseDir         GHC.SysTools.Terminal@@ -437,7 +451,7 @@         GHC.Tc.Types         GHC.Tc.Types.BasicTypes         GHC.Tc.Types.Constraint-        GHC.Tc.Types.CtLocEnv+        GHC.Tc.Types.CtLoc         GHC.Tc.Types.ErrCtxt         GHC.Tc.Types.Evidence         GHC.Tc.Types.LclEnv@@ -455,6 +469,7 @@         GHC.Types.CostCentre         GHC.Types.CostCentre.State         GHC.Types.Cpr+        GHC.Types.DefaultEnv         GHC.Types.Demand         GHC.Types.Error         GHC.Types.Error.Codes@@ -488,6 +503,7 @@         GHC.Types.SourceError         GHC.Types.SourceFile         GHC.Types.SourceText+        GHC.Types.SptEntry         GHC.Types.SrcLoc         GHC.Types.Target         GHC.Types.Tickish@@ -496,6 +512,7 @@         GHC.Types.TypeEnv         GHC.Types.Unique         GHC.Types.Unique.DFM+        GHC.Types.Unique.DSM         GHC.Types.Unique.DSet         GHC.Types.Unique.FM         GHC.Types.Unique.Map@@ -577,12 +594,17 @@         Language.Haskell.Syntax.Lit         Language.Haskell.Syntax.Module.Name         Language.Haskell.Syntax.Pat+        Language.Haskell.Syntax.Specificity         Language.Haskell.Syntax.Type-        Language.Haskell.TH-        Language.Haskell.TH.LanguageExtensions-        Language.Haskell.TH.Lib-        Language.Haskell.TH.Lib.Internal-        Language.Haskell.TH.Lib.Map-        Language.Haskell.TH.Ppr-        Language.Haskell.TH.PprLib-        Language.Haskell.TH.Syntax+    if impl(ghc < 9.12.1)+      hs-source-dirs:+        libraries/ghc-internal/src+        libraries/ghc-boot-th-internal+      exposed-modules:+            GHC.Internal.ForeignSrcLang+            GHC.Internal.LanguageExtensions+            GHC.Internal.Lexeme+            GHC.Internal.TH.Syntax+            GHC.Internal.TH.Ppr+            GHC.Internal.TH.PprLib+            GHC.Internal.TH.Lib.Map
ghc-lib/stage0/compiler/build/GHC/Settings/Config.hs view
@@ -22,10 +22,10 @@ cProjectName          = "The Glorious Glasgow Haskell Compilation System"  cBooterVersion        :: String-cBooterVersion        = "9.10.1"+cBooterVersion        = "9.12.1"  cStage                :: String cStage                = show (1 :: Int)  cProjectUnitId :: String-cProjectUnitId = "ghc-9.10.3-inplace"+cProjectUnitId = "ghc-9.12.1-inplace"
ghc-lib/stage0/compiler/build/primop-commutable.hs-incl view
@@ -47,10 +47,14 @@ commutableOp WordXorOp = True commutableOp DoubleEqOp = True commutableOp DoubleNeOp = True+commutableOp DoubleMinOp = True+commutableOp DoubleMaxOp = True commutableOp DoubleAddOp = True commutableOp DoubleMulOp = True commutableOp FloatEqOp = True commutableOp FloatNeOp = True+commutableOp FloatMinOp = True+commutableOp FloatMaxOp = True commutableOp FloatAddOp = True commutableOp FloatMulOp = True commutableOp (VecAddOp _ _ _) = True
ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl view
@@ -264,6 +264,8 @@    | DoubleNeOp    | DoubleLtOp    | DoubleLeOp+   | DoubleMinOp+   | DoubleMaxOp    | DoubleAddOp    | DoubleSubOp    | DoubleMulOp@@ -300,6 +302,8 @@    | FloatNeOp    | FloatLtOp    | FloatLeOp+   | FloatMinOp+   | FloatMaxOp    | FloatAddOp    | FloatSubOp    | FloatMulOp@@ -374,6 +378,8 @@    | NewAlignedPinnedByteArrayOp_Char    | MutableByteArrayIsPinnedOp    | ByteArrayIsPinnedOp+   | ByteArrayIsWeaklyPinnedOp+   | MutableByteArrayIsWeaklyPinnedOp    | ByteArrayContents_Char    | MutableByteArrayContents_Char    | ShrinkMutableByteArrayOp_Char@@ -692,7 +698,6 @@    | ReallyUnsafePtrEqualityOp    | ParOp    | SparkOp-   | SeqOp    | GetSparkOp    | NumSparks    | KeepAliveOp@@ -737,6 +742,13 @@    | VecIndexScalarOffAddrOp PrimOpVecCat Length Width    | VecReadScalarOffAddrOp PrimOpVecCat Length Width    | VecWriteScalarOffAddrOp PrimOpVecCat Length Width+   | VecFMAdd PrimOpVecCat Length Width+   | VecFMSub PrimOpVecCat Length Width+   | VecFNMAdd PrimOpVecCat Length Width+   | VecFNMSub PrimOpVecCat Length Width+   | VecShuffleOp PrimOpVecCat Length Width+   | VecMinOp PrimOpVecCat Length Width+   | VecMaxOp PrimOpVecCat Length Width    | PrefetchByteArrayOp3    | PrefetchMutableByteArrayOp3    | PrefetchAddrOp3
+ ghc-lib/stage0/compiler/build/primop-deprecations.hs-incl view
@@ -0,0 +1,7 @@+primOpDeprecations =+  [ (mkVarOcc "sizeofSmallMutableArray#", fsLit " Use 'getSizeofSmallMutableArray#' instead ")+  , (mkVarOcc "sizeofMutableByteArray#", fsLit " Use 'getSizeofMutableByteArray#' instead ")+  , (mkVarOcc "dataToTagSmall#", fsLit " Use dataToTag# from \\\"GHC.Magic\\\" instead. ")+  , (mkVarOcc "dataToTagLarge#", fsLit " Use dataToTag# from \\\"GHC.Magic\\\" instead. ")+  , (mkVarOcc "void#", fsLit " Use an unboxed unit tuple instead ")+  ]
ghc-lib/stage0/compiler/build/primop-docs.hs-incl view
@@ -1,1080 +1,1197 @@ primOpDocs =-  [ ("*#","Low word of signed integer multiply.")-  , ("timesInt2#","Return a triple (isHighNeeded,high,low) where high and low are respectively\n   the high and low bits of the double-word result. isHighNeeded is a cheap way\n   to test if the high word is a sign-extension of the low word (isHighNeeded =\n   0#) or not (isHighNeeded = 1#).")-  , ("mulIntMayOflo#","Return non-zero if there is any possibility that the upper word of a\n    signed integer multiply might contain useful information.  Return\n    zero only if you are completely sure that no overflow can occur.\n    On a 32-bit platform, the recommended implementation is to do a\n    32 x 32 -> 64 signed multiply, and subtract result[63:32] from\n    (result[31] >>signed 31).  If this is zero, meaning that the\n    upper word is merely a sign extension of the lower one, no\n    overflow can occur.\n\n    On a 64-bit platform it is not always possible to\n    acquire the top 64 bits of the result.  Therefore, a recommended\n    implementation is to take the absolute value of both operands, and\n    return 0 iff bits[63:31] of them are zero, since that means that their\n    magnitudes fit within 31 bits, so the magnitude of the product must fit\n    into 62 bits.\n\n    If in doubt, return non-zero, but do make an effort to create the\n    correct answer for small args, since otherwise the performance of\n    @(*) :: Integer -> Integer -> Integer@ will be poor.\n   ")-  , ("quotInt#","Rounds towards zero. The behavior is undefined if the second argument is\n    zero.\n   ")-  , ("remInt#","Satisfies @('quotInt#' x y) '*#' y '+#' ('remInt#' x y) == x@. The\n    behavior is undefined if the second argument is zero.\n   ")-  , ("quotRemInt#","Rounds towards zero.")-  , ("andI#","Bitwise \"and\".")-  , ("orI#","Bitwise \"or\".")-  , ("xorI#","Bitwise \"xor\".")-  , ("notI#","Bitwise \"not\", also known as the binary complement.")-  , ("negateInt#","Unary negation.\n    Since the negative 'Int#' range extends one further than the\n    positive range, 'negateInt#' of the most negative number is an\n    identity operation. This way, 'negateInt#' is always its own inverse.")-  , ("addIntC#","Add signed integers reporting overflow.\n          First member of result is the sum truncated to an 'Int#';\n          second member is zero if the true sum fits in an 'Int#',\n          nonzero if overflow occurred (the sum is either too large\n          or too small to fit in an 'Int#').")-  , ("subIntC#","Subtract signed integers reporting overflow.\n          First member of result is the difference truncated to an 'Int#';\n          second member is zero if the true difference fits in an 'Int#',\n          nonzero if overflow occurred (the difference is either too large\n          or too small to fit in an 'Int#').")-  , ("int2Float#","Convert an 'Int#' to the corresponding 'Float#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'int2Float#' 1# == 1.0#@")-  , ("int2Double#","Convert an 'Int#' to the corresponding 'Double#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'int2Double#' 1# == 1.0##@")-  , ("word2Float#","Convert an 'Word#' to the corresponding 'Float#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'word2Float#' 1## == 1.0#@")-  , ("word2Double#","Convert an 'Word#' to the corresponding 'Double#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'word2Double#' 1## == 1.0##@")-  , ("uncheckedIShiftL#","Shift left.  Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")-  , ("uncheckedIShiftRA#","Shift right arithmetic.  Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")-  , ("uncheckedIShiftRL#","Shift right logical.  Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")-  , ("addWordC#","Add unsigned integers reporting overflow.\n          The first element of the pair is the result.  The second element is\n          the carry flag, which is nonzero on overflow. See also 'plusWord2#'.")-  , ("subWordC#","Subtract unsigned integers reporting overflow.\n          The first element of the pair is the result.  The second element is\n          the carry flag, which is nonzero on overflow.")-  , ("plusWord2#","Add unsigned integers, with the high part (carry) in the first\n          component of the returned pair and the low part in the second\n          component of the pair. See also 'addWordC#'.")-  , ("quotRemWord2#"," Takes high word of dividend, then low word of dividend, then divisor.\n           Requires that high word < divisor.")-  , ("uncheckedShiftL#","Shift left logical.   Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")-  , ("uncheckedShiftRL#","Shift right logical.   Result undefined if shift  amount is not\n          in the range 0 to word size - 1 inclusive.")-  , ("popCnt8#","Count the number of set bits in the lower 8 bits of a word.")-  , ("popCnt16#","Count the number of set bits in the lower 16 bits of a word.")-  , ("popCnt32#","Count the number of set bits in the lower 32 bits of a word.")-  , ("popCnt64#","Count the number of set bits in a 64-bit word.")-  , ("popCnt#","Count the number of set bits in a word.")-  , ("pdep8#","Deposit bits to lower 8 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pdep16#","Deposit bits to lower 16 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pdep32#","Deposit bits to lower 32 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pdep64#","Deposit bits to a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pdep#","Deposit bits to a word at locations specified by a mask, aka\n    [parallel bit deposit](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract).\n\n    Software emulation:\n\n    > pdep :: Word -> Word -> Word\n    > pdep src mask = go 0 src mask\n    >   where\n    >     go :: Word -> Word -> Word -> Word\n    >     go result _ 0 = result\n    >     go result src mask = go newResult newSrc newMask\n    >       where\n    >         maskCtz   = countTrailingZeros mask\n    >         newResult = if testBit src 0 then setBit result maskCtz else result\n    >         newSrc    = src `shiftR` 1\n    >         newMask   = clearBit mask maskCtz\n\n    @since 0.5.2.0")-  , ("pext8#","Extract bits from lower 8 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pext16#","Extract bits from lower 16 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pext32#","Extract bits from lower 32 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pext64#","Extract bits from a word at locations specified by a mask.\n\n    @since 0.5.2.0")-  , ("pext#","Extract bits from a word at locations specified by a mask, aka\n    [parallel bit extract](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract).\n\n    Software emulation:\n\n    > pext :: Word -> Word -> Word\n    > pext src mask = loop 0 0 0\n    >   where\n    >     loop i count result\n    >       | i >= finiteBitSize (0 :: Word)\n    >       = result\n    >       | testBit mask i\n    >       = loop (i + 1) (count + 1) (if testBit src i then setBit result count else result)\n    >       | otherwise\n    >       = loop (i + 1) count result\n\n    @since 0.5.2.0")-  , ("clz8#","Count leading zeros in the lower 8 bits of a word.")-  , ("clz16#","Count leading zeros in the lower 16 bits of a word.")-  , ("clz32#","Count leading zeros in the lower 32 bits of a word.")-  , ("clz64#","Count leading zeros in a 64-bit word.")-  , ("clz#","Count leading zeros in a word.")-  , ("ctz8#","Count trailing zeros in the lower 8 bits of a word.")-  , ("ctz16#","Count trailing zeros in the lower 16 bits of a word.")-  , ("ctz32#","Count trailing zeros in the lower 32 bits of a word.")-  , ("ctz64#","Count trailing zeros in a 64-bit word.")-  , ("ctz#","Count trailing zeros in a word.")-  , ("byteSwap16#","Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. ")-  , ("byteSwap32#","Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. ")-  , ("byteSwap64#","Swap bytes in a 64 bits of a word.")-  , ("byteSwap#","Swap bytes in a word.")-  , ("bitReverse8#","Reverse the order of the bits in a 8-bit word.")-  , ("bitReverse16#","Reverse the order of the bits in a 16-bit word.")-  , ("bitReverse32#","Reverse the order of the bits in a 32-bit word.")-  , ("bitReverse64#","Reverse the order of the bits in a 64-bit word.")-  , ("bitReverse#","Reverse the order of the bits in a word.")-  , ("double2Int#","Truncates a 'Double#' value to the nearest 'Int#'.\n    Results are undefined if the truncation if truncation yields\n    a value outside the range of 'Int#'.")-  , ("**##","Exponentiation.")-  , ("decodeDouble_2Int#","Convert to integer.\n    First component of the result is -1 or 1, indicating the sign of the\n    mantissa. The next two are the high and low 32 bits of the mantissa\n    respectively, and the last is the exponent.")-  , ("decodeDouble_Int64#","Decode 'Double#' into mantissa and base-2 exponent.")-  , ("castDoubleToWord64#","Bitcast a 'Double#' into a 'Word64#'")-  , ("castWord64ToDouble#","Bitcast a 'Word64#' into a 'Double#'")-  , ("float2Int#","Truncates a 'Float#' value to the nearest 'Int#'.\n    Results are undefined if the truncation if truncation yields\n    a value outside the range of 'Int#'.")-  , ("decodeFloat_Int#","Convert to integers.\n    First 'Int#' in result is the mantissa; second is the exponent.")-  , ("castFloatToWord32#","Bitcast a 'Float#' into a 'Word32#'")-  , ("castWord32ToFloat#","Bitcast a 'Word32#' into a 'Float#'")-  , ("fmaddFloat#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")-  , ("fmsubFloat#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")-  , ("fnmaddFloat#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")-  , ("fnmsubFloat#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")-  , ("fmaddDouble#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")-  , ("fmsubDouble#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")-  , ("fnmaddDouble#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")-  , ("fnmsubDouble#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")-  , ("newArray#","Create a new mutable array with the specified number of elements,\n    in the specified state thread,\n    with each element containing the specified initial value.")-  , ("readArray#","Read from specified index of mutable array. Result is not yet evaluated.")-  , ("writeArray#","Write to specified index of mutable array.")-  , ("sizeofArray#","Return the number of elements in the array.")-  , ("sizeofMutableArray#","Return the number of elements in the array.")-  , ("indexArray#","Read from the specified index of an immutable array. The result is packaged\n    into an unboxed unary tuple; the result itself is not yet\n    evaluated. Pattern matching on the tuple forces the indexing of the\n    array to happen but does not evaluate the element itself. Evaluating\n    the thunk prevents additional thunks from building up on the\n    heap. Avoiding these thunks, in turn, reduces references to the\n    argument array, allowing it to be garbage collected more promptly.")-  , ("unsafeFreezeArray#","Make a mutable array immutable, without copying.")-  , ("unsafeThawArray#","Make an immutable array mutable, without copying.")-  , ("copyArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. Both arrays must fully contain the\n   specified ranges, but this is not checked. The two arrays must not\n   be the same array in different states, but this is not checked\n   either.")-  , ("copyMutableArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. Both arrays must fully contain the\n   specified ranges, but this is not checked. In the case where\n   the source and destination are the same array the source and\n   destination regions may overlap.")-  , ("cloneArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("cloneMutableArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("freezeArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("thawArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("casArray#","Given an array, an offset, the expected old value, and\n    the new value, perform an atomic compare and swap (i.e. write the new\n    value if the current value and the old value are the same pointer).\n    Returns 0 if the swap succeeds and 1 if it fails. Additionally, returns\n    the element at the offset after the operation completes. This means that\n    on a success the new value is returned, and on a failure the actual old\n    value (not the expected one) is returned. Implies a full memory barrier.\n    The use of a pointer equality on a boxed value makes this function harder\n    to use correctly than 'casIntArray#'. All of the difficulties\n    of using 'reallyUnsafePtrEquality#' correctly apply to\n    'casArray#' as well.\n   ")-  , ("newSmallArray#","Create a new mutable array with the specified number of elements,\n    in the specified state thread,\n    with each element containing the specified initial value.")-  , ("shrinkSmallMutableArray#","Shrink mutable array to new specified size, in\n    the specified state thread. The new size argument must be less than or\n    equal to the current size as reported by 'getSizeofSmallMutableArray#'.\n\n    Assuming the non-profiling RTS, for the copying garbage collector\n    (default) this primitive compiles to an O(1) operation in C--, modifying\n    the array in-place. For the non-moving garbage collector, however, the\n    time is proportional to the number of elements shrinked out. Backends\n    bypassing C-- representation (such as JavaScript) might behave\n    differently.\n\n    @since 0.6.1")-  , ("readSmallArray#","Read from specified index of mutable array. Result is not yet evaluated.")-  , ("writeSmallArray#","Write to specified index of mutable array.")-  , ("sizeofSmallArray#","Return the number of elements in the array.")-  , ("sizeofSmallMutableArray#","Return the number of elements in the array. __Deprecated__, it is\n   unsafe in the presence of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@\n   operations on the same small mutable array.")-  , ("getSizeofSmallMutableArray#","Return the number of elements in the array, correctly accounting for\n   the effect of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@.\n\n   @since 0.6.1")-  , ("indexSmallArray#","Read from specified index of immutable array. Result is packaged into\n    an unboxed singleton; the result itself is not yet evaluated.")-  , ("unsafeFreezeSmallArray#","Make a mutable array immutable, without copying.")-  , ("unsafeThawSmallArray#","Make an immutable array mutable, without copying.")-  , ("copySmallArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. Both arrays must fully contain the\n   specified ranges, but this is not checked. The two arrays must not\n   be the same array in different states, but this is not checked\n   either.")-  , ("copySmallMutableArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. The source and destination arrays can\n   refer to the same array. Both arrays must fully contain the\n   specified ranges, but this is not checked.\n   The regions are allowed to overlap, although this is only possible when the same\n   array is provided as both the source and the destination. ")-  , ("cloneSmallArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("cloneSmallMutableArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("freezeSmallArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("thawSmallArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")-  , ("casSmallArray#","Unsafe, machine-level atomic compare and swap on an element within an array.\n    See the documentation of 'casArray#'.")-  , ("ByteArray#","\n  A boxed, unlifted datatype representing a region of raw memory in the garbage-collected heap,\n  which is not scanned for pointers during garbage collection.\n\n  It is created by freezing a 'MutableByteArray#' with 'unsafeFreezeByteArray#'.\n  Freezing is essentially a no-op, as 'MutableByteArray#' and 'ByteArray#' share the same heap structure under the hood.\n\n  The immutable and mutable variants are commonly used for scenarios requiring high-performance data structures,\n  like @Text@, @Primitive Vector@, @Unboxed Array@, and @ShortByteString@.\n\n  Another application of fundamental importance is 'Integer', which is backed by 'ByteArray#'.\n\n  The representation on the heap of a Byte Array is:\n\n  > +------------+-----------------+-----------------------+\n  > |            |                 |                       |\n  > |   HEADER   | SIZE (in bytes) |       PAYLOAD         |\n  > |            |                 |                       |\n  > +------------+-----------------+-----------------------+\n\n  To obtain a pointer to actual payload (e.g., for FFI purposes) use 'byteArrayContents#' or 'mutableByteArrayContents#'.\n\n  Alternatively, enabling the @UnliftedFFITypes@ extension\n  allows to mention 'ByteArray#' and 'MutableByteArray#' in FFI type signatures directly.\n")-  , ("MutableByteArray#"," A mutable 'ByteAray#'. It can be created in three ways:\n\n  * 'newByteArray#': Create an unpinned array.\n  * 'newPinnedByteArray#': This will create a pinned array,\n  * 'newAlignedPinnedByteArray#': This will create a pinned array, with a custom alignment.\n\n  Unpinned arrays can be moved around during garbage collection, so you must not store or pass pointers to these values\n  if there is a chance for the garbage collector to kick in. That said, even unpinned arrays can be passed to unsafe FFI calls,\n  because no garbage collection happens during these unsafe calls\n  (see [Guaranteed Call Safety](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/ffi.html#guaranteed-call-safety)\n  in the GHC Manual). For safe FFI calls, byte arrays must be not only pinned, but also kept alive by means of the keepAlive# function\n  for the duration of a call (that's because garbage collection cannot move a pinned array, but is free to scrap it altogether).\n")-  , ("newByteArray#","Create a new mutable byte array of specified size (in bytes), in\n    the specified state thread. The size of the memory underlying the\n    array will be rounded up to the platform's word size.")-  , ("newPinnedByteArray#","Like 'newByteArray#' but GC guarantees not to move it.")-  , ("newAlignedPinnedByteArray#","Like 'newPinnedByteArray#' but allow specifying an arbitrary\n    alignment, which must be a power of two.")-  , ("isMutableByteArrayPinned#","Determine whether a 'MutableByteArray#' is guaranteed not to move\n   during GC.")-  , ("isByteArrayPinned#","Determine whether a 'ByteArray#' is guaranteed not to move during GC.")-  , ("byteArrayContents#","Intended for use with pinned arrays; otherwise very unsafe!")-  , ("mutableByteArrayContents#","Intended for use with pinned arrays; otherwise very unsafe!")-  , ("shrinkMutableByteArray#","Shrink mutable byte array to new specified size (in bytes), in\n    the specified state thread. The new size argument must be less than or\n    equal to the current size as reported by 'getSizeofMutableByteArray#'.\n\n    Assuming the non-profiling RTS, this primitive compiles to an O(1)\n    operation in C--, modifying the array in-place. Backends bypassing C--\n    representation (such as JavaScript) might behave differently.\n\n    @since 0.4.0.0")-  , ("resizeMutableByteArray#","Resize mutable byte array to new specified size (in bytes), shrinking or growing it.\n    The returned 'MutableByteArray#' is either the original\n    'MutableByteArray#' resized in-place or, if not possible, a newly\n    allocated (unpinned) 'MutableByteArray#' (with the original content\n    copied over).\n\n    To avoid undefined behaviour, the original 'MutableByteArray#' shall\n    not be accessed anymore after a 'resizeMutableByteArray#' has been\n    performed.  Moreover, no reference to the old one should be kept in order\n    to allow garbage collection of the original 'MutableByteArray#' in\n    case a new 'MutableByteArray#' had to be allocated.\n\n    @since 0.4.0.0")-  , ("unsafeFreezeByteArray#","Make a mutable byte array immutable, without copying.")-  , ("unsafeThawByteArray#","Make an immutable byte array mutable, without copying.\n\n    @since 0.12.0.0")-  , ("sizeofByteArray#","Return the size of the array in bytes.")-  , ("sizeofMutableByteArray#","Return the size of the array in bytes. __Deprecated__, it is\n   unsafe in the presence of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'\n   operations on the same mutable byte\n   array.")-  , ("getSizeofMutableByteArray#","Return the number of elements in the array, correctly accounting for\n   the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'.\n\n   @since 0.5.0.0")-  , ("indexCharArray#","Read an 8-bit character; offset in bytes.")-  , ("indexWideCharArray#","Read a 32-bit character; offset in 4-byte words.")-  , ("indexIntArray#","Read a word-sized integer; offset in machine words.")-  , ("indexWordArray#","Read a word-sized unsigned integer; offset in machine words.")-  , ("indexAddrArray#","Read a machine address; offset in machine words.")-  , ("indexFloatArray#","Read a single-precision floating-point value; offset in 4-byte words.")-  , ("indexDoubleArray#","Read a double-precision floating-point value; offset in 8-byte words.")-  , ("indexStablePtrArray#","Read a 'StablePtr#' value; offset in machine words.")-  , ("indexInt8Array#","Read an 8-bit signed integer; offset in bytes.")-  , ("indexWord8Array#","Read an 8-bit unsigned integer; offset in bytes.")-  , ("indexInt16Array#","Read a 16-bit signed integer; offset in 2-byte words.")-  , ("indexWord16Array#","Read a 16-bit unsigned integer; offset in 2-byte words.")-  , ("indexInt32Array#","Read a 32-bit signed integer; offset in 4-byte words.")-  , ("indexWord32Array#","Read a 32-bit unsigned integer; offset in 4-byte words.")-  , ("indexInt64Array#","Read a 64-bit signed integer; offset in 8-byte words.")-  , ("indexWord64Array#","Read a 64-bit unsigned integer; offset in 8-byte words.")-  , ("indexWord8ArrayAsChar#","Read an 8-bit character; offset in bytes.")-  , ("indexWord8ArrayAsWideChar#","Read a 32-bit character; offset in bytes.")-  , ("indexWord8ArrayAsInt#","Read a word-sized integer; offset in bytes.")-  , ("indexWord8ArrayAsWord#","Read a word-sized unsigned integer; offset in bytes.")-  , ("indexWord8ArrayAsAddr#","Read a machine address; offset in bytes.")-  , ("indexWord8ArrayAsFloat#","Read a single-precision floating-point value; offset in bytes.")-  , ("indexWord8ArrayAsDouble#","Read a double-precision floating-point value; offset in bytes.")-  , ("indexWord8ArrayAsStablePtr#","Read a 'StablePtr#' value; offset in bytes.")-  , ("indexWord8ArrayAsInt16#","Read a 16-bit signed integer; offset in bytes.")-  , ("indexWord8ArrayAsWord16#","Read a 16-bit unsigned integer; offset in bytes.")-  , ("indexWord8ArrayAsInt32#","Read a 32-bit signed integer; offset in bytes.")-  , ("indexWord8ArrayAsWord32#","Read a 32-bit unsigned integer; offset in bytes.")-  , ("indexWord8ArrayAsInt64#","Read a 64-bit signed integer; offset in bytes.")-  , ("indexWord8ArrayAsWord64#","Read a 64-bit unsigned integer; offset in bytes.")-  , ("readCharArray#","Read an 8-bit character; offset in bytes.")-  , ("readWideCharArray#","Read a 32-bit character; offset in 4-byte words.")-  , ("readIntArray#","Read a word-sized integer; offset in machine words.")-  , ("readWordArray#","Read a word-sized unsigned integer; offset in machine words.")-  , ("readAddrArray#","Read a machine address; offset in machine words.")-  , ("readFloatArray#","Read a single-precision floating-point value; offset in 4-byte words.")-  , ("readDoubleArray#","Read a double-precision floating-point value; offset in 8-byte words.")-  , ("readStablePtrArray#","Read a 'StablePtr#' value; offset in machine words.")-  , ("readInt8Array#","Read an 8-bit signed integer; offset in bytes.")-  , ("readWord8Array#","Read an 8-bit unsigned integer; offset in bytes.")-  , ("readInt16Array#","Read a 16-bit signed integer; offset in 2-byte words.")-  , ("readWord16Array#","Read a 16-bit unsigned integer; offset in 2-byte words.")-  , ("readInt32Array#","Read a 32-bit signed integer; offset in 4-byte words.")-  , ("readWord32Array#","Read a 32-bit unsigned integer; offset in 4-byte words.")-  , ("readInt64Array#","Read a 64-bit signed integer; offset in 8-byte words.")-  , ("readWord64Array#","Read a 64-bit unsigned integer; offset in 8-byte words.")-  , ("readWord8ArrayAsChar#","Read an 8-bit character; offset in bytes.")-  , ("readWord8ArrayAsWideChar#","Read a 32-bit character; offset in bytes.")-  , ("readWord8ArrayAsInt#","Read a word-sized integer; offset in bytes.")-  , ("readWord8ArrayAsWord#","Read a word-sized unsigned integer; offset in bytes.")-  , ("readWord8ArrayAsAddr#","Read a machine address; offset in bytes.")-  , ("readWord8ArrayAsFloat#","Read a single-precision floating-point value; offset in bytes.")-  , ("readWord8ArrayAsDouble#","Read a double-precision floating-point value; offset in bytes.")-  , ("readWord8ArrayAsStablePtr#","Read a 'StablePtr#' value; offset in bytes.")-  , ("readWord8ArrayAsInt16#","Read a 16-bit signed integer; offset in bytes.")-  , ("readWord8ArrayAsWord16#","Read a 16-bit unsigned integer; offset in bytes.")-  , ("readWord8ArrayAsInt32#","Read a 32-bit signed integer; offset in bytes.")-  , ("readWord8ArrayAsWord32#","Read a 32-bit unsigned integer; offset in bytes.")-  , ("readWord8ArrayAsInt64#","Read a 64-bit signed integer; offset in bytes.")-  , ("readWord8ArrayAsWord64#","Read a 64-bit unsigned integer; offset in bytes.")-  , ("writeCharArray#","Write an 8-bit character; offset in bytes.")-  , ("writeWideCharArray#","Write a 32-bit character; offset in 4-byte words.")-  , ("writeIntArray#","Write a word-sized integer; offset in machine words.")-  , ("writeWordArray#","Write a word-sized unsigned integer; offset in machine words.")-  , ("writeAddrArray#","Write a machine address; offset in machine words.")-  , ("writeFloatArray#","Write a single-precision floating-point value; offset in 4-byte words.")-  , ("writeDoubleArray#","Write a double-precision floating-point value; offset in 8-byte words.")-  , ("writeStablePtrArray#","Write a 'StablePtr#' value; offset in machine words.")-  , ("writeInt8Array#","Write an 8-bit signed integer; offset in bytes.")-  , ("writeWord8Array#","Write an 8-bit unsigned integer; offset in bytes.")-  , ("writeInt16Array#","Write a 16-bit signed integer; offset in 2-byte words.")-  , ("writeWord16Array#","Write a 16-bit unsigned integer; offset in 2-byte words.")-  , ("writeInt32Array#","Write a 32-bit signed integer; offset in 4-byte words.")-  , ("writeWord32Array#","Write a 32-bit unsigned integer; offset in 4-byte words.")-  , ("writeInt64Array#","Write a 64-bit signed integer; offset in 8-byte words.")-  , ("writeWord64Array#","Write a 64-bit unsigned integer; offset in 8-byte words.")-  , ("writeWord8ArrayAsChar#","Write an 8-bit character; offset in bytes.")-  , ("writeWord8ArrayAsWideChar#","Write a 32-bit character; offset in bytes.")-  , ("writeWord8ArrayAsInt#","Write a word-sized integer; offset in bytes.")-  , ("writeWord8ArrayAsWord#","Write a word-sized unsigned integer; offset in bytes.")-  , ("writeWord8ArrayAsAddr#","Write a machine address; offset in bytes.")-  , ("writeWord8ArrayAsFloat#","Write a single-precision floating-point value; offset in bytes.")-  , ("writeWord8ArrayAsDouble#","Write a double-precision floating-point value; offset in bytes.")-  , ("writeWord8ArrayAsStablePtr#","Write a 'StablePtr#' value; offset in bytes.")-  , ("writeWord8ArrayAsInt16#","Write a 16-bit signed integer; offset in bytes.")-  , ("writeWord8ArrayAsWord16#","Write a 16-bit unsigned integer; offset in bytes.")-  , ("writeWord8ArrayAsInt32#","Write a 32-bit signed integer; offset in bytes.")-  , ("writeWord8ArrayAsWord32#","Write a 32-bit unsigned integer; offset in bytes.")-  , ("writeWord8ArrayAsInt64#","Write a 64-bit signed integer; offset in bytes.")-  , ("writeWord8ArrayAsWord64#","Write a 64-bit unsigned integer; offset in bytes.")-  , ("compareByteArrays#","@'compareByteArrays#' src1 src1_ofs src2 src2_ofs n@ compares\n    @n@ bytes starting at offset @src1_ofs@ in the first\n    'ByteArray#' @src1@ to the range of @n@ bytes\n    (i.e. same length) starting at offset @src2_ofs@ of the second\n    'ByteArray#' @src2@.  Both arrays must fully contain the\n    specified ranges, but this is not checked.  Returns an 'Int#'\n    less than, equal to, or greater than zero if the range is found,\n    respectively, to be byte-wise lexicographically less than, to\n    match, or be greater than the second range.\n\n    @since 0.5.2.0")-  , ("copyByteArray#"," @'copyByteArray#' src src_ofs dst dst_ofs len@ copies the range\n    starting at offset @src_ofs@ of length @len@ from the\n    'ByteArray#' @src@ to the 'MutableByteArray#' @dst@\n    starting at offset @dst_ofs@.  Both arrays must fully contain\n    the specified ranges, but this is not checked.  The two arrays must\n    not be the same array in different states, but this is not checked\n    either.\n  ")-  , ("copyMutableByteArray#"," @'copyMutableByteArray#' src src_ofs dst dst_ofs len@ copies the\n    range starting at offset @src_ofs@ of length @len@ from the\n    'MutableByteArray#' @src@ to the 'MutableByteArray#' @dst@\n    starting at offset @dst_ofs@.  Both arrays must fully contain the\n    specified ranges, but this is not checked.  The regions are\n    allowed to overlap, although this is only possible when the same\n    array is provided as both the source and the destination.\n  ")-  , ("copyMutableByteArrayNonOverlapping#"," @'copyMutableByteArrayNonOverlapping#' src src_ofs dst dst_ofs len@\n    copies the range starting at offset @src_ofs@ of length @len@ from\n    the 'MutableByteArray#' @src@ to the 'MutableByteArray#' @dst@\n    starting at offset @dst_ofs@.  Both arrays must fully contain the\n    specified ranges, but this is not checked.  The regions are /not/\n    allowed to overlap, but this is also not checked.\n\n    @since 0.11.0\n  ")-  , ("copyByteArrayToAddr#","Copy a range of the ByteArray\\# to the memory range starting at the Addr\\#.\n   The ByteArray\\# and the memory region at Addr\\# must fully contain the\n   specified ranges, but this is not checked. The Addr\\# must not point into the\n   ByteArray\\# (e.g. if the ByteArray\\# were pinned), but this is not checked\n   either.")-  , ("copyMutableByteArrayToAddr#","Copy a range of the MutableByteArray\\# to the memory range starting at the\n   Addr\\#. The MutableByteArray\\# and the memory region at Addr\\# must fully\n   contain the specified ranges, but this is not checked. The Addr\\# must not\n   point into the MutableByteArray\\# (e.g. if the MutableByteArray\\# were\n   pinned), but this is not checked either.")-  , ("copyAddrToByteArray#","Copy a memory range starting at the Addr\\# to the specified range in the\n   MutableByteArray\\#. The memory region at Addr\\# and the ByteArray\\# must fully\n   contain the specified ranges, but this is not checked. The Addr\\# must not\n   point into the MutableByteArray\\# (e.g. if the MutableByteArray\\# were pinned),\n   but this is not checked either.")-  , ("copyAddrToAddr#"," @'copyAddrToAddr#' src dest len@ copies @len@ bytes\n    from @src@ to @dest@.  These two memory ranges are allowed to overlap.\n\n    Analogous to the standard C function @memmove@, but with a different\n    argument order.\n\n    @since 0.11.0\n  ")-  , ("copyAddrToAddrNonOverlapping#"," @'copyAddrToAddrNonOverlapping#' src dest len@ copies @len@ bytes\n    from @src@ to @dest@.  As the name suggests, these two memory ranges\n    /must not overlap/, although this pre-condition is not checked.\n\n    Analogous to the standard C function @memcpy@, but with a different\n    argument order.\n\n    @since 0.11.0\n  ")-  , ("setByteArray#","@'setByteArray#' ba off len c@ sets the byte range @[off, off+len)@ of\n   the 'MutableByteArray#' to the byte @c@.")-  , ("setAddrRange#"," @'setAddrRange#' dest len c@ sets all of the bytes in\n    @[dest, dest+len)@ to the value @c@.\n\n    Analogous to the standard C function @memset@, but with a different\n    argument order.\n\n    @since 0.11.0\n  ")-  , ("atomicReadIntArray#","Given an array and an offset in machine words, read an element. The\n    index is assumed to be in bounds. Implies a full memory barrier.")-  , ("atomicWriteIntArray#","Given an array and an offset in machine words, write an element. The\n    index is assumed to be in bounds. Implies a full memory barrier.")-  , ("casIntArray#","Given an array, an offset in machine words, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")-  , ("casInt8Array#","Given an array, an offset in bytes, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")-  , ("casInt16Array#","Given an array, an offset in 16 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")-  , ("casInt32Array#","Given an array, an offset in 32 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")-  , ("casInt64Array#","Given an array, an offset in 64 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")-  , ("fetchAddIntArray#","Given an array, and offset in machine words, and a value to add,\n    atomically add the value to the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchSubIntArray#","Given an array, and offset in machine words, and a value to subtract,\n    atomically subtract the value from the element. Returns the value of\n    the element before the operation. Implies a full memory barrier.")-  , ("fetchAndIntArray#","Given an array, and offset in machine words, and a value to AND,\n    atomically AND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchNandIntArray#","Given an array, and offset in machine words, and a value to NAND,\n    atomically NAND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchOrIntArray#","Given an array, and offset in machine words, and a value to OR,\n    atomically OR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchXorIntArray#","Given an array, and offset in machine words, and a value to XOR,\n    atomically XOR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("Addr#"," An arbitrary machine address assumed to point outside\n         the garbage-collected heap. ")-  , ("nullAddr#"," The null address. ")-  , ("minusAddr#","Result is meaningless if two 'Addr#'s are so far apart that their\n         difference doesn't fit in an 'Int#'.")-  , ("remAddr#","Return the remainder when the 'Addr#' arg, treated like an 'Int#',\n          is divided by the 'Int#' arg.")-  , ("addr2Int#","Coerce directly from address to int.")-  , ("int2Addr#","Coerce directly from int to address.")-  , ("indexCharOffAddr#","Read an 8-bit character; offset in bytes.\n\n")-  , ("indexWideCharOffAddr#","Read a 32-bit character; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexIntOffAddr#","Read a word-sized integer; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexWordOffAddr#","Read a word-sized unsigned integer; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexAddrOffAddr#","Read a machine address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexFloatOffAddr#","Read a single-precision floating-point value; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexDoubleOffAddr#","Read a double-precision floating-point value; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexStablePtrOffAddr#","Read a 'StablePtr#' value; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexInt8OffAddr#","Read an 8-bit signed integer; offset in bytes.\n\n")-  , ("indexWord8OffAddr#","Read an 8-bit unsigned integer; offset in bytes.\n\n")-  , ("indexInt16OffAddr#","Read a 16-bit signed integer; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexWord16OffAddr#","Read a 16-bit unsigned integer; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexInt32OffAddr#","Read a 32-bit signed integer; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexWord32OffAddr#","Read a 32-bit unsigned integer; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexInt64OffAddr#","Read a 64-bit signed integer; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexWord64OffAddr#","Read a 64-bit unsigned integer; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("indexWord8OffAddrAsChar#","Read an 8-bit character; offset in bytes.")-  , ("indexWord8OffAddrAsWideChar#","Read a 32-bit character; offset in bytes.")-  , ("indexWord8OffAddrAsInt#","Read a word-sized integer; offset in bytes.")-  , ("indexWord8OffAddrAsWord#","Read a word-sized unsigned integer; offset in bytes.")-  , ("indexWord8OffAddrAsAddr#","Read a machine address; offset in bytes.")-  , ("indexWord8OffAddrAsFloat#","Read a single-precision floating-point value; offset in bytes.")-  , ("indexWord8OffAddrAsDouble#","Read a double-precision floating-point value; offset in bytes.")-  , ("indexWord8OffAddrAsStablePtr#","Read a 'StablePtr#' value; offset in bytes.")-  , ("indexWord8OffAddrAsInt16#","Read a 16-bit signed integer; offset in bytes.")-  , ("indexWord8OffAddrAsWord16#","Read a 16-bit unsigned integer; offset in bytes.")-  , ("indexWord8OffAddrAsInt32#","Read a 32-bit signed integer; offset in bytes.")-  , ("indexWord8OffAddrAsWord32#","Read a 32-bit unsigned integer; offset in bytes.")-  , ("indexWord8OffAddrAsInt64#","Read a 64-bit signed integer; offset in bytes.")-  , ("indexWord8OffAddrAsWord64#","Read a 64-bit unsigned integer; offset in bytes.")-  , ("readCharOffAddr#","Read an 8-bit character; offset in bytes.\n\n")-  , ("readWideCharOffAddr#","Read a 32-bit character; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readIntOffAddr#","Read a word-sized integer; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readWordOffAddr#","Read a word-sized unsigned integer; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readAddrOffAddr#","Read a machine address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readFloatOffAddr#","Read a single-precision floating-point value; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readDoubleOffAddr#","Read a double-precision floating-point value; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readStablePtrOffAddr#","Read a 'StablePtr#' value; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readInt8OffAddr#","Read an 8-bit signed integer; offset in bytes.\n\n")-  , ("readWord8OffAddr#","Read an 8-bit unsigned integer; offset in bytes.\n\n")-  , ("readInt16OffAddr#","Read a 16-bit signed integer; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readWord16OffAddr#","Read a 16-bit unsigned integer; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readInt32OffAddr#","Read a 32-bit signed integer; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readWord32OffAddr#","Read a 32-bit unsigned integer; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readInt64OffAddr#","Read a 64-bit signed integer; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readWord64OffAddr#","Read a 64-bit unsigned integer; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("readWord8OffAddrAsChar#","Read an 8-bit character; offset in bytes.")-  , ("readWord8OffAddrAsWideChar#","Read a 32-bit character; offset in bytes.")-  , ("readWord8OffAddrAsInt#","Read a word-sized integer; offset in bytes.")-  , ("readWord8OffAddrAsWord#","Read a word-sized unsigned integer; offset in bytes.")-  , ("readWord8OffAddrAsAddr#","Read a machine address; offset in bytes.")-  , ("readWord8OffAddrAsFloat#","Read a single-precision floating-point value; offset in bytes.")-  , ("readWord8OffAddrAsDouble#","Read a double-precision floating-point value; offset in bytes.")-  , ("readWord8OffAddrAsStablePtr#","Read a 'StablePtr#' value; offset in bytes.")-  , ("readWord8OffAddrAsInt16#","Read a 16-bit signed integer; offset in bytes.")-  , ("readWord8OffAddrAsWord16#","Read a 16-bit unsigned integer; offset in bytes.")-  , ("readWord8OffAddrAsInt32#","Read a 32-bit signed integer; offset in bytes.")-  , ("readWord8OffAddrAsWord32#","Read a 32-bit unsigned integer; offset in bytes.")-  , ("readWord8OffAddrAsInt64#","Read a 64-bit signed integer; offset in bytes.")-  , ("readWord8OffAddrAsWord64#","Read a 64-bit unsigned integer; offset in bytes.")-  , ("writeCharOffAddr#","Write an 8-bit character; offset in bytes.\n\n")-  , ("writeWideCharOffAddr#","Write a 32-bit character; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeIntOffAddr#","Write a word-sized integer; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeWordOffAddr#","Write a word-sized unsigned integer; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeAddrOffAddr#","Write a machine address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeFloatOffAddr#","Write a single-precision floating-point value; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeDoubleOffAddr#","Write a double-precision floating-point value; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeStablePtrOffAddr#","Write a 'StablePtr#' value; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeInt8OffAddr#","Write an 8-bit signed integer; offset in bytes.\n\n")-  , ("writeWord8OffAddr#","Write an 8-bit unsigned integer; offset in bytes.\n\n")-  , ("writeInt16OffAddr#","Write a 16-bit signed integer; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeWord16OffAddr#","Write a 16-bit unsigned integer; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeInt32OffAddr#","Write a 32-bit signed integer; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeWord32OffAddr#","Write a 32-bit unsigned integer; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeInt64OffAddr#","Write a 64-bit signed integer; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeWord64OffAddr#","Write a 64-bit unsigned integer; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")-  , ("writeWord8OffAddrAsChar#","Write an 8-bit character; offset in bytes.")-  , ("writeWord8OffAddrAsWideChar#","Write a 32-bit character; offset in bytes.")-  , ("writeWord8OffAddrAsInt#","Write a word-sized integer; offset in bytes.")-  , ("writeWord8OffAddrAsWord#","Write a word-sized unsigned integer; offset in bytes.")-  , ("writeWord8OffAddrAsAddr#","Write a machine address; offset in bytes.")-  , ("writeWord8OffAddrAsFloat#","Write a single-precision floating-point value; offset in bytes.")-  , ("writeWord8OffAddrAsDouble#","Write a double-precision floating-point value; offset in bytes.")-  , ("writeWord8OffAddrAsStablePtr#","Write a 'StablePtr#' value; offset in bytes.")-  , ("writeWord8OffAddrAsInt16#","Write a 16-bit signed integer; offset in bytes.")-  , ("writeWord8OffAddrAsWord16#","Write a 16-bit unsigned integer; offset in bytes.")-  , ("writeWord8OffAddrAsInt32#","Write a 32-bit signed integer; offset in bytes.")-  , ("writeWord8OffAddrAsWord32#","Write a 32-bit unsigned integer; offset in bytes.")-  , ("writeWord8OffAddrAsInt64#","Write a 64-bit signed integer; offset in bytes.")-  , ("writeWord8OffAddrAsWord64#","Write a 64-bit unsigned integer; offset in bytes.")-  , ("atomicExchangeAddrAddr#","The atomic exchange operation. Atomically exchanges the value at the first address\n    with the Addr# given as second argument. Implies a read barrier.")-  , ("atomicExchangeWordAddr#","The atomic exchange operation. Atomically exchanges the value at the address\n    with the given value. Returns the old value. Implies a read barrier.")-  , ("atomicCasAddrAddr#"," Compare and swap on a word-sized memory location.\n\n     Use as: \\s -> atomicCasAddrAddr# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")-  , ("atomicCasWordAddr#"," Compare and swap on a word-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")-  , ("atomicCasWord8Addr#"," Compare and swap on a 8 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr8# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")-  , ("atomicCasWord16Addr#"," Compare and swap on a 16 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr16# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")-  , ("atomicCasWord32Addr#"," Compare and swap on a 32 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr32# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")-  , ("atomicCasWord64Addr#"," Compare and swap on a 64 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr64# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")-  , ("fetchAddWordAddr#","Given an address, and a value to add,\n    atomically add the value to the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchSubWordAddr#","Given an address, and a value to subtract,\n    atomically subtract the value from the element. Returns the value of\n    the element before the operation. Implies a full memory barrier.")-  , ("fetchAndWordAddr#","Given an address, and a value to AND,\n    atomically AND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchNandWordAddr#","Given an address, and a value to NAND,\n    atomically NAND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchOrWordAddr#","Given an address, and a value to OR,\n    atomically OR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("fetchXorWordAddr#","Given an address, and a value to XOR,\n    atomically XOR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")-  , ("atomicReadWordAddr#","Given an address, read a machine word.  Implies a full memory barrier.")-  , ("atomicWriteWordAddr#","Given an address, write a machine word. Implies a full memory barrier.")-  , ("MutVar#","A 'MutVar#' behaves like a single-element mutable array.")-  , ("newMutVar#","Create 'MutVar#' with specified initial value in specified state thread.")-  , ("readMutVar#","Read contents of 'MutVar#'. Result is not yet evaluated.")-  , ("writeMutVar#","Write contents of 'MutVar#'.")-  , ("atomicSwapMutVar#","Atomically exchange the value of a 'MutVar#'.")-  , ("atomicModifyMutVar2#"," Modify the contents of a 'MutVar#', returning the previous\n     contents @x :: a@ and the result of applying the given function to the\n     previous contents @f x :: c@.\n\n     The @data@ type @c@ (not a @newtype@!) must be a record whose first field\n     is of lifted type @a :: Type@ and is not unpacked. For example, product\n     types @c ~ Solo a@ or @c ~ (a, b)@ work well. If the record type is both\n     monomorphic and strict in its first field, it's recommended to mark the\n     latter @{-# NOUNPACK #-}@ explicitly.\n\n     Under the hood 'atomicModifyMutVar2#' atomically replaces a pointer to an\n     old @x :: a@ with a pointer to a selector thunk @fst r@, where\n     @fst@ is a selector for the first field of the record and @r@ is a\n     function application thunk @r = f x@.\n\n     @atomicModifyIORef2Native@ from @atomic-modify-general@ package makes an\n     effort to reflect restrictions on @c@ faithfully, providing a\n     well-typed high-level wrapper.")-  , ("atomicModifyMutVar_#"," Modify the contents of a 'MutVar#', returning the previous\n     contents and the result of applying the given function to the\n     previous contents. ")-  , ("casMutVar#"," Compare-and-swap: perform a pointer equality test between\n     the first value passed to this function and the value\n     stored inside the 'MutVar#'. If the pointers are equal,\n     replace the stored value with the second value passed to this\n     function, otherwise do nothing.\n     Returns the final value stored inside the 'MutVar#'.\n     The 'Int#' indicates whether a swap took place,\n     with @1#@ meaning that we didn't swap, and @0#@\n     that we did.\n     Implies a full memory barrier.\n     Because the comparison is done on the level of pointers,\n     all of the difficulties of using\n     'reallyUnsafePtrEquality#' correctly apply to\n     'casMutVar#' as well.\n   ")-  , ("catch#"," @'catch#' k handler s@ evaluates @k s@, invoking @handler@ on any exceptions\n     thrown.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")-  , ("maskAsyncExceptions#"," @'maskAsyncExceptions#' k s@ evaluates @k s@ such that asynchronous\n     exceptions are deferred until after evaluation has finished.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")-  , ("maskUninterruptible#"," @'maskUninterruptible#' k s@ evaluates @k s@ such that asynchronous\n     exceptions are deferred until after evaluation has finished.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")-  , ("unmaskAsyncExceptions#"," @'unmaskAsyncUninterruptible#' k s@ evaluates @k s@ such that asynchronous\n     exceptions are unmasked.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")-  , ("PromptTag#"," See \"GHC.Prim#continuations\". ")-  , ("newPromptTag#"," See \"GHC.Prim#continuations\". ")-  , ("prompt#"," See \"GHC.Prim#continuations\". ")-  , ("control0#"," See \"GHC.Prim#continuations\". ")-  , ("newTVar#","Create a new 'TVar#' holding a specified initial value.")-  , ("readTVar#","Read contents of 'TVar#' inside an STM transaction,\n    i.e. within a call to 'atomically#'.\n    Does not force evaluation of the result.")-  , ("readTVarIO#","Read contents of 'TVar#' outside an STM transaction.\n   Does not force evaluation of the result.")-  , ("writeTVar#","Write contents of 'TVar#'.")-  , ("MVar#"," A shared mutable variable (/not/ the same as a 'MutVar#'!).\n        (Note: in a non-concurrent implementation, @('MVar#' a)@ can be\n        represented by @('MutVar#' (Maybe a))@.) ")-  , ("newMVar#","Create new 'MVar#'; initially empty.")-  , ("takeMVar#","If 'MVar#' is empty, block until it becomes full.\n   Then remove and return its contents, and set it empty.")-  , ("tryTakeMVar#","If 'MVar#' is empty, immediately return with integer 0 and value undefined.\n   Otherwise, return with integer 1 and contents of 'MVar#', and set 'MVar#' empty.")-  , ("putMVar#","If 'MVar#' is full, block until it becomes empty.\n   Then store value arg as its new contents.")-  , ("tryPutMVar#","If 'MVar#' is full, immediately return with integer 0.\n    Otherwise, store value arg as 'MVar#''s new contents, and return with integer 1.")-  , ("readMVar#","If 'MVar#' is empty, block until it becomes full.\n   Then read its contents without modifying the MVar, without possibility\n   of intervention from other threads.")-  , ("tryReadMVar#","If 'MVar#' is empty, immediately return with integer 0 and value undefined.\n   Otherwise, return with integer 1 and contents of 'MVar#'.")-  , ("isEmptyMVar#","Return 1 if 'MVar#' is empty; 0 otherwise.")-  , ("IOPort#"," A shared I/O port is almost the same as an 'MVar#'.\n        The main difference is that IOPort has no deadlock detection or\n        deadlock breaking code that forcibly releases the lock. ")-  , ("newIOPort#","Create new 'IOPort#'; initially empty.")-  , ("readIOPort#","If 'IOPort#' is empty, block until it becomes full.\n   Then remove and return its contents, and set it empty.\n   Throws an 'IOPortException' if another thread is already\n   waiting to read this 'IOPort#'.")-  , ("writeIOPort#","If 'IOPort#' is full, immediately return with integer 0,\n    throwing an 'IOPortException'.\n    Otherwise, store value arg as 'IOPort#''s new contents,\n    and return with integer 1. ")-  , ("delay#","Sleep specified number of microseconds.")-  , ("waitRead#","Block until input is available on specified file descriptor.")-  , ("waitWrite#","Block until output is possible on specified file descriptor.")-  , ("State#"," 'State#' is the primitive, unlifted type of states.  It has\n        one type parameter, thus @'State#' 'RealWorld'@, or @'State#' s@,\n        where s is a type variable. The only purpose of the type parameter\n        is to keep different state threads separate.  It is represented by\n        nothing at all. ")-  , ("RealWorld"," 'RealWorld' is deeply magical.  It is /primitive/, but it is not\n        /unlifted/ (hence @ptrArg@).  We never manipulate values of type\n        'RealWorld'; it's only used in the type system, to parameterise 'State#'. ")-  , ("ThreadId#","(In a non-concurrent implementation, this can be a singleton\n        type, whose (unique) value is returned by 'myThreadId#'.  The\n        other operations can be omitted.)")-  , ("labelThread#","Set the label of the given thread. The @ByteArray#@ should contain\n    a UTF-8-encoded string.")-  , ("threadLabel#","Get the label of the given thread.\n    Morally of type @ThreadId# -> IO (Maybe ByteArray#)@, with a @1#@ tag\n    denoting @Just@.\n\n    @since 0.10")-  , ("threadStatus#","Get the status of the given thread. Result is\n    @(ThreadStatus, Capability, Locked)@ where\n    @ThreadStatus@ is one of the status constants defined in\n    @rts/Constants.h@, @Capability@ is the number of\n    the capability which currently owns the thread, and\n    @Locked@ is a boolean indicating whether the\n    thread is bound to that capability.\n\n    @since 0.9")-  , ("listThreads#"," Returns an array of the threads started by the program. Note that this\n     threads which have finished execution may or may not be present in this\n     list, depending upon whether they have been collected by the garbage collector.\n\n     @since 0.10")-  , ("mkWeak#"," @'mkWeak#' k v finalizer s@ creates a weak reference to value @k@,\n     with an associated reference to some value @v@. If @k@ is still\n     alive then @v@ can be retrieved using 'deRefWeak#'. Note that\n     the type of @k@ must be represented by a pointer (i.e. of kind\n     @'TYPE' ''LiftedRep' or @'TYPE' ''UnliftedRep'@). ")-  , ("addCFinalizerToWeak#"," @'addCFinalizerToWeak#' fptr ptr flag eptr w@ attaches a C\n     function pointer @fptr@ to a weak pointer @w@ as a finalizer. If\n     @flag@ is zero, @fptr@ will be called with one argument,\n     @ptr@. Otherwise, it will be called with two arguments,\n     @eptr@ and @ptr@. 'addCFinalizerToWeak#' returns\n     1 on success, or 0 if @w@ is already dead. ")-  , ("finalizeWeak#"," Finalize a weak pointer. The return value is an unboxed tuple\n     containing the new state of the world and an \"unboxed Maybe\",\n     represented by an 'Int#' and a (possibly invalid) finalization\n     action. An 'Int#' of @1@ indicates that the finalizer is valid. The\n     return value @b@ from the finalizer should be ignored. ")-  , ("compactNew#"," Create a new CNF with a single compact block. The argument is\n     the capacity of the compact block (in bytes, not words).\n     The capacity is rounded up to a multiple of the allocator block size\n     and is capped to one mega block. ")-  , ("compactResize#"," Set the new allocation size of the CNF. This value (in bytes)\n     determines the capacity of each compact block in the CNF. It\n     does not retroactively affect existing compact blocks in the CNF. ")-  , ("compactContains#"," Returns 1\\# if the object is contained in the CNF, 0\\# otherwise. ")-  , ("compactContainsAny#"," Returns 1\\# if the object is in any CNF at all, 0\\# otherwise. ")-  , ("compactGetFirstBlock#"," Returns the address and the utilized size (in bytes) of the\n     first compact block of a CNF.")-  , ("compactGetNextBlock#"," Given a CNF and the address of one its compact blocks, returns the\n     next compact block and its utilized size, or 'nullAddr#' if the\n     argument was the last compact block in the CNF. ")-  , ("compactAllocateBlock#"," Attempt to allocate a compact block with the capacity (in\n     bytes) given by the first argument. The 'Addr#' is a pointer\n     to previous compact block of the CNF or 'nullAddr#' to create a\n     new CNF with a single compact block.\n\n     The resulting block is not known to the GC until\n     'compactFixupPointers#' is called on it, and care must be taken\n     so that the address does not escape or memory will be leaked.\n   ")-  , ("compactFixupPointers#"," Given the pointer to the first block of a CNF and the\n     address of the root object in the old address space, fix up\n     the internal pointers inside the CNF to account for\n     a different position in memory than when it was serialized.\n     This method must be called exactly once after importing\n     a serialized CNF. It returns the new CNF and the new adjusted\n     root address. ")-  , ("compactAdd#"," Recursively add a closure and its transitive closure to a\n     'Compact#' (a CNF), evaluating any unevaluated components\n     at the same time. Note: 'compactAdd#' is not thread-safe, so\n     only one thread may call 'compactAdd#' with a particular\n     'Compact#' at any given time. The primop does not\n     enforce any mutual exclusion; the caller is expected to\n     arrange this. ")-  , ("compactAddWithSharing#"," Like 'compactAdd#', but retains sharing and cycles\n   during compaction. ")-  , ("compactSize#"," Return the total capacity (in bytes) of all the compact blocks\n     in the CNF. ")-  , ("reallyUnsafePtrEquality#"," Returns @1#@ if the given pointers are equal and @0#@ otherwise. ")-  , ("numSparks#"," Returns the number of sparks in the local spark pool. ")-  , ("keepAlive#"," @'keepAlive#' x s k@ keeps the value @x@ alive during the execution\n     of the computation @k@.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")-  , ("dataToTagSmall#"," Used internally to implement @dataToTag#@: Use that function instead!\n     This one normally offers /no advantage/ and comes with no stability\n     guarantees: it may change its type, its name, or its behavior\n     with /no warning/ between compiler releases.\n\n     It is expected that this function will be un-exposed in a future\n     release of ghc.\n\n     For more details, look at @Note [DataToTag overview]@\n     in GHC.Tc.Instance.Class in the source code for\n     /the specific compiler version you are using./\n   ")-  , ("dataToTagLarge#"," Used internally to implement @dataToTag#@: Use that function instead!\n     This one offers /no advantage/ and comes with no stability\n     guarantees: it may change its type, its name, or its behavior\n     with /no warning/ between compiler releases.\n\n     It is expected that this function will be un-exposed in a future\n     release of ghc.\n\n     For more details, look at @Note [DataToTag overview]@\n     in GHC.Tc.Instance.Class in the source code for\n     /the specific compiler version you are using./\n   ")-  , ("BCO"," Primitive bytecode type. ")-  , ("addrToAny#"," Convert an 'Addr#' to a followable Any type. ")-  , ("anyToAddr#"," Retrieve the address of any Haskell value. This is\n     essentially an 'unsafeCoerce#', but if implemented as such\n     the core lint pass complains and fails to compile.\n     As a primop, it is opaque to core/stg, and only appears\n     in cmm (where the copy propagation pass will get rid of it).\n     Note that \"a\" must be a value, not a thunk! It's too late\n     for strictness analysis to enforce this, so you're on your\n     own to guarantee this. Also note that 'Addr#' is not a GC\n     pointer - up to you to guarantee that it does not become\n     a dangling pointer immediately after you get it.")-  , ("mkApUpd0#"," Wrap a BCO in a @AP_UPD@ thunk which will be updated with the value of\n     the BCO when evaluated. ")-  , ("newBCO#"," @'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The\n     resulting object encodes a function of the given arity with the instructions\n     encoded in @instrs@, and a static reference table usage bitmap given by\n     @bitmap@. ")-  , ("unpackClosure#"," @'unpackClosure#' closure@ copies the closure and pointers in the\n     payload of the given closure into two new arrays, and returns a pointer to\n     the first word of the closure's info table, a non-pointer array for the raw\n     bytes of the closure, and a pointer array for the pointers in the payload. ")-  , ("closureSize#"," @'closureSize#' closure@ returns the size of the given closure in\n     machine words. ")-  , ("getCurrentCCS#"," Returns the current 'CostCentreStack' (value is @NULL@ if\n     not profiling).  Takes a dummy argument which can be used to\n     avoid the call to 'getCurrentCCS#' being floated out by the\n     simplifier, which would result in an uninformative stack\n     (\"CAF\"). ")-  , ("clearCCS#"," Run the supplied IO action with an empty CCS.  For example, this\n     is used by the interpreter to run an interpreted computation\n     without the call stack showing that it was invoked from GHC. ")-  , ("whereFrom#"," Fills the given buffer with the @InfoProvEnt@ for the info table of the\n     given object. Returns @1#@ on success and @0#@ otherwise.")-  , ("FUN","The builtin function type, written in infix form as @a % m -> b@.\n   Values of this type are functions taking inputs of type @a@ and\n   producing outputs of type @b@. The multiplicity of the input is\n   @m@.\n\n   Note that @'FUN' m a b@ permits representation polymorphism in both\n   @a@ and @b@, so that types like @'Int#' -> 'Int#'@ can still be\n   well-kinded.\n  ")-  , ("realWorld#"," The token used in the implementation of the IO monad as a state monad.\n     It does not pass any information at runtime.\n     See also 'GHC.Magic.runRW#'. ")-  , ("void#"," This is an alias for the unboxed unit tuple constructor.\n     In earlier versions of GHC, 'void#' was a value\n     of the primitive type 'Void#', which is now defined to be @(# #)@.\n   ")-  , ("Proxy#"," The type constructor 'Proxy#' is used to bear witness to some\n   type variable. It's used when you want to pass around proxy values\n   for doing things like modelling type applications. A 'Proxy#'\n   is not only unboxed, it also has a polymorphic kind, and has no\n   runtime representation, being totally free. ")-  , ("proxy#"," Witness for an unboxed 'Proxy#' value, which has no runtime\n   representation. ")-  , ("seq"," The value of @'seq' a b@ is bottom if @a@ is bottom, and\n     otherwise equal to @b@. In other words, it evaluates the first\n     argument @a@ to weak head normal form (WHNF). 'seq' is usually\n     introduced to improve performance by avoiding unneeded laziness.\n\n     A note on evaluation order: the expression @'seq' a b@ does\n     /not/ guarantee that @a@ will be evaluated before @b@.\n     The only guarantee given by 'seq' is that the both @a@\n     and @b@ will be evaluated before 'seq' returns a value.\n     In particular, this means that @b@ may be evaluated before\n     @a@. If you need to guarantee a specific order of evaluation,\n     you must use the function 'pseq' from the \"parallel\" package. ")-  , ("traceEvent#"," Emits an event via the RTS tracing framework.  The contents\n     of the event is the zero-terminated byte string passed as the first\n     argument.  The event will be emitted either to the @.eventlog@ file,\n     or to stderr, depending on the runtime RTS flags. ")-  , ("traceBinaryEvent#"," Emits an event via the RTS tracing framework.  The contents\n     of the event is the binary object passed as the first argument with\n     the given length passed as the second argument. The event will be\n     emitted to the @.eventlog@ file. ")-  , ("traceMarker#"," Emits a marker event via the RTS tracing framework.  The contents\n     of the event is the zero-terminated byte string passed as the first\n     argument.  The event will be emitted either to the @.eventlog@ file,\n     or to stderr, depending on the runtime RTS flags. ")-  , ("setThreadAllocationCounter#"," Sets the allocation counter for the current thread to the given value. ")-  , ("StackSnapshot#"," Haskell representation of a @StgStack*@ that was created (cloned)\n     with a function in \"GHC.Stack.CloneStack\". Please check the\n     documentation in that module for more detailed explanations. ")-  , ("coerce"," The function 'coerce' allows you to safely convert between values of\n     types that have the same representation with no run-time overhead. In the\n     simplest case you can use it instead of a newtype constructor, to go from\n     the newtype's concrete type to the abstract type. But it also works in\n     more complicated settings, e.g. converting a list of newtypes to a list of\n     concrete types.\n\n     When used in conversions involving a newtype wrapper,\n     make sure the newtype constructor is in scope.\n\n     This function is representation-polymorphic, but the\n     'RuntimeRep' type argument is marked as 'Inferred', meaning\n     that it is not available for visible type application. This means\n     the typechecker will accept @'coerce' \\@'Int' \\@Age 42@.\n\n     === __Examples__\n\n     >>> newtype TTL = TTL Int deriving (Eq, Ord, Show)\n     >>> newtype Age = Age Int deriving (Eq, Ord, Show)\n     >>> coerce (Age 42) :: TTL\n     TTL 42\n     >>> coerce (+ (1 :: Int)) (Age 42) :: TTL\n     TTL 43\n     >>> coerce (map (+ (1 :: Int))) [Age 42, Age 24] :: [TTL]\n     [TTL 43,TTL 25]\n\n   ")-  , ("broadcastInt8X16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt16X8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt32X4#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt64X2#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt8X32#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt16X16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt32X8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt64X4#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt8X64#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt16X32#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt32X16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastInt64X8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord8X16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord16X8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord32X4#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord64X2#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord8X32#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord16X16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord32X8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord64X4#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord8X64#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord16X32#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord32X16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastWord64X8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastFloatX4#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastDoubleX2#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastFloatX8#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastDoubleX4#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastFloatX16#"," Broadcast a scalar to all elements of a vector. ")-  , ("broadcastDoubleX8#"," Broadcast a scalar to all elements of a vector. ")-  , ("packInt8X16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt16X8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt32X4#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt64X2#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt8X32#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt16X16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt32X8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt64X4#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt8X64#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt16X32#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt32X16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packInt64X8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord8X16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord16X8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord32X4#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord64X2#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord8X32#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord16X16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord32X8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord64X4#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord8X64#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord16X32#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord32X16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packWord64X8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packFloatX4#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packDoubleX2#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packFloatX8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packDoubleX4#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packFloatX16#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("packDoubleX8#"," Pack the elements of an unboxed tuple into a vector. ")-  , ("unpackInt8X16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt16X8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt32X4#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt64X2#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt8X32#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt16X16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt32X8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt64X4#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt8X64#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt16X32#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt32X16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackInt64X8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord8X16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord16X8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord32X4#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord64X2#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord8X32#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord16X16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord32X8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord64X4#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord8X64#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord16X32#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord32X16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackWord64X8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackFloatX4#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackDoubleX2#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackFloatX8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackDoubleX4#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackFloatX16#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("unpackDoubleX8#"," Unpack the elements of a vector into an unboxed tuple. #")-  , ("insertInt8X16#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt16X8#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt32X4#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt64X2#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt8X32#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt16X16#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt32X8#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt64X4#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt8X64#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt16X32#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt32X16#"," Insert a scalar at the given position in a vector. ")-  , ("insertInt64X8#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord8X16#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord16X8#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord32X4#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord64X2#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord8X32#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord16X16#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord32X8#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord64X4#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord8X64#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord16X32#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord32X16#"," Insert a scalar at the given position in a vector. ")-  , ("insertWord64X8#"," Insert a scalar at the given position in a vector. ")-  , ("insertFloatX4#"," Insert a scalar at the given position in a vector. ")-  , ("insertDoubleX2#"," Insert a scalar at the given position in a vector. ")-  , ("insertFloatX8#"," Insert a scalar at the given position in a vector. ")-  , ("insertDoubleX4#"," Insert a scalar at the given position in a vector. ")-  , ("insertFloatX16#"," Insert a scalar at the given position in a vector. ")-  , ("insertDoubleX8#"," Insert a scalar at the given position in a vector. ")-  , ("plusInt8X16#"," Add two vectors element-wise. ")-  , ("plusInt16X8#"," Add two vectors element-wise. ")-  , ("plusInt32X4#"," Add two vectors element-wise. ")-  , ("plusInt64X2#"," Add two vectors element-wise. ")-  , ("plusInt8X32#"," Add two vectors element-wise. ")-  , ("plusInt16X16#"," Add two vectors element-wise. ")-  , ("plusInt32X8#"," Add two vectors element-wise. ")-  , ("plusInt64X4#"," Add two vectors element-wise. ")-  , ("plusInt8X64#"," Add two vectors element-wise. ")-  , ("plusInt16X32#"," Add two vectors element-wise. ")-  , ("plusInt32X16#"," Add two vectors element-wise. ")-  , ("plusInt64X8#"," Add two vectors element-wise. ")-  , ("plusWord8X16#"," Add two vectors element-wise. ")-  , ("plusWord16X8#"," Add two vectors element-wise. ")-  , ("plusWord32X4#"," Add two vectors element-wise. ")-  , ("plusWord64X2#"," Add two vectors element-wise. ")-  , ("plusWord8X32#"," Add two vectors element-wise. ")-  , ("plusWord16X16#"," Add two vectors element-wise. ")-  , ("plusWord32X8#"," Add two vectors element-wise. ")-  , ("plusWord64X4#"," Add two vectors element-wise. ")-  , ("plusWord8X64#"," Add two vectors element-wise. ")-  , ("plusWord16X32#"," Add two vectors element-wise. ")-  , ("plusWord32X16#"," Add two vectors element-wise. ")-  , ("plusWord64X8#"," Add two vectors element-wise. ")-  , ("plusFloatX4#"," Add two vectors element-wise. ")-  , ("plusDoubleX2#"," Add two vectors element-wise. ")-  , ("plusFloatX8#"," Add two vectors element-wise. ")-  , ("plusDoubleX4#"," Add two vectors element-wise. ")-  , ("plusFloatX16#"," Add two vectors element-wise. ")-  , ("plusDoubleX8#"," Add two vectors element-wise. ")-  , ("minusInt8X16#"," Subtract two vectors element-wise. ")-  , ("minusInt16X8#"," Subtract two vectors element-wise. ")-  , ("minusInt32X4#"," Subtract two vectors element-wise. ")-  , ("minusInt64X2#"," Subtract two vectors element-wise. ")-  , ("minusInt8X32#"," Subtract two vectors element-wise. ")-  , ("minusInt16X16#"," Subtract two vectors element-wise. ")-  , ("minusInt32X8#"," Subtract two vectors element-wise. ")-  , ("minusInt64X4#"," Subtract two vectors element-wise. ")-  , ("minusInt8X64#"," Subtract two vectors element-wise. ")-  , ("minusInt16X32#"," Subtract two vectors element-wise. ")-  , ("minusInt32X16#"," Subtract two vectors element-wise. ")-  , ("minusInt64X8#"," Subtract two vectors element-wise. ")-  , ("minusWord8X16#"," Subtract two vectors element-wise. ")-  , ("minusWord16X8#"," Subtract two vectors element-wise. ")-  , ("minusWord32X4#"," Subtract two vectors element-wise. ")-  , ("minusWord64X2#"," Subtract two vectors element-wise. ")-  , ("minusWord8X32#"," Subtract two vectors element-wise. ")-  , ("minusWord16X16#"," Subtract two vectors element-wise. ")-  , ("minusWord32X8#"," Subtract two vectors element-wise. ")-  , ("minusWord64X4#"," Subtract two vectors element-wise. ")-  , ("minusWord8X64#"," Subtract two vectors element-wise. ")-  , ("minusWord16X32#"," Subtract two vectors element-wise. ")-  , ("minusWord32X16#"," Subtract two vectors element-wise. ")-  , ("minusWord64X8#"," Subtract two vectors element-wise. ")-  , ("minusFloatX4#"," Subtract two vectors element-wise. ")-  , ("minusDoubleX2#"," Subtract two vectors element-wise. ")-  , ("minusFloatX8#"," Subtract two vectors element-wise. ")-  , ("minusDoubleX4#"," Subtract two vectors element-wise. ")-  , ("minusFloatX16#"," Subtract two vectors element-wise. ")-  , ("minusDoubleX8#"," Subtract two vectors element-wise. ")-  , ("timesInt8X16#"," Multiply two vectors element-wise. ")-  , ("timesInt16X8#"," Multiply two vectors element-wise. ")-  , ("timesInt32X4#"," Multiply two vectors element-wise. ")-  , ("timesInt64X2#"," Multiply two vectors element-wise. ")-  , ("timesInt8X32#"," Multiply two vectors element-wise. ")-  , ("timesInt16X16#"," Multiply two vectors element-wise. ")-  , ("timesInt32X8#"," Multiply two vectors element-wise. ")-  , ("timesInt64X4#"," Multiply two vectors element-wise. ")-  , ("timesInt8X64#"," Multiply two vectors element-wise. ")-  , ("timesInt16X32#"," Multiply two vectors element-wise. ")-  , ("timesInt32X16#"," Multiply two vectors element-wise. ")-  , ("timesInt64X8#"," Multiply two vectors element-wise. ")-  , ("timesWord8X16#"," Multiply two vectors element-wise. ")-  , ("timesWord16X8#"," Multiply two vectors element-wise. ")-  , ("timesWord32X4#"," Multiply two vectors element-wise. ")-  , ("timesWord64X2#"," Multiply two vectors element-wise. ")-  , ("timesWord8X32#"," Multiply two vectors element-wise. ")-  , ("timesWord16X16#"," Multiply two vectors element-wise. ")-  , ("timesWord32X8#"," Multiply two vectors element-wise. ")-  , ("timesWord64X4#"," Multiply two vectors element-wise. ")-  , ("timesWord8X64#"," Multiply two vectors element-wise. ")-  , ("timesWord16X32#"," Multiply two vectors element-wise. ")-  , ("timesWord32X16#"," Multiply two vectors element-wise. ")-  , ("timesWord64X8#"," Multiply two vectors element-wise. ")-  , ("timesFloatX4#"," Multiply two vectors element-wise. ")-  , ("timesDoubleX2#"," Multiply two vectors element-wise. ")-  , ("timesFloatX8#"," Multiply two vectors element-wise. ")-  , ("timesDoubleX4#"," Multiply two vectors element-wise. ")-  , ("timesFloatX16#"," Multiply two vectors element-wise. ")-  , ("timesDoubleX8#"," Multiply two vectors element-wise. ")-  , ("divideFloatX4#"," Divide two vectors element-wise. ")-  , ("divideDoubleX2#"," Divide two vectors element-wise. ")-  , ("divideFloatX8#"," Divide two vectors element-wise. ")-  , ("divideDoubleX4#"," Divide two vectors element-wise. ")-  , ("divideFloatX16#"," Divide two vectors element-wise. ")-  , ("divideDoubleX8#"," Divide two vectors element-wise. ")-  , ("quotInt8X16#"," Rounds towards zero element-wise. ")-  , ("quotInt16X8#"," Rounds towards zero element-wise. ")-  , ("quotInt32X4#"," Rounds towards zero element-wise. ")-  , ("quotInt64X2#"," Rounds towards zero element-wise. ")-  , ("quotInt8X32#"," Rounds towards zero element-wise. ")-  , ("quotInt16X16#"," Rounds towards zero element-wise. ")-  , ("quotInt32X8#"," Rounds towards zero element-wise. ")-  , ("quotInt64X4#"," Rounds towards zero element-wise. ")-  , ("quotInt8X64#"," Rounds towards zero element-wise. ")-  , ("quotInt16X32#"," Rounds towards zero element-wise. ")-  , ("quotInt32X16#"," Rounds towards zero element-wise. ")-  , ("quotInt64X8#"," Rounds towards zero element-wise. ")-  , ("quotWord8X16#"," Rounds towards zero element-wise. ")-  , ("quotWord16X8#"," Rounds towards zero element-wise. ")-  , ("quotWord32X4#"," Rounds towards zero element-wise. ")-  , ("quotWord64X2#"," Rounds towards zero element-wise. ")-  , ("quotWord8X32#"," Rounds towards zero element-wise. ")-  , ("quotWord16X16#"," Rounds towards zero element-wise. ")-  , ("quotWord32X8#"," Rounds towards zero element-wise. ")-  , ("quotWord64X4#"," Rounds towards zero element-wise. ")-  , ("quotWord8X64#"," Rounds towards zero element-wise. ")-  , ("quotWord16X32#"," Rounds towards zero element-wise. ")-  , ("quotWord32X16#"," Rounds towards zero element-wise. ")-  , ("quotWord64X8#"," Rounds towards zero element-wise. ")-  , ("remInt8X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt16X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt32X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt64X2#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt8X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt16X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt32X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt64X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt8X64#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt16X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt32X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remInt64X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord8X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord16X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord32X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord64X2#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord8X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord16X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord32X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord64X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord8X64#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord16X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord32X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("remWord64X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")-  , ("negateInt8X16#"," Negate element-wise. ")-  , ("negateInt16X8#"," Negate element-wise. ")-  , ("negateInt32X4#"," Negate element-wise. ")-  , ("negateInt64X2#"," Negate element-wise. ")-  , ("negateInt8X32#"," Negate element-wise. ")-  , ("negateInt16X16#"," Negate element-wise. ")-  , ("negateInt32X8#"," Negate element-wise. ")-  , ("negateInt64X4#"," Negate element-wise. ")-  , ("negateInt8X64#"," Negate element-wise. ")-  , ("negateInt16X32#"," Negate element-wise. ")-  , ("negateInt32X16#"," Negate element-wise. ")-  , ("negateInt64X8#"," Negate element-wise. ")-  , ("negateFloatX4#"," Negate element-wise. ")-  , ("negateDoubleX2#"," Negate element-wise. ")-  , ("negateFloatX8#"," Negate element-wise. ")-  , ("negateDoubleX4#"," Negate element-wise. ")-  , ("negateFloatX16#"," Negate element-wise. ")-  , ("negateDoubleX8#"," Negate element-wise. ")-  , ("indexInt8X16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt16X8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt32X4Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt64X2Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt8X32Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt16X16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt32X8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt64X4Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt8X64Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt16X32Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt32X16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexInt64X8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord8X16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord16X8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord32X4Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord64X2Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord8X32Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord16X16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord32X8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord64X4Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord8X64Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord16X32Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord32X16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexWord64X8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexFloatX4Array#"," Read a vector from specified index of immutable array. ")-  , ("indexDoubleX2Array#"," Read a vector from specified index of immutable array. ")-  , ("indexFloatX8Array#"," Read a vector from specified index of immutable array. ")-  , ("indexDoubleX4Array#"," Read a vector from specified index of immutable array. ")-  , ("indexFloatX16Array#"," Read a vector from specified index of immutable array. ")-  , ("indexDoubleX8Array#"," Read a vector from specified index of immutable array. ")-  , ("readInt8X16Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt16X8Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt32X4Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt64X2Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt8X32Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt16X16Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt32X8Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt64X4Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt8X64Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt16X32Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt32X16Array#"," Read a vector from specified index of mutable array. ")-  , ("readInt64X8Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord8X16Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord16X8Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord32X4Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord64X2Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord8X32Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord16X16Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord32X8Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord64X4Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord8X64Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord16X32Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord32X16Array#"," Read a vector from specified index of mutable array. ")-  , ("readWord64X8Array#"," Read a vector from specified index of mutable array. ")-  , ("readFloatX4Array#"," Read a vector from specified index of mutable array. ")-  , ("readDoubleX2Array#"," Read a vector from specified index of mutable array. ")-  , ("readFloatX8Array#"," Read a vector from specified index of mutable array. ")-  , ("readDoubleX4Array#"," Read a vector from specified index of mutable array. ")-  , ("readFloatX16Array#"," Read a vector from specified index of mutable array. ")-  , ("readDoubleX8Array#"," Read a vector from specified index of mutable array. ")-  , ("writeInt8X16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt16X8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt32X4Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt64X2Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt8X32Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt16X16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt32X8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt64X4Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt8X64Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt16X32Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt32X16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeInt64X8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord8X16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord16X8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord32X4Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord64X2Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord8X32Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord16X16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord32X8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord64X4Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord8X64Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord16X32Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord32X16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeWord64X8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeFloatX4Array#"," Write a vector to specified index of mutable array. ")-  , ("writeDoubleX2Array#"," Write a vector to specified index of mutable array. ")-  , ("writeFloatX8Array#"," Write a vector to specified index of mutable array. ")-  , ("writeDoubleX4Array#"," Write a vector to specified index of mutable array. ")-  , ("writeFloatX16Array#"," Write a vector to specified index of mutable array. ")-  , ("writeDoubleX8Array#"," Write a vector to specified index of mutable array. ")-  , ("indexInt8X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt16X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt32X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt64X2OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt8X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt16X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt32X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt64X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt8X64OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt16X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt32X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexInt64X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord8X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord16X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord32X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord64X2OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord8X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord16X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord32X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord64X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord8X64OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord16X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord32X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexWord64X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexFloatX4OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexDoubleX2OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexFloatX8OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexDoubleX4OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexFloatX16OffAddr#"," Reads vector; offset in bytes. ")-  , ("indexDoubleX8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt8X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt16X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt32X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt64X2OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt8X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt16X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt32X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt64X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt8X64OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt16X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt32X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readInt64X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord8X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord16X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord32X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord64X2OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord8X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord16X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord32X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord64X4OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord8X64OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord16X32OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord32X16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readWord64X8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readFloatX4OffAddr#"," Reads vector; offset in bytes. ")-  , ("readDoubleX2OffAddr#"," Reads vector; offset in bytes. ")-  , ("readFloatX8OffAddr#"," Reads vector; offset in bytes. ")-  , ("readDoubleX4OffAddr#"," Reads vector; offset in bytes. ")-  , ("readFloatX16OffAddr#"," Reads vector; offset in bytes. ")-  , ("readDoubleX8OffAddr#"," Reads vector; offset in bytes. ")-  , ("writeInt8X16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt16X8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt32X4OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt64X2OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt8X32OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt16X16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt32X8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt64X4OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt8X64OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt16X32OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt32X16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeInt64X8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord8X16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord16X8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord32X4OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord64X2OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord8X32OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord16X16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord32X8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord64X4OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord8X64OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord16X32OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord32X16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeWord64X8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeFloatX4OffAddr#"," Write vector; offset in bytes. ")-  , ("writeDoubleX2OffAddr#"," Write vector; offset in bytes. ")-  , ("writeFloatX8OffAddr#"," Write vector; offset in bytes. ")-  , ("writeDoubleX4OffAddr#"," Write vector; offset in bytes. ")-  , ("writeFloatX16OffAddr#"," Write vector; offset in bytes. ")-  , ("writeDoubleX8OffAddr#"," Write vector; offset in bytes. ")-  , ("indexInt8ArrayAsInt8X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt16ArrayAsInt16X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt32ArrayAsInt32X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt64ArrayAsInt64X2#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt8ArrayAsInt8X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt16ArrayAsInt16X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt32ArrayAsInt32X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt64ArrayAsInt64X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt8ArrayAsInt8X64#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt16ArrayAsInt16X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt32ArrayAsInt32X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexInt64ArrayAsInt64X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord8ArrayAsWord8X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord16ArrayAsWord16X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord32ArrayAsWord32X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord64ArrayAsWord64X2#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord8ArrayAsWord8X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord16ArrayAsWord16X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord32ArrayAsWord32X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord64ArrayAsWord64X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord8ArrayAsWord8X64#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord16ArrayAsWord16X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord32ArrayAsWord32X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexWord64ArrayAsWord64X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexFloatArrayAsFloatX4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexDoubleArrayAsDoubleX2#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexFloatArrayAsFloatX8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexDoubleArrayAsDoubleX4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexFloatArrayAsFloatX16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("indexDoubleArrayAsDoubleX8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")-  , ("readInt8ArrayAsInt8X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt16ArrayAsInt16X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt32ArrayAsInt32X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt64ArrayAsInt64X2#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt8ArrayAsInt8X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt16ArrayAsInt16X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt32ArrayAsInt32X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt64ArrayAsInt64X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt8ArrayAsInt8X64#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt16ArrayAsInt16X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt32ArrayAsInt32X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readInt64ArrayAsInt64X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord8ArrayAsWord8X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord16ArrayAsWord16X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord32ArrayAsWord32X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord64ArrayAsWord64X2#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord8ArrayAsWord8X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord16ArrayAsWord16X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord32ArrayAsWord32X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord64ArrayAsWord64X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord8ArrayAsWord8X64#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord16ArrayAsWord16X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord32ArrayAsWord32X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readWord64ArrayAsWord64X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readFloatArrayAsFloatX4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readDoubleArrayAsDoubleX2#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readFloatArrayAsFloatX8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readDoubleArrayAsDoubleX4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readFloatArrayAsFloatX16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("readDoubleArrayAsDoubleX8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt8ArrayAsInt8X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt16ArrayAsInt16X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt32ArrayAsInt32X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt64ArrayAsInt64X2#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt8ArrayAsInt8X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt16ArrayAsInt16X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt32ArrayAsInt32X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt64ArrayAsInt64X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt8ArrayAsInt8X64#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt16ArrayAsInt16X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt32ArrayAsInt32X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeInt64ArrayAsInt64X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord8ArrayAsWord8X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord16ArrayAsWord16X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord32ArrayAsWord32X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord64ArrayAsWord64X2#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord8ArrayAsWord8X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord16ArrayAsWord16X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord32ArrayAsWord32X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord64ArrayAsWord64X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord8ArrayAsWord8X64#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord16ArrayAsWord16X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord32ArrayAsWord32X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeWord64ArrayAsWord64X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeFloatArrayAsFloatX4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeDoubleArrayAsDoubleX2#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeFloatArrayAsFloatX8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeDoubleArrayAsDoubleX4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeFloatArrayAsFloatX16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("writeDoubleArrayAsDoubleX8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")-  , ("indexInt8OffAddrAsInt8X16#"," Reads vector; offset in scalar elements. ")-  , ("indexInt16OffAddrAsInt16X8#"," Reads vector; offset in scalar elements. ")-  , ("indexInt32OffAddrAsInt32X4#"," Reads vector; offset in scalar elements. ")-  , ("indexInt64OffAddrAsInt64X2#"," Reads vector; offset in scalar elements. ")-  , ("indexInt8OffAddrAsInt8X32#"," Reads vector; offset in scalar elements. ")-  , ("indexInt16OffAddrAsInt16X16#"," Reads vector; offset in scalar elements. ")-  , ("indexInt32OffAddrAsInt32X8#"," Reads vector; offset in scalar elements. ")-  , ("indexInt64OffAddrAsInt64X4#"," Reads vector; offset in scalar elements. ")-  , ("indexInt8OffAddrAsInt8X64#"," Reads vector; offset in scalar elements. ")-  , ("indexInt16OffAddrAsInt16X32#"," Reads vector; offset in scalar elements. ")-  , ("indexInt32OffAddrAsInt32X16#"," Reads vector; offset in scalar elements. ")-  , ("indexInt64OffAddrAsInt64X8#"," Reads vector; offset in scalar elements. ")-  , ("indexWord8OffAddrAsWord8X16#"," Reads vector; offset in scalar elements. ")-  , ("indexWord16OffAddrAsWord16X8#"," Reads vector; offset in scalar elements. ")-  , ("indexWord32OffAddrAsWord32X4#"," Reads vector; offset in scalar elements. ")-  , ("indexWord64OffAddrAsWord64X2#"," Reads vector; offset in scalar elements. ")-  , ("indexWord8OffAddrAsWord8X32#"," Reads vector; offset in scalar elements. ")-  , ("indexWord16OffAddrAsWord16X16#"," Reads vector; offset in scalar elements. ")-  , ("indexWord32OffAddrAsWord32X8#"," Reads vector; offset in scalar elements. ")-  , ("indexWord64OffAddrAsWord64X4#"," Reads vector; offset in scalar elements. ")-  , ("indexWord8OffAddrAsWord8X64#"," Reads vector; offset in scalar elements. ")-  , ("indexWord16OffAddrAsWord16X32#"," Reads vector; offset in scalar elements. ")-  , ("indexWord32OffAddrAsWord32X16#"," Reads vector; offset in scalar elements. ")-  , ("indexWord64OffAddrAsWord64X8#"," Reads vector; offset in scalar elements. ")-  , ("indexFloatOffAddrAsFloatX4#"," Reads vector; offset in scalar elements. ")-  , ("indexDoubleOffAddrAsDoubleX2#"," Reads vector; offset in scalar elements. ")-  , ("indexFloatOffAddrAsFloatX8#"," Reads vector; offset in scalar elements. ")-  , ("indexDoubleOffAddrAsDoubleX4#"," Reads vector; offset in scalar elements. ")-  , ("indexFloatOffAddrAsFloatX16#"," Reads vector; offset in scalar elements. ")-  , ("indexDoubleOffAddrAsDoubleX8#"," Reads vector; offset in scalar elements. ")-  , ("readInt8OffAddrAsInt8X16#"," Reads vector; offset in scalar elements. ")-  , ("readInt16OffAddrAsInt16X8#"," Reads vector; offset in scalar elements. ")-  , ("readInt32OffAddrAsInt32X4#"," Reads vector; offset in scalar elements. ")-  , ("readInt64OffAddrAsInt64X2#"," Reads vector; offset in scalar elements. ")-  , ("readInt8OffAddrAsInt8X32#"," Reads vector; offset in scalar elements. ")-  , ("readInt16OffAddrAsInt16X16#"," Reads vector; offset in scalar elements. ")-  , ("readInt32OffAddrAsInt32X8#"," Reads vector; offset in scalar elements. ")-  , ("readInt64OffAddrAsInt64X4#"," Reads vector; offset in scalar elements. ")-  , ("readInt8OffAddrAsInt8X64#"," Reads vector; offset in scalar elements. ")-  , ("readInt16OffAddrAsInt16X32#"," Reads vector; offset in scalar elements. ")-  , ("readInt32OffAddrAsInt32X16#"," Reads vector; offset in scalar elements. ")-  , ("readInt64OffAddrAsInt64X8#"," Reads vector; offset in scalar elements. ")-  , ("readWord8OffAddrAsWord8X16#"," Reads vector; offset in scalar elements. ")-  , ("readWord16OffAddrAsWord16X8#"," Reads vector; offset in scalar elements. ")-  , ("readWord32OffAddrAsWord32X4#"," Reads vector; offset in scalar elements. ")-  , ("readWord64OffAddrAsWord64X2#"," Reads vector; offset in scalar elements. ")-  , ("readWord8OffAddrAsWord8X32#"," Reads vector; offset in scalar elements. ")-  , ("readWord16OffAddrAsWord16X16#"," Reads vector; offset in scalar elements. ")-  , ("readWord32OffAddrAsWord32X8#"," Reads vector; offset in scalar elements. ")-  , ("readWord64OffAddrAsWord64X4#"," Reads vector; offset in scalar elements. ")-  , ("readWord8OffAddrAsWord8X64#"," Reads vector; offset in scalar elements. ")-  , ("readWord16OffAddrAsWord16X32#"," Reads vector; offset in scalar elements. ")-  , ("readWord32OffAddrAsWord32X16#"," Reads vector; offset in scalar elements. ")-  , ("readWord64OffAddrAsWord64X8#"," Reads vector; offset in scalar elements. ")-  , ("readFloatOffAddrAsFloatX4#"," Reads vector; offset in scalar elements. ")-  , ("readDoubleOffAddrAsDoubleX2#"," Reads vector; offset in scalar elements. ")-  , ("readFloatOffAddrAsFloatX8#"," Reads vector; offset in scalar elements. ")-  , ("readDoubleOffAddrAsDoubleX4#"," Reads vector; offset in scalar elements. ")-  , ("readFloatOffAddrAsFloatX16#"," Reads vector; offset in scalar elements. ")-  , ("readDoubleOffAddrAsDoubleX8#"," Reads vector; offset in scalar elements. ")-  , ("writeInt8OffAddrAsInt8X16#"," Write vector; offset in scalar elements. ")-  , ("writeInt16OffAddrAsInt16X8#"," Write vector; offset in scalar elements. ")-  , ("writeInt32OffAddrAsInt32X4#"," Write vector; offset in scalar elements. ")-  , ("writeInt64OffAddrAsInt64X2#"," Write vector; offset in scalar elements. ")-  , ("writeInt8OffAddrAsInt8X32#"," Write vector; offset in scalar elements. ")-  , ("writeInt16OffAddrAsInt16X16#"," Write vector; offset in scalar elements. ")-  , ("writeInt32OffAddrAsInt32X8#"," Write vector; offset in scalar elements. ")-  , ("writeInt64OffAddrAsInt64X4#"," Write vector; offset in scalar elements. ")-  , ("writeInt8OffAddrAsInt8X64#"," Write vector; offset in scalar elements. ")-  , ("writeInt16OffAddrAsInt16X32#"," Write vector; offset in scalar elements. ")-  , ("writeInt32OffAddrAsInt32X16#"," Write vector; offset in scalar elements. ")-  , ("writeInt64OffAddrAsInt64X8#"," Write vector; offset in scalar elements. ")-  , ("writeWord8OffAddrAsWord8X16#"," Write vector; offset in scalar elements. ")-  , ("writeWord16OffAddrAsWord16X8#"," Write vector; offset in scalar elements. ")-  , ("writeWord32OffAddrAsWord32X4#"," Write vector; offset in scalar elements. ")-  , ("writeWord64OffAddrAsWord64X2#"," Write vector; offset in scalar elements. ")-  , ("writeWord8OffAddrAsWord8X32#"," Write vector; offset in scalar elements. ")-  , ("writeWord16OffAddrAsWord16X16#"," Write vector; offset in scalar elements. ")-  , ("writeWord32OffAddrAsWord32X8#"," Write vector; offset in scalar elements. ")-  , ("writeWord64OffAddrAsWord64X4#"," Write vector; offset in scalar elements. ")-  , ("writeWord8OffAddrAsWord8X64#"," Write vector; offset in scalar elements. ")-  , ("writeWord16OffAddrAsWord16X32#"," Write vector; offset in scalar elements. ")-  , ("writeWord32OffAddrAsWord32X16#"," Write vector; offset in scalar elements. ")-  , ("writeWord64OffAddrAsWord64X8#"," Write vector; offset in scalar elements. ")-  , ("writeFloatOffAddrAsFloatX4#"," Write vector; offset in scalar elements. ")-  , ("writeDoubleOffAddrAsDoubleX2#"," Write vector; offset in scalar elements. ")-  , ("writeFloatOffAddrAsFloatX8#"," Write vector; offset in scalar elements. ")-  , ("writeDoubleOffAddrAsDoubleX4#"," Write vector; offset in scalar elements. ")-  , ("writeFloatOffAddrAsFloatX16#"," Write vector; offset in scalar elements. ")-  , ("writeDoubleOffAddrAsDoubleX8#"," Write vector; offset in scalar elements. ")+  [ (fsLit "*#","Low word of signed integer multiply.")+  , (fsLit "timesInt2#","Return a triple (isHighNeeded,high,low) where high and low are respectively\n   the high and low bits of the double-word result. isHighNeeded is a cheap way\n   to test if the high word is a sign-extension of the low word (isHighNeeded =\n   0#) or not (isHighNeeded = 1#).")+  , (fsLit "mulIntMayOflo#","Return non-zero if there is any possibility that the upper word of a\n    signed integer multiply might contain useful information.  Return\n    zero only if you are completely sure that no overflow can occur.\n    On a 32-bit platform, the recommended implementation is to do a\n    32 x 32 -> 64 signed multiply, and subtract result[63:32] from\n    (result[31] >>signed 31).  If this is zero, meaning that the\n    upper word is merely a sign extension of the lower one, no\n    overflow can occur.\n\n    On a 64-bit platform it is not always possible to\n    acquire the top 64 bits of the result.  Therefore, a recommended\n    implementation is to take the absolute value of both operands, and\n    return 0 iff bits[63:31] of them are zero, since that means that their\n    magnitudes fit within 31 bits, so the magnitude of the product must fit\n    into 62 bits.\n\n    If in doubt, return non-zero, but do make an effort to create the\n    correct answer for small args, since otherwise the performance of\n    @(*) :: Integer -> Integer -> Integer@ will be poor.\n   ")+  , (fsLit "quotInt#","Rounds towards zero. The behavior is undefined if the second argument is\n    zero.\n   ")+  , (fsLit "remInt#","Satisfies @('quotInt#' x y) '*#' y '+#' ('remInt#' x y) == x@. The\n    behavior is undefined if the second argument is zero.\n   ")+  , (fsLit "quotRemInt#","Rounds towards zero.")+  , (fsLit "andI#","Bitwise \"and\".")+  , (fsLit "orI#","Bitwise \"or\".")+  , (fsLit "xorI#","Bitwise \"xor\".")+  , (fsLit "notI#","Bitwise \"not\", also known as the binary complement.")+  , (fsLit "negateInt#","Unary negation.\n    Since the negative 'Int#' range extends one further than the\n    positive range, 'negateInt#' of the most negative number is an\n    identity operation. This way, 'negateInt#' is always its own inverse.")+  , (fsLit "addIntC#","Add signed integers reporting overflow.\n          First member of result is the sum truncated to an 'Int#';\n          second member is zero if the true sum fits in an 'Int#',\n          nonzero if overflow occurred (the sum is either too large\n          or too small to fit in an 'Int#').")+  , (fsLit "subIntC#","Subtract signed integers reporting overflow.\n          First member of result is the difference truncated to an 'Int#';\n          second member is zero if the true difference fits in an 'Int#',\n          nonzero if overflow occurred (the difference is either too large\n          or too small to fit in an 'Int#').")+  , (fsLit "int2Float#","Convert an 'Int#' to the corresponding 'Float#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'int2Float#' 1# == 1.0#@")+  , (fsLit "int2Double#","Convert an 'Int#' to the corresponding 'Double#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'int2Double#' 1# == 1.0##@")+  , (fsLit "word2Float#","Convert an 'Word#' to the corresponding 'Float#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'word2Float#' 1## == 1.0#@")+  , (fsLit "word2Double#","Convert an 'Word#' to the corresponding 'Double#' with the same\n    integral value (up to truncation due to floating-point precision). e.g.\n    @'word2Double#' 1## == 1.0##@")+  , (fsLit "uncheckedIShiftL#","Shift left.  Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")+  , (fsLit "uncheckedIShiftRA#","Shift right arithmetic.  Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")+  , (fsLit "uncheckedIShiftRL#","Shift right logical.  Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")+  , (fsLit "addWordC#","Add unsigned integers reporting overflow.\n          The first element of the pair is the result.  The second element is\n          the carry flag, which is nonzero on overflow. See also 'plusWord2#'.")+  , (fsLit "subWordC#","Subtract unsigned integers reporting overflow.\n          The first element of the pair is the result.  The second element is\n          the carry flag, which is nonzero on overflow.")+  , (fsLit "plusWord2#","Add unsigned integers, with the high part (carry) in the first\n          component of the returned pair and the low part in the second\n          component of the pair. See also 'addWordC#'.")+  , (fsLit "quotRemWord2#"," Takes high word of dividend, then low word of dividend, then divisor.\n           Requires that high word < divisor.")+  , (fsLit "uncheckedShiftL#","Shift left logical.   Result undefined if shift amount is not\n          in the range 0 to word size - 1 inclusive.")+  , (fsLit "uncheckedShiftRL#","Shift right logical.   Result undefined if shift  amount is not\n          in the range 0 to word size - 1 inclusive.")+  , (fsLit "popCnt8#","Count the number of set bits in the lower 8 bits of a word.")+  , (fsLit "popCnt16#","Count the number of set bits in the lower 16 bits of a word.")+  , (fsLit "popCnt32#","Count the number of set bits in the lower 32 bits of a word.")+  , (fsLit "popCnt64#","Count the number of set bits in a 64-bit word.")+  , (fsLit "popCnt#","Count the number of set bits in a word.")+  , (fsLit "pdep8#","Deposit bits to lower 8 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pdep16#","Deposit bits to lower 16 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pdep32#","Deposit bits to lower 32 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pdep64#","Deposit bits to a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pdep#","Deposit bits to a word at locations specified by a mask, aka\n    [parallel bit deposit](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract).\n\n    Software emulation:\n\n    > pdep :: Word -> Word -> Word\n    > pdep src mask = go 0 src mask\n    >   where\n    >     go :: Word -> Word -> Word -> Word\n    >     go result _ 0 = result\n    >     go result src mask = go newResult newSrc newMask\n    >       where\n    >         maskCtz   = countTrailingZeros mask\n    >         newResult = if testBit src 0 then setBit result maskCtz else result\n    >         newSrc    = src `shiftR` 1\n    >         newMask   = clearBit mask maskCtz\n\n    @since 0.5.2.0")+  , (fsLit "pext8#","Extract bits from lower 8 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pext16#","Extract bits from lower 16 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pext32#","Extract bits from lower 32 bits of a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pext64#","Extract bits from a word at locations specified by a mask.\n\n    @since 0.5.2.0")+  , (fsLit "pext#","Extract bits from a word at locations specified by a mask, aka\n    [parallel bit extract](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract).\n\n    Software emulation:\n\n    > pext :: Word -> Word -> Word\n    > pext src mask = loop 0 0 0\n    >   where\n    >     loop i count result\n    >       | i >= finiteBitSize (0 :: Word)\n    >       = result\n    >       | testBit mask i\n    >       = loop (i + 1) (count + 1) (if testBit src i then setBit result count else result)\n    >       | otherwise\n    >       = loop (i + 1) count result\n\n    @since 0.5.2.0")+  , (fsLit "clz8#","Count leading zeros in the lower 8 bits of a word.")+  , (fsLit "clz16#","Count leading zeros in the lower 16 bits of a word.")+  , (fsLit "clz32#","Count leading zeros in the lower 32 bits of a word.")+  , (fsLit "clz64#","Count leading zeros in a 64-bit word.")+  , (fsLit "clz#","Count leading zeros in a word.")+  , (fsLit "ctz8#","Count trailing zeros in the lower 8 bits of a word.")+  , (fsLit "ctz16#","Count trailing zeros in the lower 16 bits of a word.")+  , (fsLit "ctz32#","Count trailing zeros in the lower 32 bits of a word.")+  , (fsLit "ctz64#","Count trailing zeros in a 64-bit word.")+  , (fsLit "ctz#","Count trailing zeros in a word.")+  , (fsLit "byteSwap16#","Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. ")+  , (fsLit "byteSwap32#","Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. ")+  , (fsLit "byteSwap64#","Swap bytes in a 64 bits of a word.")+  , (fsLit "byteSwap#","Swap bytes in a word.")+  , (fsLit "bitReverse8#","Reverse the order of the bits in a 8-bit word.")+  , (fsLit "bitReverse16#","Reverse the order of the bits in a 16-bit word.")+  , (fsLit "bitReverse32#","Reverse the order of the bits in a 32-bit word.")+  , (fsLit "bitReverse64#","Reverse the order of the bits in a 64-bit word.")+  , (fsLit "bitReverse#","Reverse the order of the bits in a word.")+  , (fsLit "double2Int#","Truncates a 'Double#' value to the nearest 'Int#'.\n    Results are undefined if the truncation if truncation yields\n    a value outside the range of 'Int#'.")+  , (fsLit "**##","Exponentiation.")+  , (fsLit "decodeDouble_2Int#","Convert to integer.\n    First component of the result is -1 or 1, indicating the sign of the\n    mantissa. The next two are the high and low 32 bits of the mantissa\n    respectively, and the last is the exponent.")+  , (fsLit "decodeDouble_Int64#","Decode 'Double#' into mantissa and base-2 exponent.")+  , (fsLit "castDoubleToWord64#","Bitcast a 'Double#' into a 'Word64#'")+  , (fsLit "castWord64ToDouble#","Bitcast a 'Word64#' into a 'Double#'")+  , (fsLit "float2Int#","Truncates a 'Float#' value to the nearest 'Int#'.\n    Results are undefined if the truncation if truncation yields\n    a value outside the range of 'Int#'.")+  , (fsLit "decodeFloat_Int#","Convert to integers.\n    First 'Int#' in result is the mantissa; second is the exponent.")+  , (fsLit "castFloatToWord32#","Bitcast a 'Float#' into a 'Word32#'")+  , (fsLit "castWord32ToFloat#","Bitcast a 'Word32#' into a 'Float#'")+  , (fsLit "fmaddFloat#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubFloat#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddFloat#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubFloat#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmaddDouble#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubDouble#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddDouble#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubDouble#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "newArray#","Create a new mutable array with the specified number of elements,\n    in the specified state thread,\n    with each element containing the specified initial value.")+  , (fsLit "readArray#","Read from specified index of mutable array. Result is not yet evaluated.")+  , (fsLit "writeArray#","Write to specified index of mutable array.")+  , (fsLit "sizeofArray#","Return the number of elements in the array.")+  , (fsLit "sizeofMutableArray#","Return the number of elements in the array.")+  , (fsLit "indexArray#","Read from the specified index of an immutable array. The result is packaged\n    into an unboxed unary tuple; the result itself is not yet\n    evaluated. Pattern matching on the tuple forces the indexing of the\n    array to happen but does not evaluate the element itself. Evaluating\n    the thunk prevents additional thunks from building up on the\n    heap. Avoiding these thunks, in turn, reduces references to the\n    argument array, allowing it to be garbage collected more promptly.")+  , (fsLit "unsafeFreezeArray#","Make a mutable array immutable, without copying.")+  , (fsLit "unsafeThawArray#","Make an immutable array mutable, without copying.")+  , (fsLit "copyArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. Both arrays must fully contain the\n   specified ranges, but this is not checked. The two arrays must not\n   be the same array in different states, but this is not checked\n   either.")+  , (fsLit "copyMutableArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. Both arrays must fully contain the\n   specified ranges, but this is not checked. In the case where\n   the source and destination are the same array the source and\n   destination regions may overlap.")+  , (fsLit "cloneArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "cloneMutableArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "freezeArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "thawArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "casArray#","Given an array, an offset, the expected old value, and\n    the new value, perform an atomic compare and swap (i.e. write the new\n    value if the current value and the old value are the same pointer).\n    Returns 0 if the swap succeeds and 1 if it fails. Additionally, returns\n    the element at the offset after the operation completes. This means that\n    on a success the new value is returned, and on a failure the actual old\n    value (not the expected one) is returned. Implies a full memory barrier.\n    The use of a pointer equality on a boxed value makes this function harder\n    to use correctly than 'casIntArray#'. All of the difficulties\n    of using 'reallyUnsafePtrEquality#' correctly apply to\n    'casArray#' as well.\n   ")+  , (fsLit "newSmallArray#","Create a new mutable array with the specified number of elements,\n    in the specified state thread,\n    with each element containing the specified initial value.")+  , (fsLit "shrinkSmallMutableArray#","Shrink mutable array to new specified size, in\n    the specified state thread. The new size argument must be less than or\n    equal to the current size as reported by 'getSizeofSmallMutableArray#'.\n\n    Assuming the non-profiling RTS, for the copying garbage collector\n    (default) this primitive compiles to an O(1) operation in C--, modifying\n    the array in-place. For the non-moving garbage collector, however, the\n    time is proportional to the number of elements shrinked out. Backends\n    bypassing C-- representation (such as JavaScript) might behave\n    differently.\n\n    @since 0.6.1")+  , (fsLit "readSmallArray#","Read from specified index of mutable array. Result is not yet evaluated.")+  , (fsLit "writeSmallArray#","Write to specified index of mutable array.")+  , (fsLit "sizeofSmallArray#","Return the number of elements in the array.")+  , (fsLit "sizeofSmallMutableArray#","Return the number of elements in the array. __Deprecated__, it is\n   unsafe in the presence of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@\n   operations on the same small mutable array.")+  , (fsLit "getSizeofSmallMutableArray#","Return the number of elements in the array, correctly accounting for\n   the effect of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@.\n\n   @since 0.6.1")+  , (fsLit "indexSmallArray#","Read from specified index of immutable array. Result is packaged into\n    an unboxed singleton; the result itself is not yet evaluated.")+  , (fsLit "unsafeFreezeSmallArray#","Make a mutable array immutable, without copying.")+  , (fsLit "unsafeThawSmallArray#","Make an immutable array mutable, without copying.")+  , (fsLit "copySmallArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. Both arrays must fully contain the\n   specified ranges, but this is not checked. The two arrays must not\n   be the same array in different states, but this is not checked\n   either.")+  , (fsLit "copySmallMutableArray#","Given a source array, an offset into the source array, a\n   destination array, an offset into the destination array, and a\n   number of elements to copy, copy the elements from the source array\n   to the destination array. The source and destination arrays can\n   refer to the same array. Both arrays must fully contain the\n   specified ranges, but this is not checked.\n   The regions are allowed to overlap, although this is only possible when the same\n   array is provided as both the source and the destination. ")+  , (fsLit "cloneSmallArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "cloneSmallMutableArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "freezeSmallArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "thawSmallArray#","Given a source array, an offset into the source array, and a number\n   of elements to copy, create a new array with the elements from the\n   source array. The provided array must fully contain the specified\n   range, but this is not checked.")+  , (fsLit "casSmallArray#","Unsafe, machine-level atomic compare and swap on an element within an array.\n    See the documentation of 'casArray#'.")+  , (fsLit "ByteArray#","\n  A boxed, unlifted datatype representing a region of raw memory in the garbage-collected heap,\n  which is not scanned for pointers during garbage collection.\n\n  It is created by freezing a 'MutableByteArray#' with 'unsafeFreezeByteArray#'.\n  Freezing is essentially a no-op, as 'MutableByteArray#' and 'ByteArray#' share the same heap structure under the hood.\n\n  The immutable and mutable variants are commonly used for scenarios requiring high-performance data structures,\n  like @Text@, @Primitive Vector@, @Unboxed Array@, and @ShortByteString@.\n\n  Another application of fundamental importance is 'Integer', which is backed by 'ByteArray#'.\n\n  The representation on the heap of a Byte Array is:\n\n  > +------------+-----------------+-----------------------+\n  > |            |                 |                       |\n  > |   HEADER   | SIZE (in bytes) |       PAYLOAD         |\n  > |            |                 |                       |\n  > +------------+-----------------+-----------------------+\n\n  To obtain a pointer to actual payload (e.g., for FFI purposes) use 'byteArrayContents#' or 'mutableByteArrayContents#'.\n\n  Alternatively, enabling the @UnliftedFFITypes@ extension\n  allows to mention 'ByteArray#' and 'MutableByteArray#' in FFI type signatures directly.\n")+  , (fsLit "MutableByteArray#"," A mutable 'ByteAray#'. It can be created in three ways:\n\n  * 'newByteArray#': Create an unpinned array.\n  * 'newPinnedByteArray#': This will create a pinned array,\n  * 'newAlignedPinnedByteArray#': This will create a pinned array, with a custom alignment.\n\n  Unpinned arrays can be moved around during garbage collection, so you must not store or pass pointers to these values\n  if there is a chance for the garbage collector to kick in. That said, even unpinned arrays can be passed to unsafe FFI calls,\n  because no garbage collection happens during these unsafe calls\n  (see [Guaranteed Call Safety](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/ffi.html#guaranteed-call-safety)\n  in the GHC Manual). For safe FFI calls, byte arrays must be not only pinned, but also kept alive by means of the keepAlive# function\n  for the duration of a call (that's because garbage collection cannot move a pinned array, but is free to scrap it altogether).\n")+  , (fsLit "newByteArray#","Create a new mutable byte array of specified size (in bytes), in\n    the specified state thread. The size of the memory underlying the\n    array will be rounded up to the platform's word size.")+  , (fsLit "newPinnedByteArray#","Like 'newByteArray#' but GC guarantees not to move it.")+  , (fsLit "newAlignedPinnedByteArray#","Like 'newPinnedByteArray#' but allow specifying an arbitrary\n    alignment, which must be a power of two.")+  , (fsLit "isMutableByteArrayPinned#","Determine whether a 'MutableByteArray#' is guaranteed not to move\n   during GC.")+  , (fsLit "isByteArrayPinned#","Determine whether a 'ByteArray#' is guaranteed not to move.")+  , (fsLit "isByteArrayWeaklyPinned#","Similar to 'isByteArrayPinned#'. Weakly pinned byte arrays are allowed\n    to be copied into compact regions by the user, potentially invalidating\n    the results of earlier calls to 'byteArrayContents#'.\n\n    See the section `Pinned Byte Arrays` in the user guide for more information.\n\n    This function also returns true for regular pinned bytearrays.\n   ")+  , (fsLit "isMutableByteArrayWeaklyPinned#"," 'isByteArrayWeaklyPinned#' but for mutable arrays.\n   ")+  , (fsLit "byteArrayContents#","Intended for use with pinned arrays; otherwise very unsafe!")+  , (fsLit "mutableByteArrayContents#","Intended for use with pinned arrays; otherwise very unsafe!")+  , (fsLit "shrinkMutableByteArray#","Shrink mutable byte array to new specified size (in bytes), in\n    the specified state thread. The new size argument must be less than or\n    equal to the current size as reported by 'getSizeofMutableByteArray#'.\n\n    Assuming the non-profiling RTS, this primitive compiles to an O(1)\n    operation in C--, modifying the array in-place. Backends bypassing C--\n    representation (such as JavaScript) might behave differently.\n\n    @since 0.4.0.0")+  , (fsLit "resizeMutableByteArray#","Resize mutable byte array to new specified size (in bytes), shrinking or growing it.\n    The returned 'MutableByteArray#' is either the original\n    'MutableByteArray#' resized in-place or, if not possible, a newly\n    allocated (unpinned) 'MutableByteArray#' (with the original content\n    copied over).\n\n    To avoid undefined behaviour, the original 'MutableByteArray#' shall\n    not be accessed anymore after a 'resizeMutableByteArray#' has been\n    performed.  Moreover, no reference to the old one should be kept in order\n    to allow garbage collection of the original 'MutableByteArray#' in\n    case a new 'MutableByteArray#' had to be allocated.\n\n    @since 0.4.0.0")+  , (fsLit "unsafeFreezeByteArray#","Make a mutable byte array immutable, without copying.")+  , (fsLit "unsafeThawByteArray#","Make an immutable byte array mutable, without copying.\n\n    @since 0.12.0.0")+  , (fsLit "sizeofByteArray#","Return the size of the array in bytes.")+  , (fsLit "sizeofMutableByteArray#","Return the size of the array in bytes. __Deprecated__, it is\n   unsafe in the presence of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'\n   operations on the same mutable byte\n   array.")+  , (fsLit "getSizeofMutableByteArray#","Return the number of elements in the array, correctly accounting for\n   the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'.\n\n   @since 0.5.0.0")+  , (fsLit "indexCharArray#","Read an 8-bit character from immutable array; offset in bytes.")+  , (fsLit "indexWideCharArray#","Read a 32-bit character from immutable array; offset in 4-byte words.")+  , (fsLit "indexIntArray#","Read a word-sized integer from immutable array; offset in machine words.")+  , (fsLit "indexWordArray#","Read a word-sized unsigned integer from immutable array; offset in machine words.")+  , (fsLit "indexAddrArray#","Read a machine address from immutable array; offset in machine words.")+  , (fsLit "indexFloatArray#","Read a single-precision floating-point value from immutable array; offset in 4-byte words.")+  , (fsLit "indexDoubleArray#","Read a double-precision floating-point value from immutable array; offset in 8-byte words.")+  , (fsLit "indexStablePtrArray#","Read a 'StablePtr#' value from immutable array; offset in machine words.")+  , (fsLit "indexInt8Array#","Read an 8-bit signed integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8Array#","Read an 8-bit unsigned integer from immutable array; offset in bytes.")+  , (fsLit "indexInt16Array#","Read a 16-bit signed integer from immutable array; offset in 2-byte words.")+  , (fsLit "indexWord16Array#","Read a 16-bit unsigned integer from immutable array; offset in 2-byte words.")+  , (fsLit "indexInt32Array#","Read a 32-bit signed integer from immutable array; offset in 4-byte words.")+  , (fsLit "indexWord32Array#","Read a 32-bit unsigned integer from immutable array; offset in 4-byte words.")+  , (fsLit "indexInt64Array#","Read a 64-bit signed integer from immutable array; offset in 8-byte words.")+  , (fsLit "indexWord64Array#","Read a 64-bit unsigned integer from immutable array; offset in 8-byte words.")+  , (fsLit "indexWord8ArrayAsChar#","Read an 8-bit character from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsWideChar#","Read a 32-bit character from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsInt#","Read a word-sized integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsWord#","Read a word-sized unsigned integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsAddr#","Read a machine address from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsFloat#","Read a single-precision floating-point value from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsDouble#","Read a double-precision floating-point value from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsStablePtr#","Read a 'StablePtr#' value from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsInt16#","Read a 16-bit signed integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsWord16#","Read a 16-bit unsigned integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsInt32#","Read a 32-bit signed integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsWord32#","Read a 32-bit unsigned integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsInt64#","Read a 64-bit signed integer from immutable array; offset in bytes.")+  , (fsLit "indexWord8ArrayAsWord64#","Read a 64-bit unsigned integer from immutable array; offset in bytes.")+  , (fsLit "readCharArray#","Read an 8-bit character from mutable array; offset in bytes.")+  , (fsLit "readWideCharArray#","Read a 32-bit character from mutable array; offset in 4-byte words.")+  , (fsLit "readIntArray#","Read a word-sized integer from mutable array; offset in machine words.")+  , (fsLit "readWordArray#","Read a word-sized unsigned integer from mutable array; offset in machine words.")+  , (fsLit "readAddrArray#","Read a machine address from mutable array; offset in machine words.")+  , (fsLit "readFloatArray#","Read a single-precision floating-point value from mutable array; offset in 4-byte words.")+  , (fsLit "readDoubleArray#","Read a double-precision floating-point value from mutable array; offset in 8-byte words.")+  , (fsLit "readStablePtrArray#","Read a 'StablePtr#' value from mutable array; offset in machine words.")+  , (fsLit "readInt8Array#","Read an 8-bit signed integer from mutable array; offset in bytes.")+  , (fsLit "readWord8Array#","Read an 8-bit unsigned integer from mutable array; offset in bytes.")+  , (fsLit "readInt16Array#","Read a 16-bit signed integer from mutable array; offset in 2-byte words.")+  , (fsLit "readWord16Array#","Read a 16-bit unsigned integer from mutable array; offset in 2-byte words.")+  , (fsLit "readInt32Array#","Read a 32-bit signed integer from mutable array; offset in 4-byte words.")+  , (fsLit "readWord32Array#","Read a 32-bit unsigned integer from mutable array; offset in 4-byte words.")+  , (fsLit "readInt64Array#","Read a 64-bit signed integer from mutable array; offset in 8-byte words.")+  , (fsLit "readWord64Array#","Read a 64-bit unsigned integer from mutable array; offset in 8-byte words.")+  , (fsLit "readWord8ArrayAsChar#","Read an 8-bit character from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsWideChar#","Read a 32-bit character from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsInt#","Read a word-sized integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsWord#","Read a word-sized unsigned integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsAddr#","Read a machine address from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsFloat#","Read a single-precision floating-point value from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsDouble#","Read a double-precision floating-point value from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsStablePtr#","Read a 'StablePtr#' value from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsInt16#","Read a 16-bit signed integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsWord16#","Read a 16-bit unsigned integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsInt32#","Read a 32-bit signed integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsWord32#","Read a 32-bit unsigned integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsInt64#","Read a 64-bit signed integer from mutable array; offset in bytes.")+  , (fsLit "readWord8ArrayAsWord64#","Read a 64-bit unsigned integer from mutable array; offset in bytes.")+  , (fsLit "writeCharArray#","Write an 8-bit character to mutable array; offset in bytes.")+  , (fsLit "writeWideCharArray#","Write a 32-bit character to mutable array; offset in 4-byte words.")+  , (fsLit "writeIntArray#","Write a word-sized integer to mutable array; offset in machine words.")+  , (fsLit "writeWordArray#","Write a word-sized unsigned integer to mutable array; offset in machine words.")+  , (fsLit "writeAddrArray#","Write a machine address to mutable array; offset in machine words.")+  , (fsLit "writeFloatArray#","Write a single-precision floating-point value to mutable array; offset in 4-byte words.")+  , (fsLit "writeDoubleArray#","Write a double-precision floating-point value to mutable array; offset in 8-byte words.")+  , (fsLit "writeStablePtrArray#","Write a 'StablePtr#' value to mutable array; offset in machine words.")+  , (fsLit "writeInt8Array#","Write an 8-bit signed integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8Array#","Write an 8-bit unsigned integer to mutable array; offset in bytes.")+  , (fsLit "writeInt16Array#","Write a 16-bit signed integer to mutable array; offset in 2-byte words.")+  , (fsLit "writeWord16Array#","Write a 16-bit unsigned integer to mutable array; offset in 2-byte words.")+  , (fsLit "writeInt32Array#","Write a 32-bit signed integer to mutable array; offset in 4-byte words.")+  , (fsLit "writeWord32Array#","Write a 32-bit unsigned integer to mutable array; offset in 4-byte words.")+  , (fsLit "writeInt64Array#","Write a 64-bit signed integer to mutable array; offset in 8-byte words.")+  , (fsLit "writeWord64Array#","Write a 64-bit unsigned integer to mutable array; offset in 8-byte words.")+  , (fsLit "writeWord8ArrayAsChar#","Write an 8-bit character to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsWideChar#","Write a 32-bit character to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsInt#","Write a word-sized integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsWord#","Write a word-sized unsigned integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsAddr#","Write a machine address to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsFloat#","Write a single-precision floating-point value to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsDouble#","Write a double-precision floating-point value to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsStablePtr#","Write a 'StablePtr#' value to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsInt16#","Write a 16-bit signed integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsWord16#","Write a 16-bit unsigned integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsInt32#","Write a 32-bit signed integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsWord32#","Write a 32-bit unsigned integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsInt64#","Write a 64-bit signed integer to mutable array; offset in bytes.")+  , (fsLit "writeWord8ArrayAsWord64#","Write a 64-bit unsigned integer to mutable array; offset in bytes.")+  , (fsLit "compareByteArrays#","@'compareByteArrays#' src1 src1_ofs src2 src2_ofs n@ compares\n    @n@ bytes starting at offset @src1_ofs@ in the first\n    'ByteArray#' @src1@ to the range of @n@ bytes\n    (i.e. same length) starting at offset @src2_ofs@ of the second\n    'ByteArray#' @src2@.  Both arrays must fully contain the\n    specified ranges, but this is not checked.  Returns an 'Int#'\n    less than, equal to, or greater than zero if the range is found,\n    respectively, to be byte-wise lexicographically less than, to\n    match, or be greater than the second range.\n\n    @since 0.5.2.0")+  , (fsLit "copyByteArray#"," @'copyByteArray#' src src_ofs dst dst_ofs len@ copies the range\n    starting at offset @src_ofs@ of length @len@ from the\n    'ByteArray#' @src@ to the 'MutableByteArray#' @dst@\n    starting at offset @dst_ofs@.  Both arrays must fully contain\n    the specified ranges, but this is not checked.  The two arrays must\n    not be the same array in different states, but this is not checked\n    either.\n  ")+  , (fsLit "copyMutableByteArray#"," @'copyMutableByteArray#' src src_ofs dst dst_ofs len@ copies the\n    range starting at offset @src_ofs@ of length @len@ from the\n    'MutableByteArray#' @src@ to the 'MutableByteArray#' @dst@\n    starting at offset @dst_ofs@.  Both arrays must fully contain the\n    specified ranges, but this is not checked.  The regions are\n    allowed to overlap, although this is only possible when the same\n    array is provided as both the source and the destination.\n  ")+  , (fsLit "copyMutableByteArrayNonOverlapping#"," @'copyMutableByteArrayNonOverlapping#' src src_ofs dst dst_ofs len@\n    copies the range starting at offset @src_ofs@ of length @len@ from\n    the 'MutableByteArray#' @src@ to the 'MutableByteArray#' @dst@\n    starting at offset @dst_ofs@.  Both arrays must fully contain the\n    specified ranges, but this is not checked.  The regions are /not/\n    allowed to overlap, but this is also not checked.\n\n    @since 0.11.0\n  ")+  , (fsLit "copyByteArrayToAddr#","Copy a range of the ByteArray\\# to the memory range starting at the Addr\\#.\n   The ByteArray\\# and the memory region at Addr\\# must fully contain the\n   specified ranges, but this is not checked. The Addr\\# must not point into the\n   ByteArray\\# (e.g. if the ByteArray\\# were pinned), but this is not checked\n   either.")+  , (fsLit "copyMutableByteArrayToAddr#","Copy a range of the MutableByteArray\\# to the memory range starting at the\n   Addr\\#. The MutableByteArray\\# and the memory region at Addr\\# must fully\n   contain the specified ranges, but this is not checked. The Addr\\# must not\n   point into the MutableByteArray\\# (e.g. if the MutableByteArray\\# were\n   pinned), but this is not checked either.")+  , (fsLit "copyAddrToByteArray#","Copy a memory range starting at the Addr\\# to the specified range in the\n   MutableByteArray\\#. The memory region at Addr\\# and the ByteArray\\# must fully\n   contain the specified ranges, but this is not checked. The Addr\\# must not\n   point into the MutableByteArray\\# (e.g. if the MutableByteArray\\# were pinned),\n   but this is not checked either.")+  , (fsLit "copyAddrToAddr#"," @'copyAddrToAddr#' src dest len@ copies @len@ bytes\n    from @src@ to @dest@.  These two memory ranges are allowed to overlap.\n\n    Analogous to the standard C function @memmove@, but with a different\n    argument order.\n\n    @since 0.11.0\n  ")+  , (fsLit "copyAddrToAddrNonOverlapping#"," @'copyAddrToAddrNonOverlapping#' src dest len@ copies @len@ bytes\n    from @src@ to @dest@.  As the name suggests, these two memory ranges\n    /must not overlap/, although this pre-condition is not checked.\n\n    Analogous to the standard C function @memcpy@, but with a different\n    argument order.\n\n    @since 0.11.0\n  ")+  , (fsLit "setByteArray#","@'setByteArray#' ba off len c@ sets the byte range @[off, off+len)@ of\n   the 'MutableByteArray#' to the byte @c@.")+  , (fsLit "setAddrRange#"," @'setAddrRange#' dest len c@ sets all of the bytes in\n    @[dest, dest+len)@ to the value @c@.\n\n    Analogous to the standard C function @memset@, but with a different\n    argument order.\n\n    @since 0.11.0\n  ")+  , (fsLit "atomicReadIntArray#","Given an array and an offset in machine words, read an element. The\n    index is assumed to be in bounds. Implies a full memory barrier.")+  , (fsLit "atomicWriteIntArray#","Given an array and an offset in machine words, write an element. The\n    index is assumed to be in bounds. Implies a full memory barrier.")+  , (fsLit "casIntArray#","Given an array, an offset in machine words, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , (fsLit "casInt8Array#","Given an array, an offset in bytes, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , (fsLit "casInt16Array#","Given an array, an offset in 16 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , (fsLit "casInt32Array#","Given an array, an offset in 32 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , (fsLit "casInt64Array#","Given an array, an offset in 64 bit units, the expected old value, and\n    the new value, perform an atomic compare and swap i.e. write the new\n    value if the current value matches the provided old value. Returns\n    the value of the element before the operation. Implies a full memory\n    barrier.")+  , (fsLit "fetchAddIntArray#","Given an array, and offset in machine words, and a value to add,\n    atomically add the value to the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchSubIntArray#","Given an array, and offset in machine words, and a value to subtract,\n    atomically subtract the value from the element. Returns the value of\n    the element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchAndIntArray#","Given an array, and offset in machine words, and a value to AND,\n    atomically AND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchNandIntArray#","Given an array, and offset in machine words, and a value to NAND,\n    atomically NAND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchOrIntArray#","Given an array, and offset in machine words, and a value to OR,\n    atomically OR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchXorIntArray#","Given an array, and offset in machine words, and a value to XOR,\n    atomically XOR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "Addr#"," An arbitrary machine address assumed to point outside\n         the garbage-collected heap. ")+  , (fsLit "nullAddr#"," The null address. ")+  , (fsLit "minusAddr#","Result is meaningless if two 'Addr#'s are so far apart that their\n         difference doesn't fit in an 'Int#'.")+  , (fsLit "remAddr#","Return the remainder when the 'Addr#' arg, treated like an 'Int#',\n          is divided by the 'Int#' arg.")+  , (fsLit "addr2Int#","Coerce directly from address to int. Users are discouraged from using\n         this operation as it makes little sense on platforms with tagged pointers.")+  , (fsLit "int2Addr#","Coerce directly from int to address. Users are discouraged from using\n         this operation as it makes little sense on platforms with tagged pointers.")+  , (fsLit "indexCharOffAddr#","Read an 8-bit character from immutable address; offset in bytes.\n\n")+  , (fsLit "indexWideCharOffAddr#","Read a 32-bit character from immutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexIntOffAddr#","Read a word-sized integer from immutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexWordOffAddr#","Read a word-sized unsigned integer from immutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexAddrOffAddr#","Read a machine address from immutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexFloatOffAddr#","Read a single-precision floating-point value from immutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexDoubleOffAddr#","Read a double-precision floating-point value from immutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexStablePtrOffAddr#","Read a 'StablePtr#' value from immutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexInt8OffAddr#","Read an 8-bit signed integer from immutable address; offset in bytes.\n\n")+  , (fsLit "indexWord8OffAddr#","Read an 8-bit unsigned integer from immutable address; offset in bytes.\n\n")+  , (fsLit "indexInt16OffAddr#","Read a 16-bit signed integer from immutable address; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexWord16OffAddr#","Read a 16-bit unsigned integer from immutable address; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexInt32OffAddr#","Read a 32-bit signed integer from immutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexWord32OffAddr#","Read a 32-bit unsigned integer from immutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexInt64OffAddr#","Read a 64-bit signed integer from immutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexWord64OffAddr#","Read a 64-bit unsigned integer from immutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "indexWord8OffAddrAsChar#","Read an 8-bit character from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsWideChar#","Read a 32-bit character from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsInt#","Read a word-sized integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsWord#","Read a word-sized unsigned integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsAddr#","Read a machine address from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsFloat#","Read a single-precision floating-point value from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsDouble#","Read a double-precision floating-point value from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsStablePtr#","Read a 'StablePtr#' value from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsInt16#","Read a 16-bit signed integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsWord16#","Read a 16-bit unsigned integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsInt32#","Read a 32-bit signed integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsWord32#","Read a 32-bit unsigned integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsInt64#","Read a 64-bit signed integer from immutable address; offset in bytes.")+  , (fsLit "indexWord8OffAddrAsWord64#","Read a 64-bit unsigned integer from immutable address; offset in bytes.")+  , (fsLit "readCharOffAddr#","Read an 8-bit character from mutable address; offset in bytes.\n\n")+  , (fsLit "readWideCharOffAddr#","Read a 32-bit character from mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readIntOffAddr#","Read a word-sized integer from mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readWordOffAddr#","Read a word-sized unsigned integer from mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readAddrOffAddr#","Read a machine address from mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readFloatOffAddr#","Read a single-precision floating-point value from mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readDoubleOffAddr#","Read a double-precision floating-point value from mutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readStablePtrOffAddr#","Read a 'StablePtr#' value from mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readInt8OffAddr#","Read an 8-bit signed integer from mutable address; offset in bytes.\n\n")+  , (fsLit "readWord8OffAddr#","Read an 8-bit unsigned integer from mutable address; offset in bytes.\n\n")+  , (fsLit "readInt16OffAddr#","Read a 16-bit signed integer from mutable address; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readWord16OffAddr#","Read a 16-bit unsigned integer from mutable address; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readInt32OffAddr#","Read a 32-bit signed integer from mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readWord32OffAddr#","Read a 32-bit unsigned integer from mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readInt64OffAddr#","Read a 64-bit signed integer from mutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readWord64OffAddr#","Read a 64-bit unsigned integer from mutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "readWord8OffAddrAsChar#","Read an 8-bit character from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsWideChar#","Read a 32-bit character from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsInt#","Read a word-sized integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsWord#","Read a word-sized unsigned integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsAddr#","Read a machine address from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsFloat#","Read a single-precision floating-point value from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsDouble#","Read a double-precision floating-point value from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsStablePtr#","Read a 'StablePtr#' value from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsInt16#","Read a 16-bit signed integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsWord16#","Read a 16-bit unsigned integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsInt32#","Read a 32-bit signed integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsWord32#","Read a 32-bit unsigned integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsInt64#","Read a 64-bit signed integer from mutable address; offset in bytes.")+  , (fsLit "readWord8OffAddrAsWord64#","Read a 64-bit unsigned integer from mutable address; offset in bytes.")+  , (fsLit "writeCharOffAddr#","Write an 8-bit character to mutable address; offset in bytes.\n\n")+  , (fsLit "writeWideCharOffAddr#","Write a 32-bit character to mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeIntOffAddr#","Write a word-sized integer to mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeWordOffAddr#","Write a word-sized unsigned integer to mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeAddrOffAddr#","Write a machine address to mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeFloatOffAddr#","Write a single-precision floating-point value to mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeDoubleOffAddr#","Write a double-precision floating-point value to mutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeStablePtrOffAddr#","Write a 'StablePtr#' value to mutable address; offset in machine words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeInt8OffAddr#","Write an 8-bit signed integer to mutable address; offset in bytes.\n\n")+  , (fsLit "writeWord8OffAddr#","Write an 8-bit unsigned integer to mutable address; offset in bytes.\n\n")+  , (fsLit "writeInt16OffAddr#","Write a 16-bit signed integer to mutable address; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeWord16OffAddr#","Write a 16-bit unsigned integer to mutable address; offset in 2-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeInt32OffAddr#","Write a 32-bit signed integer to mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeWord32OffAddr#","Write a 32-bit unsigned integer to mutable address; offset in 4-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeInt64OffAddr#","Write a 64-bit signed integer to mutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeWord64OffAddr#","Write a 64-bit unsigned integer to mutable address; offset in 8-byte words.\n\nOn some platforms, the access may fail\nfor an insufficiently aligned @Addr#@.")+  , (fsLit "writeWord8OffAddrAsChar#","Write an 8-bit character to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsWideChar#","Write a 32-bit character to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsInt#","Write a word-sized integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsWord#","Write a word-sized unsigned integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsAddr#","Write a machine address to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsFloat#","Write a single-precision floating-point value to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsDouble#","Write a double-precision floating-point value to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsStablePtr#","Write a 'StablePtr#' value to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsInt16#","Write a 16-bit signed integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsWord16#","Write a 16-bit unsigned integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsInt32#","Write a 32-bit signed integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsWord32#","Write a 32-bit unsigned integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsInt64#","Write a 64-bit signed integer to mutable address; offset in bytes.")+  , (fsLit "writeWord8OffAddrAsWord64#","Write a 64-bit unsigned integer to mutable address; offset in bytes.")+  , (fsLit "atomicExchangeAddrAddr#","The atomic exchange operation. Atomically exchanges the value at the first address\n    with the Addr# given as second argument. Implies a read barrier.")+  , (fsLit "atomicExchangeWordAddr#","The atomic exchange operation. Atomically exchanges the value at the address\n    with the given value. Returns the old value. Implies a read barrier.")+  , (fsLit "atomicCasAddrAddr#"," Compare and swap on a word-sized memory location.\n\n     Use as: \\s -> atomicCasAddrAddr# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , (fsLit "atomicCasWordAddr#"," Compare and swap on a word-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , (fsLit "atomicCasWord8Addr#"," Compare and swap on a 8 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr8# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , (fsLit "atomicCasWord16Addr#"," Compare and swap on a 16 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr16# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , (fsLit "atomicCasWord32Addr#"," Compare and swap on a 32 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr32# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , (fsLit "atomicCasWord64Addr#"," Compare and swap on a 64 bit-sized and aligned memory location.\n\n     Use as: \\s -> atomicCasWordAddr64# location expected desired s\n\n     This version always returns the old value read. This follows the normal\n     protocol for CAS operations (and matches the underlying instruction on\n     most architectures).\n\n     Implies a full memory barrier.")+  , (fsLit "fetchAddWordAddr#","Given an address, and a value to add,\n    atomically add the value to the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchSubWordAddr#","Given an address, and a value to subtract,\n    atomically subtract the value from the element. Returns the value of\n    the element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchAndWordAddr#","Given an address, and a value to AND,\n    atomically AND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchNandWordAddr#","Given an address, and a value to NAND,\n    atomically NAND the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchOrWordAddr#","Given an address, and a value to OR,\n    atomically OR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "fetchXorWordAddr#","Given an address, and a value to XOR,\n    atomically XOR the value into the element. Returns the value of the\n    element before the operation. Implies a full memory barrier.")+  , (fsLit "atomicReadWordAddr#","Given an address, read a machine word.  Implies a full memory barrier.")+  , (fsLit "atomicWriteWordAddr#","Given an address, write a machine word. Implies a full memory barrier.")+  , (fsLit "MutVar#","A 'MutVar#' behaves like a single-element mutable array.")+  , (fsLit "newMutVar#","Create 'MutVar#' with specified initial value in specified state thread.")+  , (fsLit "readMutVar#","Read contents of 'MutVar#'. Result is not yet evaluated.")+  , (fsLit "writeMutVar#","Write contents of 'MutVar#'.")+  , (fsLit "atomicSwapMutVar#","Atomically exchange the value of a 'MutVar#'.")+  , (fsLit "atomicModifyMutVar2#"," Modify the contents of a 'MutVar#', returning the previous\n     contents @x :: a@ and the result of applying the given function to the\n     previous contents @f x :: c@.\n\n     The @data@ type @c@ (not a @newtype@!) must be a record whose first field\n     is of lifted type @a :: Type@ and is not unpacked. For example, product\n     types @c ~ Solo a@ or @c ~ (a, b)@ work well. If the record type is both\n     monomorphic and strict in its first field, it's recommended to mark the\n     latter @{-# NOUNPACK #-}@ explicitly.\n\n     Under the hood 'atomicModifyMutVar2#' atomically replaces a pointer to an\n     old @x :: a@ with a pointer to a selector thunk @fst r@, where\n     @fst@ is a selector for the first field of the record and @r@ is a\n     function application thunk @r = f x@.\n\n     @atomicModifyIORef2Native@ from @atomic-modify-general@ package makes an\n     effort to reflect restrictions on @c@ faithfully, providing a\n     well-typed high-level wrapper.")+  , (fsLit "atomicModifyMutVar_#"," Modify the contents of a 'MutVar#', returning the previous\n     contents and the result of applying the given function to the\n     previous contents. ")+  , (fsLit "casMutVar#"," Compare-and-swap: perform a pointer equality test between\n     the first value passed to this function and the value\n     stored inside the 'MutVar#'. If the pointers are equal,\n     replace the stored value with the second value passed to this\n     function, otherwise do nothing.\n     Returns the final value stored inside the 'MutVar#'.\n     The 'Int#' indicates whether a swap took place,\n     with @1#@ meaning that we didn't swap, and @0#@\n     that we did.\n     Implies a full memory barrier.\n     Because the comparison is done on the level of pointers,\n     all of the difficulties of using\n     'reallyUnsafePtrEquality#' correctly apply to\n     'casMutVar#' as well.\n   ")+  , (fsLit "catch#"," @'catch#' k handler s@ evaluates @k s@, invoking @handler@ on any exceptions\n     thrown.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")+  , (fsLit "maskAsyncExceptions#"," @'maskAsyncExceptions#' k s@ evaluates @k s@ such that asynchronous\n     exceptions are deferred until after evaluation has finished.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")+  , (fsLit "maskUninterruptible#"," @'maskUninterruptible#' k s@ evaluates @k s@ such that asynchronous\n     exceptions are deferred until after evaluation has finished.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")+  , (fsLit "unmaskAsyncExceptions#"," @'unmaskAsyncUninterruptible#' k s@ evaluates @k s@ such that asynchronous\n     exceptions are unmasked.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")+  , (fsLit "PromptTag#"," See \"GHC.Prim#continuations\". ")+  , (fsLit "newPromptTag#"," See \"GHC.Prim#continuations\". ")+  , (fsLit "prompt#"," See \"GHC.Prim#continuations\". ")+  , (fsLit "control0#"," See \"GHC.Prim#continuations\". ")+  , (fsLit "newTVar#","Create a new 'TVar#' holding a specified initial value.")+  , (fsLit "readTVar#","Read contents of 'TVar#' inside an STM transaction,\n    i.e. within a call to 'atomically#'.\n    Does not force evaluation of the result.")+  , (fsLit "readTVarIO#","Read contents of 'TVar#' outside an STM transaction.\n   Does not force evaluation of the result.")+  , (fsLit "writeTVar#","Write contents of 'TVar#'.")+  , (fsLit "MVar#"," A shared mutable variable (/not/ the same as a 'MutVar#'!).\n        (Note: in a non-concurrent implementation, @('MVar#' a)@ can be\n        represented by @('MutVar#' (Maybe a))@.) ")+  , (fsLit "newMVar#","Create new 'MVar#'; initially empty.")+  , (fsLit "takeMVar#","If 'MVar#' is empty, block until it becomes full.\n   Then remove and return its contents, and set it empty.")+  , (fsLit "tryTakeMVar#","If 'MVar#' is empty, immediately return with integer 0 and value undefined.\n   Otherwise, return with integer 1 and contents of 'MVar#', and set 'MVar#' empty.")+  , (fsLit "putMVar#","If 'MVar#' is full, block until it becomes empty.\n   Then store value arg as its new contents.")+  , (fsLit "tryPutMVar#","If 'MVar#' is full, immediately return with integer 0.\n    Otherwise, store value arg as 'MVar#''s new contents, and return with integer 1.")+  , (fsLit "readMVar#","If 'MVar#' is empty, block until it becomes full.\n   Then read its contents without modifying the MVar, without possibility\n   of intervention from other threads.")+  , (fsLit "tryReadMVar#","If 'MVar#' is empty, immediately return with integer 0 and value undefined.\n   Otherwise, return with integer 1 and contents of 'MVar#'.")+  , (fsLit "isEmptyMVar#","Return 1 if 'MVar#' is empty; 0 otherwise.")+  , (fsLit "IOPort#"," A shared I/O port is almost the same as an 'MVar#'.\n        The main difference is that IOPort has no deadlock detection or\n        deadlock breaking code that forcibly releases the lock. ")+  , (fsLit "newIOPort#","Create new 'IOPort#'; initially empty.")+  , (fsLit "readIOPort#","If 'IOPort#' is empty, block until it becomes full.\n   Then remove and return its contents, and set it empty.\n   Throws an 'IOPortException' if another thread is already\n   waiting to read this 'IOPort#'.")+  , (fsLit "writeIOPort#","If 'IOPort#' is full, immediately return with integer 0,\n    throwing an 'IOPortException'.\n    Otherwise, store value arg as 'IOPort#''s new contents,\n    and return with integer 1. ")+  , (fsLit "delay#","Sleep specified number of microseconds.")+  , (fsLit "waitRead#","Block until input is available on specified file descriptor.")+  , (fsLit "waitWrite#","Block until output is possible on specified file descriptor.")+  , (fsLit "State#"," 'State#' is the primitive, unlifted type of states.  It has\n        one type parameter, thus @'State#' 'RealWorld'@, or @'State#' s@,\n        where s is a type variable. The only purpose of the type parameter\n        is to keep different state threads separate.  It is represented by\n        nothing at all. ")+  , (fsLit "RealWorld"," 'RealWorld' is deeply magical.  It is /primitive/, but it is not\n        /unlifted/ (hence @ptrArg@).  We never manipulate values of type\n        'RealWorld'; it's only used in the type system, to parameterise 'State#'. ")+  , (fsLit "ThreadId#","(In a non-concurrent implementation, this can be a singleton\n        type, whose (unique) value is returned by 'myThreadId#'.  The\n        other operations can be omitted.)")+  , (fsLit "labelThread#","Set the label of the given thread. The @ByteArray#@ should contain\n    a UTF-8-encoded string.")+  , (fsLit "threadLabel#","Get the label of the given thread.\n    Morally of type @ThreadId# -> IO (Maybe ByteArray#)@, with a @1#@ tag\n    denoting @Just@.\n\n    @since 0.10")+  , (fsLit "threadStatus#","Get the status of the given thread. Result is\n    @(ThreadStatus, Capability, Locked)@ where\n    @ThreadStatus@ is one of the status constants defined in\n    @rts/Constants.h@, @Capability@ is the number of\n    the capability which currently owns the thread, and\n    @Locked@ is a boolean indicating whether the\n    thread is bound to that capability.\n\n    @since 0.9")+  , (fsLit "listThreads#"," Returns an array of the threads started by the program. Note that this\n     threads which have finished execution may or may not be present in this\n     list, depending upon whether they have been collected by the garbage collector.\n\n     @since 0.10")+  , (fsLit "mkWeak#"," @'mkWeak#' k v finalizer s@ creates a weak reference to value @k@,\n     with an associated reference to some value @v@. If @k@ is still\n     alive then @v@ can be retrieved using 'deRefWeak#'. Note that\n     the type of @k@ must be represented by a pointer (i.e. of kind\n     @'TYPE' ''LiftedRep' or @'TYPE' ''UnliftedRep'@). ")+  , (fsLit "addCFinalizerToWeak#"," @'addCFinalizerToWeak#' fptr ptr flag eptr w@ attaches a C\n     function pointer @fptr@ to a weak pointer @w@ as a finalizer. If\n     @flag@ is zero, @fptr@ will be called with one argument,\n     @ptr@. Otherwise, it will be called with two arguments,\n     @eptr@ and @ptr@. 'addCFinalizerToWeak#' returns\n     1 on success, or 0 if @w@ is already dead. ")+  , (fsLit "finalizeWeak#"," Finalize a weak pointer. The return value is an unboxed tuple\n     containing the new state of the world and an \"unboxed Maybe\",\n     represented by an 'Int#' and a (possibly invalid) finalization\n     action. An 'Int#' of @1@ indicates that the finalizer is valid. The\n     return value @b@ from the finalizer should be ignored. ")+  , (fsLit "compactNew#"," Create a new CNF with a single compact block. The argument is\n     the capacity of the compact block (in bytes, not words).\n     The capacity is rounded up to a multiple of the allocator block size\n     and is capped to one mega block. ")+  , (fsLit "compactResize#"," Set the new allocation size of the CNF. This value (in bytes)\n     determines the capacity of each compact block in the CNF. It\n     does not retroactively affect existing compact blocks in the CNF. ")+  , (fsLit "compactContains#"," Returns 1\\# if the object is contained in the CNF, 0\\# otherwise. ")+  , (fsLit "compactContainsAny#"," Returns 1\\# if the object is in any CNF at all, 0\\# otherwise. ")+  , (fsLit "compactGetFirstBlock#"," Returns the address and the utilized size (in bytes) of the\n     first compact block of a CNF.")+  , (fsLit "compactGetNextBlock#"," Given a CNF and the address of one its compact blocks, returns the\n     next compact block and its utilized size, or 'nullAddr#' if the\n     argument was the last compact block in the CNF. ")+  , (fsLit "compactAllocateBlock#"," Attempt to allocate a compact block with the capacity (in\n     bytes) given by the first argument. The 'Addr#' is a pointer\n     to previous compact block of the CNF or 'nullAddr#' to create a\n     new CNF with a single compact block.\n\n     The resulting block is not known to the GC until\n     'compactFixupPointers#' is called on it, and care must be taken\n     so that the address does not escape or memory will be leaked.\n   ")+  , (fsLit "compactFixupPointers#"," Given the pointer to the first block of a CNF and the\n     address of the root object in the old address space, fix up\n     the internal pointers inside the CNF to account for\n     a different position in memory than when it was serialized.\n     This method must be called exactly once after importing\n     a serialized CNF. It returns the new CNF and the new adjusted\n     root address. ")+  , (fsLit "compactAdd#"," Recursively add a closure and its transitive closure to a\n     'Compact#' (a CNF), evaluating any unevaluated components\n     at the same time. Note: 'compactAdd#' is not thread-safe, so\n     only one thread may call 'compactAdd#' with a particular\n     'Compact#' at any given time. The primop does not\n     enforce any mutual exclusion; the caller is expected to\n     arrange this. ")+  , (fsLit "compactAddWithSharing#"," Like 'compactAdd#', but retains sharing and cycles\n   during compaction. ")+  , (fsLit "compactSize#"," Return the total capacity (in bytes) of all the compact blocks\n     in the CNF. ")+  , (fsLit "reallyUnsafePtrEquality#"," Returns @1#@ if the given pointers are equal and @0#@ otherwise. ")+  , (fsLit "par#","Create a new spark evaluating the given argument.\n    The return value should always be 1.\n    Users are encouraged to use spark# instead.")+  , (fsLit "numSparks#"," Returns the number of sparks in the local spark pool. ")+  , (fsLit "keepAlive#"," @'keepAlive#' x s k@ keeps the value @x@ alive during the execution\n     of the computation @k@.\n\n     Note that the result type here isn't quite as unrestricted as the\n     polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n     in continuation-style primops\\\" for details. ")+  , (fsLit "dataToTagSmall#"," Used internally to implement @dataToTag#@: Use that function instead!\n     This one normally offers /no advantage/ and comes with no stability\n     guarantees: it may change its type, its name, or its behavior\n     with /no warning/ between compiler releases.\n\n     It is expected that this function will be un-exposed in a future\n     release of ghc.\n\n     For more details, look at @Note [DataToTag overview]@\n     in GHC.Tc.Instance.Class in the source code for\n     /the specific compiler version you are using./\n   ")+  , (fsLit "dataToTagLarge#"," Used internally to implement @dataToTag#@: Use that function instead!\n     This one offers /no advantage/ and comes with no stability\n     guarantees: it may change its type, its name, or its behavior\n     with /no warning/ between compiler releases.\n\n     It is expected that this function will be un-exposed in a future\n     release of ghc.\n\n     For more details, look at @Note [DataToTag overview]@\n     in GHC.Tc.Instance.Class in the source code for\n     /the specific compiler version you are using./\n   ")+  , (fsLit "BCO"," Primitive bytecode type. ")+  , (fsLit "addrToAny#"," Convert an 'Addr#' to a followable Any type. ")+  , (fsLit "anyToAddr#"," Retrieve the address of any Haskell value. This is\n     essentially an 'unsafeCoerce#', but if implemented as such\n     the core lint pass complains and fails to compile.\n     As a primop, it is opaque to core/stg, and only appears\n     in cmm (where the copy propagation pass will get rid of it).\n     Note that \"a\" must be a value, not a thunk! It's too late\n     for strictness analysis to enforce this, so you're on your\n     own to guarantee this. Also note that 'Addr#' is not a GC\n     pointer - up to you to guarantee that it does not become\n     a dangling pointer immediately after you get it.")+  , (fsLit "mkApUpd0#"," Wrap a BCO in a @AP_UPD@ thunk which will be updated with the value of\n     the BCO when evaluated. ")+  , (fsLit "newBCO#"," @'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The\n     resulting object encodes a function of the given arity with the instructions\n     encoded in @instrs@, and a static reference table usage bitmap given by\n     @bitmap@. ")+  , (fsLit "unpackClosure#"," @'unpackClosure#' closure@ copies the closure and pointers in the\n     payload of the given closure into two new arrays, and returns a pointer to\n     the first word of the closure's info table, a non-pointer array for the raw\n     bytes of the closure, and a pointer array for the pointers in the payload. ")+  , (fsLit "closureSize#"," @'closureSize#' closure@ returns the size of the given closure in\n     machine words. ")+  , (fsLit "getCurrentCCS#"," Returns the current 'CostCentreStack' (value is @NULL@ if\n     not profiling).  Takes a dummy argument which can be used to\n     avoid the call to 'getCurrentCCS#' being floated out by the\n     simplifier, which would result in an uninformative stack\n     (\"CAF\"). ")+  , (fsLit "clearCCS#"," Run the supplied IO action with an empty CCS.  For example, this\n     is used by the interpreter to run an interpreted computation\n     without the call stack showing that it was invoked from GHC. ")+  , (fsLit "whereFrom#"," Fills the given buffer with the @InfoProvEnt@ for the info table of the\n     given object. Returns @1#@ on success and @0#@ otherwise.")+  , (fsLit "FUN","The builtin function type, written in infix form as @a % m -> b@.\n   Values of this type are functions taking inputs of type @a@ and\n   producing outputs of type @b@. The multiplicity of the input is\n   @m@.\n\n   Note that @'FUN' m a b@ permits representation polymorphism in both\n   @a@ and @b@, so that types like @'Int#' -> 'Int#'@ can still be\n   well-kinded.\n  ")+  , (fsLit "realWorld#"," The token used in the implementation of the IO monad as a state monad.\n     It does not pass any information at runtime.\n     See also 'GHC.Magic.runRW#'. ")+  , (fsLit "void#"," This is an alias for the unboxed unit tuple constructor.\n     In earlier versions of GHC, 'void#' was a value\n     of the primitive type 'Void#', which is now defined to be @(# #)@.\n   ")+  , (fsLit "Proxy#"," The type constructor 'Proxy#' is used to bear witness to some\n   type variable. It's used when you want to pass around proxy values\n   for doing things like modelling type applications. A 'Proxy#'\n   is not only unboxed, it also has a polymorphic kind, and has no\n   runtime representation, being totally free. ")+  , (fsLit "proxy#"," Witness for an unboxed 'Proxy#' value, which has no runtime\n   representation. ")+  , (fsLit "seq"," The value of @'seq' a b@ is bottom if @a@ is bottom, and\n     otherwise equal to @b@. In other words, it evaluates the first\n     argument @a@ to weak head normal form (WHNF). 'seq' is usually\n     introduced to improve performance by avoiding unneeded laziness.\n\n     A note on evaluation order: the expression @'seq' a b@ does\n     /not/ guarantee that @a@ will be evaluated before @b@.\n     The only guarantee given by 'seq' is that the both @a@\n     and @b@ will be evaluated before 'seq' returns a value.\n     In particular, this means that @b@ may be evaluated before\n     @a@. If you need to guarantee a specific order of evaluation,\n     you must use the function 'pseq' from the \"parallel\" package. ")+  , (fsLit "traceEvent#"," Emits an event via the RTS tracing framework.  The contents\n     of the event is the zero-terminated byte string passed as the first\n     argument.  The event will be emitted either to the @.eventlog@ file,\n     or to stderr, depending on the runtime RTS flags. ")+  , (fsLit "traceBinaryEvent#"," Emits an event via the RTS tracing framework.  The contents\n     of the event is the binary object passed as the first argument with\n     the given length passed as the second argument. The event will be\n     emitted to the @.eventlog@ file. ")+  , (fsLit "traceMarker#"," Emits a marker event via the RTS tracing framework.  The contents\n     of the event is the zero-terminated byte string passed as the first\n     argument.  The event will be emitted either to the @.eventlog@ file,\n     or to stderr, depending on the runtime RTS flags. ")+  , (fsLit "setThreadAllocationCounter#"," Sets the allocation counter for the current thread to the given value. ")+  , (fsLit "StackSnapshot#"," Haskell representation of a @StgStack*@ that was created (cloned)\n     with a function in \"GHC.Stack.CloneStack\". Please check the\n     documentation in that module for more detailed explanations. ")+  , (fsLit "coerce"," The function 'coerce' allows you to safely convert between values of\n     types that have the same representation with no run-time overhead. In the\n     simplest case you can use it instead of a newtype constructor, to go from\n     the newtype's concrete type to the abstract type. But it also works in\n     more complicated settings, e.g. converting a list of newtypes to a list of\n     concrete types.\n\n     When used in conversions involving a newtype wrapper,\n     make sure the newtype constructor is in scope.\n\n     This function is representation-polymorphic, but the\n     'RuntimeRep' type argument is marked as 'Inferred', meaning\n     that it is not available for visible type application. This means\n     the typechecker will accept @'coerce' \\@'Int' \\@Age 42@.\n\n     === __Examples__\n\n     >>> newtype TTL = TTL Int deriving (Eq, Ord, Show)\n     >>> newtype Age = Age Int deriving (Eq, Ord, Show)\n     >>> coerce (Age 42) :: TTL\n     TTL 42\n     >>> coerce (+ (1 :: Int)) (Age 42) :: TTL\n     TTL 43\n     >>> coerce (map (+ (1 :: Int))) [Age 42, Age 24] :: [TTL]\n     [TTL 43,TTL 25]\n\n   ")+  , (fsLit "broadcastInt8X16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt16X8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt32X4#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt64X2#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt8X32#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt16X16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt32X8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt64X4#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt8X64#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt16X32#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt32X16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastInt64X8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord8X16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord16X8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord32X4#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord64X2#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord8X32#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord16X16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord32X8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord64X4#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord8X64#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord16X32#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord32X16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastWord64X8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastFloatX4#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastDoubleX2#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastFloatX8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastDoubleX4#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastFloatX16#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "broadcastDoubleX8#"," Broadcast a scalar to all elements of a vector. ")+  , (fsLit "packInt8X16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt16X8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt32X4#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt64X2#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt8X32#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt16X16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt32X8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt64X4#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt8X64#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt16X32#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt32X16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packInt64X8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord8X16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord16X8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord32X4#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord64X2#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord8X32#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord16X16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord32X8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord64X4#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord8X64#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord16X32#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord32X16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packWord64X8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packFloatX4#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packDoubleX2#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packFloatX8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packDoubleX4#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packFloatX16#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "packDoubleX8#"," Pack the elements of an unboxed tuple into a vector. ")+  , (fsLit "unpackInt8X16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt16X8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt32X4#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt64X2#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt8X32#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt16X16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt32X8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt64X4#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt8X64#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt16X32#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt32X16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackInt64X8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord8X16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord16X8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord32X4#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord64X2#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord8X32#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord16X16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord32X8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord64X4#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord8X64#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord16X32#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord32X16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackWord64X8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackFloatX4#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackDoubleX2#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackFloatX8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackDoubleX4#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackFloatX16#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "unpackDoubleX8#"," Unpack the elements of a vector into an unboxed tuple. #")+  , (fsLit "insertInt8X16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt16X8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt32X4#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt64X2#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt8X32#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt16X16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt32X8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt64X4#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt8X64#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt16X32#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt32X16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertInt64X8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord8X16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord16X8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord32X4#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord64X2#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord8X32#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord16X16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord32X8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord64X4#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord8X64#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord16X32#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord32X16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertWord64X8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertFloatX4#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertDoubleX2#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertFloatX8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertDoubleX4#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertFloatX16#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "insertDoubleX8#"," Insert a scalar at the given position in a vector. ")+  , (fsLit "plusInt8X16#"," Add two vectors element-wise. ")+  , (fsLit "plusInt16X8#"," Add two vectors element-wise. ")+  , (fsLit "plusInt32X4#"," Add two vectors element-wise. ")+  , (fsLit "plusInt64X2#"," Add two vectors element-wise. ")+  , (fsLit "plusInt8X32#"," Add two vectors element-wise. ")+  , (fsLit "plusInt16X16#"," Add two vectors element-wise. ")+  , (fsLit "plusInt32X8#"," Add two vectors element-wise. ")+  , (fsLit "plusInt64X4#"," Add two vectors element-wise. ")+  , (fsLit "plusInt8X64#"," Add two vectors element-wise. ")+  , (fsLit "plusInt16X32#"," Add two vectors element-wise. ")+  , (fsLit "plusInt32X16#"," Add two vectors element-wise. ")+  , (fsLit "plusInt64X8#"," Add two vectors element-wise. ")+  , (fsLit "plusWord8X16#"," Add two vectors element-wise. ")+  , (fsLit "plusWord16X8#"," Add two vectors element-wise. ")+  , (fsLit "plusWord32X4#"," Add two vectors element-wise. ")+  , (fsLit "plusWord64X2#"," Add two vectors element-wise. ")+  , (fsLit "plusWord8X32#"," Add two vectors element-wise. ")+  , (fsLit "plusWord16X16#"," Add two vectors element-wise. ")+  , (fsLit "plusWord32X8#"," Add two vectors element-wise. ")+  , (fsLit "plusWord64X4#"," Add two vectors element-wise. ")+  , (fsLit "plusWord8X64#"," Add two vectors element-wise. ")+  , (fsLit "plusWord16X32#"," Add two vectors element-wise. ")+  , (fsLit "plusWord32X16#"," Add two vectors element-wise. ")+  , (fsLit "plusWord64X8#"," Add two vectors element-wise. ")+  , (fsLit "plusFloatX4#"," Add two vectors element-wise. ")+  , (fsLit "plusDoubleX2#"," Add two vectors element-wise. ")+  , (fsLit "plusFloatX8#"," Add two vectors element-wise. ")+  , (fsLit "plusDoubleX4#"," Add two vectors element-wise. ")+  , (fsLit "plusFloatX16#"," Add two vectors element-wise. ")+  , (fsLit "plusDoubleX8#"," Add two vectors element-wise. ")+  , (fsLit "minusInt8X16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt16X8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt32X4#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt64X2#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt8X32#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt16X16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt32X8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt64X4#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt8X64#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt16X32#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt32X16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusInt64X8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord8X16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord16X8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord32X4#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord64X2#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord8X32#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord16X16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord32X8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord64X4#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord8X64#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord16X32#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord32X16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusWord64X8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusFloatX4#"," Subtract two vectors element-wise. ")+  , (fsLit "minusDoubleX2#"," Subtract two vectors element-wise. ")+  , (fsLit "minusFloatX8#"," Subtract two vectors element-wise. ")+  , (fsLit "minusDoubleX4#"," Subtract two vectors element-wise. ")+  , (fsLit "minusFloatX16#"," Subtract two vectors element-wise. ")+  , (fsLit "minusDoubleX8#"," Subtract two vectors element-wise. ")+  , (fsLit "timesInt8X16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt16X8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt32X4#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt64X2#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt8X32#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt16X16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt32X8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt64X4#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt8X64#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt16X32#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt32X16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesInt64X8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord8X16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord16X8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord32X4#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord64X2#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord8X32#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord16X16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord32X8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord64X4#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord8X64#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord16X32#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord32X16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesWord64X8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesFloatX4#"," Multiply two vectors element-wise. ")+  , (fsLit "timesDoubleX2#"," Multiply two vectors element-wise. ")+  , (fsLit "timesFloatX8#"," Multiply two vectors element-wise. ")+  , (fsLit "timesDoubleX4#"," Multiply two vectors element-wise. ")+  , (fsLit "timesFloatX16#"," Multiply two vectors element-wise. ")+  , (fsLit "timesDoubleX8#"," Multiply two vectors element-wise. ")+  , (fsLit "divideFloatX4#"," Divide two vectors element-wise. ")+  , (fsLit "divideDoubleX2#"," Divide two vectors element-wise. ")+  , (fsLit "divideFloatX8#"," Divide two vectors element-wise. ")+  , (fsLit "divideDoubleX4#"," Divide two vectors element-wise. ")+  , (fsLit "divideFloatX16#"," Divide two vectors element-wise. ")+  , (fsLit "divideDoubleX8#"," Divide two vectors element-wise. ")+  , (fsLit "quotInt8X16#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt16X8#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt32X4#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt64X2#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt8X32#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt16X16#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt32X8#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt64X4#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt8X64#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt16X32#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt32X16#"," Rounds towards zero element-wise. ")+  , (fsLit "quotInt64X8#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord8X16#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord16X8#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord32X4#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord64X2#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord8X32#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord16X16#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord32X8#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord64X4#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord8X64#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord16X32#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord32X16#"," Rounds towards zero element-wise. ")+  , (fsLit "quotWord64X8#"," Rounds towards zero element-wise. ")+  , (fsLit "remInt8X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt16X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt32X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt64X2#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt8X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt16X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt32X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt64X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt8X64#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt16X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt32X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remInt64X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord8X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord16X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord32X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord64X2#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord8X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord16X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord32X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord64X4#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord8X64#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord16X32#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord32X16#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "remWord64X8#"," Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. ")+  , (fsLit "negateInt8X16#"," Negate element-wise. ")+  , (fsLit "negateInt16X8#"," Negate element-wise. ")+  , (fsLit "negateInt32X4#"," Negate element-wise. ")+  , (fsLit "negateInt64X2#"," Negate element-wise. ")+  , (fsLit "negateInt8X32#"," Negate element-wise. ")+  , (fsLit "negateInt16X16#"," Negate element-wise. ")+  , (fsLit "negateInt32X8#"," Negate element-wise. ")+  , (fsLit "negateInt64X4#"," Negate element-wise. ")+  , (fsLit "negateInt8X64#"," Negate element-wise. ")+  , (fsLit "negateInt16X32#"," Negate element-wise. ")+  , (fsLit "negateInt32X16#"," Negate element-wise. ")+  , (fsLit "negateInt64X8#"," Negate element-wise. ")+  , (fsLit "negateFloatX4#"," Negate element-wise. ")+  , (fsLit "negateDoubleX2#"," Negate element-wise. ")+  , (fsLit "negateFloatX8#"," Negate element-wise. ")+  , (fsLit "negateDoubleX4#"," Negate element-wise. ")+  , (fsLit "negateFloatX16#"," Negate element-wise. ")+  , (fsLit "negateDoubleX8#"," Negate element-wise. ")+  , (fsLit "indexInt8X16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt16X8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt32X4Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt64X2Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt8X32Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt16X16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt32X8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt64X4Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt8X64Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt16X32Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt32X16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexInt64X8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord8X16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord16X8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord32X4Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord64X2Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord8X32Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord16X16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord32X8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord64X4Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord8X64Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord16X32Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord32X16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexWord64X8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexFloatX4Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexDoubleX2Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexFloatX8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexDoubleX4Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexFloatX16Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "indexDoubleX8Array#"," Read a vector from specified index of immutable array. ")+  , (fsLit "readInt8X16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt16X8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt32X4Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt64X2Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt8X32Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt16X16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt32X8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt64X4Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt8X64Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt16X32Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt32X16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readInt64X8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord8X16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord16X8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord32X4Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord64X2Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord8X32Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord16X16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord32X8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord64X4Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord8X64Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord16X32Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord32X16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readWord64X8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readFloatX4Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readDoubleX2Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readFloatX8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readDoubleX4Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readFloatX16Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "readDoubleX8Array#"," Read a vector from specified index of mutable array. ")+  , (fsLit "writeInt8X16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt16X8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt32X4Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt64X2Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt8X32Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt16X16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt32X8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt64X4Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt8X64Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt16X32Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt32X16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeInt64X8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord8X16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord16X8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord32X4Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord64X2Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord8X32Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord16X16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord32X8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord64X4Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord8X64Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord16X32Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord32X16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeWord64X8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeFloatX4Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeDoubleX2Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeFloatX8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeDoubleX4Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeFloatX16Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "writeDoubleX8Array#"," Write a vector to specified index of mutable array. ")+  , (fsLit "indexInt8X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt16X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt32X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt64X2OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt8X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt16X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt32X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt64X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt8X64OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt16X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt32X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexInt64X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord8X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord16X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord32X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord64X2OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord8X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord16X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord32X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord64X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord8X64OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord16X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord32X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexWord64X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexFloatX4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexDoubleX2OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexFloatX8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexDoubleX4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexFloatX16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "indexDoubleX8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt8X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt16X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt32X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt64X2OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt8X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt16X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt32X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt64X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt8X64OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt16X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt32X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readInt64X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord8X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord16X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord32X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord64X2OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord8X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord16X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord32X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord64X4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord8X64OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord16X32OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord32X16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readWord64X8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readFloatX4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readDoubleX2OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readFloatX8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readDoubleX4OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readFloatX16OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "readDoubleX8OffAddr#"," Reads vector; offset in bytes. ")+  , (fsLit "writeInt8X16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt16X8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt32X4OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt64X2OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt8X32OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt16X16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt32X8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt64X4OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt8X64OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt16X32OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt32X16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeInt64X8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord8X16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord16X8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord32X4OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord64X2OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord8X32OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord16X16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord32X8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord64X4OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord8X64OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord16X32OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord32X16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeWord64X8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeFloatX4OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeDoubleX2OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeFloatX8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeDoubleX4OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeFloatX16OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "writeDoubleX8OffAddr#"," Write vector; offset in bytes. ")+  , (fsLit "indexInt8ArrayAsInt8X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt16ArrayAsInt16X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt32ArrayAsInt32X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt64ArrayAsInt64X2#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt8ArrayAsInt8X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt16ArrayAsInt16X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt32ArrayAsInt32X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt64ArrayAsInt64X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt8ArrayAsInt8X64#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt16ArrayAsInt16X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt32ArrayAsInt32X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt64ArrayAsInt64X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord8ArrayAsWord8X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord16ArrayAsWord16X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord32ArrayAsWord32X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord64ArrayAsWord64X2#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord8ArrayAsWord8X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord16ArrayAsWord16X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord32ArrayAsWord32X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord64ArrayAsWord64X4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord8ArrayAsWord8X64#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord16ArrayAsWord16X32#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord32ArrayAsWord32X16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexWord64ArrayAsWord64X8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexFloatArrayAsFloatX4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexDoubleArrayAsDoubleX2#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexFloatArrayAsFloatX8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexDoubleArrayAsDoubleX4#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexFloatArrayAsFloatX16#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexDoubleArrayAsDoubleX8#"," Read a vector from specified index of immutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt8ArrayAsInt8X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt16ArrayAsInt16X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt32ArrayAsInt32X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt64ArrayAsInt64X2#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt8ArrayAsInt8X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt16ArrayAsInt16X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt32ArrayAsInt32X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt64ArrayAsInt64X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt8ArrayAsInt8X64#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt16ArrayAsInt16X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt32ArrayAsInt32X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readInt64ArrayAsInt64X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord8ArrayAsWord8X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord16ArrayAsWord16X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord32ArrayAsWord32X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord64ArrayAsWord64X2#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord8ArrayAsWord8X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord16ArrayAsWord16X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord32ArrayAsWord32X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord64ArrayAsWord64X4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord8ArrayAsWord8X64#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord16ArrayAsWord16X32#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord32ArrayAsWord32X16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readWord64ArrayAsWord64X8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readFloatArrayAsFloatX4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readDoubleArrayAsDoubleX2#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readFloatArrayAsFloatX8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readDoubleArrayAsDoubleX4#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readFloatArrayAsFloatX16#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "readDoubleArrayAsDoubleX8#"," Read a vector from specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt8ArrayAsInt8X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt16ArrayAsInt16X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt32ArrayAsInt32X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt64ArrayAsInt64X2#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt8ArrayAsInt8X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt16ArrayAsInt16X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt32ArrayAsInt32X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt64ArrayAsInt64X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt8ArrayAsInt8X64#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt16ArrayAsInt16X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt32ArrayAsInt32X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeInt64ArrayAsInt64X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord8ArrayAsWord8X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord16ArrayAsWord16X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord32ArrayAsWord32X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord64ArrayAsWord64X2#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord8ArrayAsWord8X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord16ArrayAsWord16X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord32ArrayAsWord32X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord64ArrayAsWord64X4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord8ArrayAsWord8X64#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord16ArrayAsWord16X32#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord32ArrayAsWord32X16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeWord64ArrayAsWord64X8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeFloatArrayAsFloatX4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeDoubleArrayAsDoubleX2#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeFloatArrayAsFloatX8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeDoubleArrayAsDoubleX4#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeFloatArrayAsFloatX16#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "writeDoubleArrayAsDoubleX8#"," Write a vector to specified index of mutable array of scalars; offset is in scalar elements. ")+  , (fsLit "indexInt8OffAddrAsInt8X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt16OffAddrAsInt16X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt32OffAddrAsInt32X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt64OffAddrAsInt64X2#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt8OffAddrAsInt8X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt16OffAddrAsInt16X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt32OffAddrAsInt32X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt64OffAddrAsInt64X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt8OffAddrAsInt8X64#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt16OffAddrAsInt16X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt32OffAddrAsInt32X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexInt64OffAddrAsInt64X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord8OffAddrAsWord8X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord16OffAddrAsWord16X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord32OffAddrAsWord32X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord64OffAddrAsWord64X2#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord8OffAddrAsWord8X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord16OffAddrAsWord16X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord32OffAddrAsWord32X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord64OffAddrAsWord64X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord8OffAddrAsWord8X64#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord16OffAddrAsWord16X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord32OffAddrAsWord32X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexWord64OffAddrAsWord64X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexFloatOffAddrAsFloatX4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexDoubleOffAddrAsDoubleX2#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexFloatOffAddrAsFloatX8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexDoubleOffAddrAsDoubleX4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexFloatOffAddrAsFloatX16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "indexDoubleOffAddrAsDoubleX8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt8OffAddrAsInt8X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt16OffAddrAsInt16X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt32OffAddrAsInt32X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt64OffAddrAsInt64X2#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt8OffAddrAsInt8X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt16OffAddrAsInt16X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt32OffAddrAsInt32X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt64OffAddrAsInt64X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt8OffAddrAsInt8X64#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt16OffAddrAsInt16X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt32OffAddrAsInt32X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readInt64OffAddrAsInt64X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord8OffAddrAsWord8X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord16OffAddrAsWord16X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord32OffAddrAsWord32X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord64OffAddrAsWord64X2#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord8OffAddrAsWord8X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord16OffAddrAsWord16X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord32OffAddrAsWord32X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord64OffAddrAsWord64X4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord8OffAddrAsWord8X64#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord16OffAddrAsWord16X32#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord32OffAddrAsWord32X16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readWord64OffAddrAsWord64X8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readFloatOffAddrAsFloatX4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readDoubleOffAddrAsDoubleX2#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readFloatOffAddrAsFloatX8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readDoubleOffAddrAsDoubleX4#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readFloatOffAddrAsFloatX16#"," Reads vector; offset in scalar elements. ")+  , (fsLit "readDoubleOffAddrAsDoubleX8#"," Reads vector; offset in scalar elements. ")+  , (fsLit "writeInt8OffAddrAsInt8X16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt16OffAddrAsInt16X8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt32OffAddrAsInt32X4#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt64OffAddrAsInt64X2#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt8OffAddrAsInt8X32#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt16OffAddrAsInt16X16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt32OffAddrAsInt32X8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt64OffAddrAsInt64X4#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt8OffAddrAsInt8X64#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt16OffAddrAsInt16X32#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt32OffAddrAsInt32X16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeInt64OffAddrAsInt64X8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord8OffAddrAsWord8X16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord16OffAddrAsWord16X8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord32OffAddrAsWord32X4#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord64OffAddrAsWord64X2#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord8OffAddrAsWord8X32#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord16OffAddrAsWord16X16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord32OffAddrAsWord32X8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord64OffAddrAsWord64X4#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord8OffAddrAsWord8X64#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord16OffAddrAsWord16X32#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord32OffAddrAsWord32X16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeWord64OffAddrAsWord64X8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeFloatOffAddrAsFloatX4#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeDoubleOffAddrAsDoubleX2#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeFloatOffAddrAsFloatX8#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeDoubleOffAddrAsDoubleX4#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeFloatOffAddrAsFloatX16#"," Write vector; offset in scalar elements. ")+  , (fsLit "writeDoubleOffAddrAsDoubleX8#"," Write vector; offset in scalar elements. ")+  , (fsLit "fmaddFloatX4#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmaddDoubleX2#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmaddFloatX8#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmaddDoubleX4#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmaddFloatX16#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmaddDoubleX8#","Fused multiply-add operation @x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubFloatX4#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubDoubleX2#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubFloatX8#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubDoubleX4#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubFloatX16#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fmsubDoubleX8#","Fused multiply-subtract operation @x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddFloatX4#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddDoubleX2#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddFloatX8#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddDoubleX4#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddFloatX16#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmaddDoubleX8#","Fused negate-multiply-add operation @-x*y+z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubFloatX4#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubDoubleX2#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubFloatX8#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubDoubleX4#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubFloatX16#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "fnmsubDoubleX8#","Fused negate-multiply-subtract operation @-x*y-z@. See \"GHC.Prim#fma\".")+  , (fsLit "shuffleInt8X16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt16X8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt32X4#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt64X2#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt8X32#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt16X16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt32X8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt64X4#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt8X64#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt16X32#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt32X16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleInt64X8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord8X16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord16X8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord32X4#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord64X2#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord8X32#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord16X16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord32X8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord64X4#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord8X64#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord16X32#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord32X16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleWord64X8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleFloatX4#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleDoubleX2#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleFloatX8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleDoubleX4#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleFloatX16#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "shuffleDoubleX8#","Shuffle elements of the concatenation of the input two vectors\n  into the result vector.")+  , (fsLit "minInt8X16#","Component-wise minimum of two vectors.")+  , (fsLit "minInt16X8#","Component-wise minimum of two vectors.")+  , (fsLit "minInt32X4#","Component-wise minimum of two vectors.")+  , (fsLit "minInt64X2#","Component-wise minimum of two vectors.")+  , (fsLit "minInt8X32#","Component-wise minimum of two vectors.")+  , (fsLit "minInt16X16#","Component-wise minimum of two vectors.")+  , (fsLit "minInt32X8#","Component-wise minimum of two vectors.")+  , (fsLit "minInt64X4#","Component-wise minimum of two vectors.")+  , (fsLit "minInt8X64#","Component-wise minimum of two vectors.")+  , (fsLit "minInt16X32#","Component-wise minimum of two vectors.")+  , (fsLit "minInt32X16#","Component-wise minimum of two vectors.")+  , (fsLit "minInt64X8#","Component-wise minimum of two vectors.")+  , (fsLit "minWord8X16#","Component-wise minimum of two vectors.")+  , (fsLit "minWord16X8#","Component-wise minimum of two vectors.")+  , (fsLit "minWord32X4#","Component-wise minimum of two vectors.")+  , (fsLit "minWord64X2#","Component-wise minimum of two vectors.")+  , (fsLit "minWord8X32#","Component-wise minimum of two vectors.")+  , (fsLit "minWord16X16#","Component-wise minimum of two vectors.")+  , (fsLit "minWord32X8#","Component-wise minimum of two vectors.")+  , (fsLit "minWord64X4#","Component-wise minimum of two vectors.")+  , (fsLit "minWord8X64#","Component-wise minimum of two vectors.")+  , (fsLit "minWord16X32#","Component-wise minimum of two vectors.")+  , (fsLit "minWord32X16#","Component-wise minimum of two vectors.")+  , (fsLit "minWord64X8#","Component-wise minimum of two vectors.")+  , (fsLit "minFloatX4#","Component-wise minimum of two vectors.")+  , (fsLit "minDoubleX2#","Component-wise minimum of two vectors.")+  , (fsLit "minFloatX8#","Component-wise minimum of two vectors.")+  , (fsLit "minDoubleX4#","Component-wise minimum of two vectors.")+  , (fsLit "minFloatX16#","Component-wise minimum of two vectors.")+  , (fsLit "minDoubleX8#","Component-wise minimum of two vectors.")+  , (fsLit "maxInt8X16#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt16X8#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt32X4#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt64X2#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt8X32#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt16X16#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt32X8#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt64X4#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt8X64#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt16X32#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt32X16#","Component-wise maximum of two vectors.")+  , (fsLit "maxInt64X8#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord8X16#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord16X8#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord32X4#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord64X2#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord8X32#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord16X16#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord32X8#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord64X4#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord8X64#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord16X32#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord32X16#","Component-wise maximum of two vectors.")+  , (fsLit "maxWord64X8#","Component-wise maximum of two vectors.")+  , (fsLit "maxFloatX4#","Component-wise maximum of two vectors.")+  , (fsLit "maxDoubleX2#","Component-wise maximum of two vectors.")+  , (fsLit "maxFloatX8#","Component-wise maximum of two vectors.")+  , (fsLit "maxDoubleX4#","Component-wise maximum of two vectors.")+  , (fsLit "maxFloatX16#","Component-wise maximum of two vectors.")+  , (fsLit "maxDoubleX8#","Component-wise maximum of two vectors.")   ]
ghc-lib/stage0/compiler/build/primop-effects.hs-incl view
@@ -363,7 +363,6 @@ primOpEffect ReallyUnsafePtrEqualityOp = CanFail primOpEffect ParOp = ReadWriteEffect primOpEffect SparkOp = ReadWriteEffect-primOpEffect SeqOp = ThrowsException primOpEffect GetSparkOp = ReadWriteEffect primOpEffect NumSparks = ReadWriteEffect primOpEffect KeepAliveOp = ReadWriteEffect
ghc-lib/stage0/compiler/build/primop-fixity.hs-incl view
@@ -1,20 +1,20 @@-primOpFixity IntAddOp = Just (Fixity NoSourceText 6 InfixL)-primOpFixity IntSubOp = Just (Fixity NoSourceText 6 InfixL)-primOpFixity IntMulOp = Just (Fixity NoSourceText 7 InfixL)-primOpFixity IntGtOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity IntGeOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity IntEqOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity IntNeOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity IntLtOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity IntLeOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleGtOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleGeOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleEqOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleNeOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleLtOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleLeOp = Just (Fixity NoSourceText 4 InfixN)-primOpFixity DoubleAddOp = Just (Fixity NoSourceText 6 InfixL)-primOpFixity DoubleSubOp = Just (Fixity NoSourceText 6 InfixL)-primOpFixity DoubleMulOp = Just (Fixity NoSourceText 7 InfixL)-primOpFixity DoubleDivOp = Just (Fixity NoSourceText 7 InfixL)+primOpFixity IntAddOp = Just (Fixity 6 InfixL)+primOpFixity IntSubOp = Just (Fixity 6 InfixL)+primOpFixity IntMulOp = Just (Fixity 7 InfixL)+primOpFixity IntGtOp = Just (Fixity 4 InfixN)+primOpFixity IntGeOp = Just (Fixity 4 InfixN)+primOpFixity IntEqOp = Just (Fixity 4 InfixN)+primOpFixity IntNeOp = Just (Fixity 4 InfixN)+primOpFixity IntLtOp = Just (Fixity 4 InfixN)+primOpFixity IntLeOp = Just (Fixity 4 InfixN)+primOpFixity DoubleGtOp = Just (Fixity 4 InfixN)+primOpFixity DoubleGeOp = Just (Fixity 4 InfixN)+primOpFixity DoubleEqOp = Just (Fixity 4 InfixN)+primOpFixity DoubleNeOp = Just (Fixity 4 InfixN)+primOpFixity DoubleLtOp = Just (Fixity 4 InfixN)+primOpFixity DoubleLeOp = Just (Fixity 4 InfixN)+primOpFixity DoubleAddOp = Just (Fixity 6 InfixL)+primOpFixity DoubleSubOp = Just (Fixity 6 InfixL)+primOpFixity DoubleMulOp = Just (Fixity 7 InfixL)+primOpFixity DoubleDivOp = Just (Fixity 7 InfixL) primOpFixity _thisOp = Nothing
ghc-lib/stage0/compiler/build/primop-is-work-free.hs-incl view
@@ -4,5 +4,4 @@ primOpIsWorkFree RaiseDivZeroOp = True primOpIsWorkFree RaiseIOOp = True primOpIsWorkFree TouchOp = False-primOpIsWorkFree SeqOp = True primOpIsWorkFree _thisOp =  primOpCodeSize _thisOp == 0
ghc-lib/stage0/compiler/build/primop-list.hs-incl view
@@ -263,6 +263,8 @@    , DoubleNeOp    , DoubleLtOp    , DoubleLeOp+   , DoubleMinOp+   , DoubleMaxOp    , DoubleAddOp    , DoubleSubOp    , DoubleMulOp@@ -299,6 +301,8 @@    , FloatNeOp    , FloatLtOp    , FloatLeOp+   , FloatMinOp+   , FloatMaxOp    , FloatAddOp    , FloatSubOp    , FloatMulOp@@ -373,6 +377,8 @@    , NewAlignedPinnedByteArrayOp_Char    , MutableByteArrayIsPinnedOp    , ByteArrayIsPinnedOp+   , ByteArrayIsWeaklyPinnedOp+   , MutableByteArrayIsWeaklyPinnedOp    , ByteArrayContents_Char    , MutableByteArrayContents_Char    , ShrinkMutableByteArrayOp_Char@@ -691,7 +697,6 @@    , ReallyUnsafePtrEqualityOp    , ParOp    , SparkOp-   , SeqOp    , GetSparkOp    , NumSparks    , KeepAliveOp@@ -1355,6 +1360,120 @@    , (VecWriteScalarOffAddrOp FloatVec 4 W64)    , (VecWriteScalarOffAddrOp FloatVec 16 W32)    , (VecWriteScalarOffAddrOp FloatVec 8 W64)+   , (VecFMAdd FloatVec 4 W32)+   , (VecFMAdd FloatVec 2 W64)+   , (VecFMAdd FloatVec 8 W32)+   , (VecFMAdd FloatVec 4 W64)+   , (VecFMAdd FloatVec 16 W32)+   , (VecFMAdd FloatVec 8 W64)+   , (VecFMSub FloatVec 4 W32)+   , (VecFMSub FloatVec 2 W64)+   , (VecFMSub FloatVec 8 W32)+   , (VecFMSub FloatVec 4 W64)+   , (VecFMSub FloatVec 16 W32)+   , (VecFMSub FloatVec 8 W64)+   , (VecFNMAdd FloatVec 4 W32)+   , (VecFNMAdd FloatVec 2 W64)+   , (VecFNMAdd FloatVec 8 W32)+   , (VecFNMAdd FloatVec 4 W64)+   , (VecFNMAdd FloatVec 16 W32)+   , (VecFNMAdd FloatVec 8 W64)+   , (VecFNMSub FloatVec 4 W32)+   , (VecFNMSub FloatVec 2 W64)+   , (VecFNMSub FloatVec 8 W32)+   , (VecFNMSub FloatVec 4 W64)+   , (VecFNMSub FloatVec 16 W32)+   , (VecFNMSub FloatVec 8 W64)+   , (VecShuffleOp IntVec 16 W8)+   , (VecShuffleOp IntVec 8 W16)+   , (VecShuffleOp IntVec 4 W32)+   , (VecShuffleOp IntVec 2 W64)+   , (VecShuffleOp IntVec 32 W8)+   , (VecShuffleOp IntVec 16 W16)+   , (VecShuffleOp IntVec 8 W32)+   , (VecShuffleOp IntVec 4 W64)+   , (VecShuffleOp IntVec 64 W8)+   , (VecShuffleOp IntVec 32 W16)+   , (VecShuffleOp IntVec 16 W32)+   , (VecShuffleOp IntVec 8 W64)+   , (VecShuffleOp WordVec 16 W8)+   , (VecShuffleOp WordVec 8 W16)+   , (VecShuffleOp WordVec 4 W32)+   , (VecShuffleOp WordVec 2 W64)+   , (VecShuffleOp WordVec 32 W8)+   , (VecShuffleOp WordVec 16 W16)+   , (VecShuffleOp WordVec 8 W32)+   , (VecShuffleOp WordVec 4 W64)+   , (VecShuffleOp WordVec 64 W8)+   , (VecShuffleOp WordVec 32 W16)+   , (VecShuffleOp WordVec 16 W32)+   , (VecShuffleOp WordVec 8 W64)+   , (VecShuffleOp FloatVec 4 W32)+   , (VecShuffleOp FloatVec 2 W64)+   , (VecShuffleOp FloatVec 8 W32)+   , (VecShuffleOp FloatVec 4 W64)+   , (VecShuffleOp FloatVec 16 W32)+   , (VecShuffleOp FloatVec 8 W64)+   , (VecMinOp IntVec 16 W8)+   , (VecMinOp IntVec 8 W16)+   , (VecMinOp IntVec 4 W32)+   , (VecMinOp IntVec 2 W64)+   , (VecMinOp IntVec 32 W8)+   , (VecMinOp IntVec 16 W16)+   , (VecMinOp IntVec 8 W32)+   , (VecMinOp IntVec 4 W64)+   , (VecMinOp IntVec 64 W8)+   , (VecMinOp IntVec 32 W16)+   , (VecMinOp IntVec 16 W32)+   , (VecMinOp IntVec 8 W64)+   , (VecMinOp WordVec 16 W8)+   , (VecMinOp WordVec 8 W16)+   , (VecMinOp WordVec 4 W32)+   , (VecMinOp WordVec 2 W64)+   , (VecMinOp WordVec 32 W8)+   , (VecMinOp WordVec 16 W16)+   , (VecMinOp WordVec 8 W32)+   , (VecMinOp WordVec 4 W64)+   , (VecMinOp WordVec 64 W8)+   , (VecMinOp WordVec 32 W16)+   , (VecMinOp WordVec 16 W32)+   , (VecMinOp WordVec 8 W64)+   , (VecMinOp FloatVec 4 W32)+   , (VecMinOp FloatVec 2 W64)+   , (VecMinOp FloatVec 8 W32)+   , (VecMinOp FloatVec 4 W64)+   , (VecMinOp FloatVec 16 W32)+   , (VecMinOp FloatVec 8 W64)+   , (VecMaxOp IntVec 16 W8)+   , (VecMaxOp IntVec 8 W16)+   , (VecMaxOp IntVec 4 W32)+   , (VecMaxOp IntVec 2 W64)+   , (VecMaxOp IntVec 32 W8)+   , (VecMaxOp IntVec 16 W16)+   , (VecMaxOp IntVec 8 W32)+   , (VecMaxOp IntVec 4 W64)+   , (VecMaxOp IntVec 64 W8)+   , (VecMaxOp IntVec 32 W16)+   , (VecMaxOp IntVec 16 W32)+   , (VecMaxOp IntVec 8 W64)+   , (VecMaxOp WordVec 16 W8)+   , (VecMaxOp WordVec 8 W16)+   , (VecMaxOp WordVec 4 W32)+   , (VecMaxOp WordVec 2 W64)+   , (VecMaxOp WordVec 32 W8)+   , (VecMaxOp WordVec 16 W16)+   , (VecMaxOp WordVec 8 W32)+   , (VecMaxOp WordVec 4 W64)+   , (VecMaxOp WordVec 64 W8)+   , (VecMaxOp WordVec 32 W16)+   , (VecMaxOp WordVec 16 W32)+   , (VecMaxOp WordVec 8 W64)+   , (VecMaxOp FloatVec 4 W32)+   , (VecMaxOp FloatVec 2 W64)+   , (VecMaxOp FloatVec 8 W32)+   , (VecMaxOp FloatVec 4 W64)+   , (VecMaxOp FloatVec 16 W32)+   , (VecMaxOp FloatVec 8 W64)    , PrefetchByteArrayOp3    , PrefetchMutableByteArrayOp3    , PrefetchAddrOp3
ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl view
@@ -25,6 +25,8 @@ primOpOutOfLine NewAlignedPinnedByteArrayOp_Char = True primOpOutOfLine MutableByteArrayIsPinnedOp = True primOpOutOfLine ByteArrayIsPinnedOp = True+primOpOutOfLine ByteArrayIsWeaklyPinnedOp = True+primOpOutOfLine MutableByteArrayIsWeaklyPinnedOp = True primOpOutOfLine ShrinkMutableByteArrayOp_Char = True primOpOutOfLine ResizeMutableByteArrayOp_Char = True primOpOutOfLine NewMutVarOp = True
ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl view
@@ -263,6 +263,8 @@ primOpInfo DoubleNeOp = mkCompare (fsLit "/=##") doublePrimTy primOpInfo DoubleLtOp = mkCompare (fsLit "<##") doublePrimTy primOpInfo DoubleLeOp = mkCompare (fsLit "<=##") doublePrimTy+primOpInfo DoubleMinOp = mkGenPrimOp (fsLit "minDouble#")  [] [doublePrimTy, doublePrimTy] (doublePrimTy)+primOpInfo DoubleMaxOp = mkGenPrimOp (fsLit "maxDouble#")  [] [doublePrimTy, doublePrimTy] (doublePrimTy) primOpInfo DoubleAddOp = mkGenPrimOp (fsLit "+##")  [] [doublePrimTy, doublePrimTy] (doublePrimTy) primOpInfo DoubleSubOp = mkGenPrimOp (fsLit "-##")  [] [doublePrimTy, doublePrimTy] (doublePrimTy) primOpInfo DoubleMulOp = mkGenPrimOp (fsLit "*##")  [] [doublePrimTy, doublePrimTy] (doublePrimTy)@@ -299,6 +301,8 @@ primOpInfo FloatNeOp = mkCompare (fsLit "neFloat#") floatPrimTy primOpInfo FloatLtOp = mkCompare (fsLit "ltFloat#") floatPrimTy primOpInfo FloatLeOp = mkCompare (fsLit "leFloat#") floatPrimTy+primOpInfo FloatMinOp = mkGenPrimOp (fsLit "minFloat#")  [] [floatPrimTy, floatPrimTy] (floatPrimTy)+primOpInfo FloatMaxOp = mkGenPrimOp (fsLit "maxFloat#")  [] [floatPrimTy, floatPrimTy] (floatPrimTy) primOpInfo FloatAddOp = mkGenPrimOp (fsLit "plusFloat#")  [] [floatPrimTy, floatPrimTy] (floatPrimTy) primOpInfo FloatSubOp = mkGenPrimOp (fsLit "minusFloat#")  [] [floatPrimTy, floatPrimTy] (floatPrimTy) primOpInfo FloatMulOp = mkGenPrimOp (fsLit "timesFloat#")  [] [floatPrimTy, floatPrimTy] (floatPrimTy)@@ -373,6 +377,8 @@ primOpInfo NewAlignedPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newAlignedPinnedByteArray#")  [deltaTyVarSpec] [intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) primOpInfo MutableByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isMutableByteArrayPinned#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy) primOpInfo ByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isByteArrayPinned#")  [] [byteArrayPrimTy] (intPrimTy)+primOpInfo ByteArrayIsWeaklyPinnedOp = mkGenPrimOp (fsLit "isByteArrayWeaklyPinned#")  [] [byteArrayPrimTy] (intPrimTy)+primOpInfo MutableByteArrayIsWeaklyPinnedOp = mkGenPrimOp (fsLit "isMutableByteArrayWeaklyPinned#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy) primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#")  [] [byteArrayPrimTy] (addrPrimTy) primOpInfo MutableByteArrayContents_Char = mkGenPrimOp (fsLit "mutableByteArrayContents#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy] (addrPrimTy) primOpInfo ShrinkMutableByteArrayOp_Char = mkGenPrimOp (fsLit "shrinkMutableByteArray#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)@@ -691,7 +697,6 @@ primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#")  [levity1TyVarInf, levity2TyVarInf, levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec] [levPolyAlphaTy, levPolyBetaTy] (intPrimTy) primOpInfo ParOp = mkGenPrimOp (fsLit "par#")  [alphaTyVarSpec] [alphaTy] (intPrimTy) primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#")  [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))-primOpInfo SeqOp = mkGenPrimOp (fsLit "seq#")  [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo GetSparkOp = mkGenPrimOp (fsLit "getSpark#")  [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#")  [deltaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo KeepAliveOp = mkGenPrimOp (fsLit "keepAlive#")  [levity1TyVarInf, runtimeRep2TyVarInf, levPolyAlphaTyVarSpec, deltaTyVarSpec, openBetaTyVarSpec] [levPolyAlphaTy, mkStatePrimTy deltaTy, (mkVisFunTyMany (mkStatePrimTy deltaTy) (openBetaTy))] (openBetaTy)@@ -1355,6 +1360,120 @@ primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX4#")  [deltaTyVarSpec] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo (VecWriteScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX16#")  [deltaTyVarSpec] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX8#")  [deltaTyVarSpec] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecFMAdd FloatVec 4 W32) = mkGenPrimOp (fsLit "fmaddFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy, floatX4PrimTy] (floatX4PrimTy)+primOpInfo (VecFMAdd FloatVec 2 W64) = mkGenPrimOp (fsLit "fmaddDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy, doubleX2PrimTy] (doubleX2PrimTy)+primOpInfo (VecFMAdd FloatVec 8 W32) = mkGenPrimOp (fsLit "fmaddFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy, floatX8PrimTy] (floatX8PrimTy)+primOpInfo (VecFMAdd FloatVec 4 W64) = mkGenPrimOp (fsLit "fmaddDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy, doubleX4PrimTy] (doubleX4PrimTy)+primOpInfo (VecFMAdd FloatVec 16 W32) = mkGenPrimOp (fsLit "fmaddFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy, floatX16PrimTy] (floatX16PrimTy)+primOpInfo (VecFMAdd FloatVec 8 W64) = mkGenPrimOp (fsLit "fmaddDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy, doubleX8PrimTy] (doubleX8PrimTy)+primOpInfo (VecFMSub FloatVec 4 W32) = mkGenPrimOp (fsLit "fmsubFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy, floatX4PrimTy] (floatX4PrimTy)+primOpInfo (VecFMSub FloatVec 2 W64) = mkGenPrimOp (fsLit "fmsubDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy, doubleX2PrimTy] (doubleX2PrimTy)+primOpInfo (VecFMSub FloatVec 8 W32) = mkGenPrimOp (fsLit "fmsubFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy, floatX8PrimTy] (floatX8PrimTy)+primOpInfo (VecFMSub FloatVec 4 W64) = mkGenPrimOp (fsLit "fmsubDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy, doubleX4PrimTy] (doubleX4PrimTy)+primOpInfo (VecFMSub FloatVec 16 W32) = mkGenPrimOp (fsLit "fmsubFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy, floatX16PrimTy] (floatX16PrimTy)+primOpInfo (VecFMSub FloatVec 8 W64) = mkGenPrimOp (fsLit "fmsubDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy, doubleX8PrimTy] (doubleX8PrimTy)+primOpInfo (VecFNMAdd FloatVec 4 W32) = mkGenPrimOp (fsLit "fnmaddFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy, floatX4PrimTy] (floatX4PrimTy)+primOpInfo (VecFNMAdd FloatVec 2 W64) = mkGenPrimOp (fsLit "fnmaddDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy, doubleX2PrimTy] (doubleX2PrimTy)+primOpInfo (VecFNMAdd FloatVec 8 W32) = mkGenPrimOp (fsLit "fnmaddFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy, floatX8PrimTy] (floatX8PrimTy)+primOpInfo (VecFNMAdd FloatVec 4 W64) = mkGenPrimOp (fsLit "fnmaddDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy, doubleX4PrimTy] (doubleX4PrimTy)+primOpInfo (VecFNMAdd FloatVec 16 W32) = mkGenPrimOp (fsLit "fnmaddFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy, floatX16PrimTy] (floatX16PrimTy)+primOpInfo (VecFNMAdd FloatVec 8 W64) = mkGenPrimOp (fsLit "fnmaddDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy, doubleX8PrimTy] (doubleX8PrimTy)+primOpInfo (VecFNMSub FloatVec 4 W32) = mkGenPrimOp (fsLit "fnmsubFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy, floatX4PrimTy] (floatX4PrimTy)+primOpInfo (VecFNMSub FloatVec 2 W64) = mkGenPrimOp (fsLit "fnmsubDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy, doubleX2PrimTy] (doubleX2PrimTy)+primOpInfo (VecFNMSub FloatVec 8 W32) = mkGenPrimOp (fsLit "fnmsubFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy, floatX8PrimTy] (floatX8PrimTy)+primOpInfo (VecFNMSub FloatVec 4 W64) = mkGenPrimOp (fsLit "fnmsubDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy, doubleX4PrimTy] (doubleX4PrimTy)+primOpInfo (VecFNMSub FloatVec 16 W32) = mkGenPrimOp (fsLit "fnmsubFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy, floatX16PrimTy] (floatX16PrimTy)+primOpInfo (VecFNMSub FloatVec 8 W64) = mkGenPrimOp (fsLit "fnmsubDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy, doubleX8PrimTy] (doubleX8PrimTy)+primOpInfo (VecShuffleOp IntVec 16 W8) = mkGenPrimOp (fsLit "shuffleInt8X16#")  [] [int8X16PrimTy, int8X16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X16PrimTy)+primOpInfo (VecShuffleOp IntVec 8 W16) = mkGenPrimOp (fsLit "shuffleInt16X8#")  [] [int16X8PrimTy, int16X8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X8PrimTy)+primOpInfo (VecShuffleOp IntVec 4 W32) = mkGenPrimOp (fsLit "shuffleInt32X4#")  [] [int32X4PrimTy, int32X4PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X4PrimTy)+primOpInfo (VecShuffleOp IntVec 2 W64) = mkGenPrimOp (fsLit "shuffleInt64X2#")  [] [int64X2PrimTy, int64X2PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy])] (int64X2PrimTy)+primOpInfo (VecShuffleOp IntVec 32 W8) = mkGenPrimOp (fsLit "shuffleInt8X32#")  [] [int8X32PrimTy, int8X32PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X32PrimTy)+primOpInfo (VecShuffleOp IntVec 16 W16) = mkGenPrimOp (fsLit "shuffleInt16X16#")  [] [int16X16PrimTy, int16X16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X16PrimTy)+primOpInfo (VecShuffleOp IntVec 8 W32) = mkGenPrimOp (fsLit "shuffleInt32X8#")  [] [int32X8PrimTy, int32X8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X8PrimTy)+primOpInfo (VecShuffleOp IntVec 4 W64) = mkGenPrimOp (fsLit "shuffleInt64X4#")  [] [int64X4PrimTy, int64X4PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int64X4PrimTy)+primOpInfo (VecShuffleOp IntVec 64 W8) = mkGenPrimOp (fsLit "shuffleInt8X64#")  [] [int8X64PrimTy, int8X64PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X64PrimTy)+primOpInfo (VecShuffleOp IntVec 32 W16) = mkGenPrimOp (fsLit "shuffleInt16X32#")  [] [int16X32PrimTy, int16X32PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X32PrimTy)+primOpInfo (VecShuffleOp IntVec 16 W32) = mkGenPrimOp (fsLit "shuffleInt32X16#")  [] [int32X16PrimTy, int32X16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X16PrimTy)+primOpInfo (VecShuffleOp IntVec 8 W64) = mkGenPrimOp (fsLit "shuffleInt64X8#")  [] [int64X8PrimTy, int64X8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int64X8PrimTy)+primOpInfo (VecShuffleOp WordVec 16 W8) = mkGenPrimOp (fsLit "shuffleWord8X16#")  [] [word8X16PrimTy, word8X16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word8X16PrimTy)+primOpInfo (VecShuffleOp WordVec 8 W16) = mkGenPrimOp (fsLit "shuffleWord16X8#")  [] [word16X8PrimTy, word16X8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word16X8PrimTy)+primOpInfo (VecShuffleOp WordVec 4 W32) = mkGenPrimOp (fsLit "shuffleWord32X4#")  [] [word32X4PrimTy, word32X4PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word32X4PrimTy)+primOpInfo (VecShuffleOp WordVec 2 W64) = mkGenPrimOp (fsLit "shuffleWord64X2#")  [] [word64X2PrimTy, word64X2PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy])] (word64X2PrimTy)+primOpInfo (VecShuffleOp WordVec 32 W8) = mkGenPrimOp (fsLit "shuffleWord8X32#")  [] [word8X32PrimTy, word8X32PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word8X32PrimTy)+primOpInfo (VecShuffleOp WordVec 16 W16) = mkGenPrimOp (fsLit "shuffleWord16X16#")  [] [word16X16PrimTy, word16X16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word16X16PrimTy)+primOpInfo (VecShuffleOp WordVec 8 W32) = mkGenPrimOp (fsLit "shuffleWord32X8#")  [] [word32X8PrimTy, word32X8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word32X8PrimTy)+primOpInfo (VecShuffleOp WordVec 4 W64) = mkGenPrimOp (fsLit "shuffleWord64X4#")  [] [word64X4PrimTy, word64X4PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word64X4PrimTy)+primOpInfo (VecShuffleOp WordVec 64 W8) = mkGenPrimOp (fsLit "shuffleWord8X64#")  [] [word8X64PrimTy, word8X64PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word8X64PrimTy)+primOpInfo (VecShuffleOp WordVec 32 W16) = mkGenPrimOp (fsLit "shuffleWord16X32#")  [] [word16X32PrimTy, word16X32PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word16X32PrimTy)+primOpInfo (VecShuffleOp WordVec 16 W32) = mkGenPrimOp (fsLit "shuffleWord32X16#")  [] [word32X16PrimTy, word32X16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word32X16PrimTy)+primOpInfo (VecShuffleOp WordVec 8 W64) = mkGenPrimOp (fsLit "shuffleWord64X8#")  [] [word64X8PrimTy, word64X8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (word64X8PrimTy)+primOpInfo (VecShuffleOp FloatVec 4 W32) = mkGenPrimOp (fsLit "shuffleFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (floatX4PrimTy)+primOpInfo (VecShuffleOp FloatVec 2 W64) = mkGenPrimOp (fsLit "shuffleDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy])] (doubleX2PrimTy)+primOpInfo (VecShuffleOp FloatVec 8 W32) = mkGenPrimOp (fsLit "shuffleFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (floatX8PrimTy)+primOpInfo (VecShuffleOp FloatVec 4 W64) = mkGenPrimOp (fsLit "shuffleDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (doubleX4PrimTy)+primOpInfo (VecShuffleOp FloatVec 16 W32) = mkGenPrimOp (fsLit "shuffleFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (floatX16PrimTy)+primOpInfo (VecShuffleOp FloatVec 8 W64) = mkGenPrimOp (fsLit "shuffleDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy, (mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (doubleX8PrimTy)+primOpInfo (VecMinOp IntVec 16 W8) = mkGenPrimOp (fsLit "minInt8X16#")  [] [int8X16PrimTy, int8X16PrimTy] (int8X16PrimTy)+primOpInfo (VecMinOp IntVec 8 W16) = mkGenPrimOp (fsLit "minInt16X8#")  [] [int16X8PrimTy, int16X8PrimTy] (int16X8PrimTy)+primOpInfo (VecMinOp IntVec 4 W32) = mkGenPrimOp (fsLit "minInt32X4#")  [] [int32X4PrimTy, int32X4PrimTy] (int32X4PrimTy)+primOpInfo (VecMinOp IntVec 2 W64) = mkGenPrimOp (fsLit "minInt64X2#")  [] [int64X2PrimTy, int64X2PrimTy] (int64X2PrimTy)+primOpInfo (VecMinOp IntVec 32 W8) = mkGenPrimOp (fsLit "minInt8X32#")  [] [int8X32PrimTy, int8X32PrimTy] (int8X32PrimTy)+primOpInfo (VecMinOp IntVec 16 W16) = mkGenPrimOp (fsLit "minInt16X16#")  [] [int16X16PrimTy, int16X16PrimTy] (int16X16PrimTy)+primOpInfo (VecMinOp IntVec 8 W32) = mkGenPrimOp (fsLit "minInt32X8#")  [] [int32X8PrimTy, int32X8PrimTy] (int32X8PrimTy)+primOpInfo (VecMinOp IntVec 4 W64) = mkGenPrimOp (fsLit "minInt64X4#")  [] [int64X4PrimTy, int64X4PrimTy] (int64X4PrimTy)+primOpInfo (VecMinOp IntVec 64 W8) = mkGenPrimOp (fsLit "minInt8X64#")  [] [int8X64PrimTy, int8X64PrimTy] (int8X64PrimTy)+primOpInfo (VecMinOp IntVec 32 W16) = mkGenPrimOp (fsLit "minInt16X32#")  [] [int16X32PrimTy, int16X32PrimTy] (int16X32PrimTy)+primOpInfo (VecMinOp IntVec 16 W32) = mkGenPrimOp (fsLit "minInt32X16#")  [] [int32X16PrimTy, int32X16PrimTy] (int32X16PrimTy)+primOpInfo (VecMinOp IntVec 8 W64) = mkGenPrimOp (fsLit "minInt64X8#")  [] [int64X8PrimTy, int64X8PrimTy] (int64X8PrimTy)+primOpInfo (VecMinOp WordVec 16 W8) = mkGenPrimOp (fsLit "minWord8X16#")  [] [word8X16PrimTy, word8X16PrimTy] (word8X16PrimTy)+primOpInfo (VecMinOp WordVec 8 W16) = mkGenPrimOp (fsLit "minWord16X8#")  [] [word16X8PrimTy, word16X8PrimTy] (word16X8PrimTy)+primOpInfo (VecMinOp WordVec 4 W32) = mkGenPrimOp (fsLit "minWord32X4#")  [] [word32X4PrimTy, word32X4PrimTy] (word32X4PrimTy)+primOpInfo (VecMinOp WordVec 2 W64) = mkGenPrimOp (fsLit "minWord64X2#")  [] [word64X2PrimTy, word64X2PrimTy] (word64X2PrimTy)+primOpInfo (VecMinOp WordVec 32 W8) = mkGenPrimOp (fsLit "minWord8X32#")  [] [word8X32PrimTy, word8X32PrimTy] (word8X32PrimTy)+primOpInfo (VecMinOp WordVec 16 W16) = mkGenPrimOp (fsLit "minWord16X16#")  [] [word16X16PrimTy, word16X16PrimTy] (word16X16PrimTy)+primOpInfo (VecMinOp WordVec 8 W32) = mkGenPrimOp (fsLit "minWord32X8#")  [] [word32X8PrimTy, word32X8PrimTy] (word32X8PrimTy)+primOpInfo (VecMinOp WordVec 4 W64) = mkGenPrimOp (fsLit "minWord64X4#")  [] [word64X4PrimTy, word64X4PrimTy] (word64X4PrimTy)+primOpInfo (VecMinOp WordVec 64 W8) = mkGenPrimOp (fsLit "minWord8X64#")  [] [word8X64PrimTy, word8X64PrimTy] (word8X64PrimTy)+primOpInfo (VecMinOp WordVec 32 W16) = mkGenPrimOp (fsLit "minWord16X32#")  [] [word16X32PrimTy, word16X32PrimTy] (word16X32PrimTy)+primOpInfo (VecMinOp WordVec 16 W32) = mkGenPrimOp (fsLit "minWord32X16#")  [] [word32X16PrimTy, word32X16PrimTy] (word32X16PrimTy)+primOpInfo (VecMinOp WordVec 8 W64) = mkGenPrimOp (fsLit "minWord64X8#")  [] [word64X8PrimTy, word64X8PrimTy] (word64X8PrimTy)+primOpInfo (VecMinOp FloatVec 4 W32) = mkGenPrimOp (fsLit "minFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy] (floatX4PrimTy)+primOpInfo (VecMinOp FloatVec 2 W64) = mkGenPrimOp (fsLit "minDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy] (doubleX2PrimTy)+primOpInfo (VecMinOp FloatVec 8 W32) = mkGenPrimOp (fsLit "minFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy] (floatX8PrimTy)+primOpInfo (VecMinOp FloatVec 4 W64) = mkGenPrimOp (fsLit "minDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy] (doubleX4PrimTy)+primOpInfo (VecMinOp FloatVec 16 W32) = mkGenPrimOp (fsLit "minFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy] (floatX16PrimTy)+primOpInfo (VecMinOp FloatVec 8 W64) = mkGenPrimOp (fsLit "minDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy] (doubleX8PrimTy)+primOpInfo (VecMaxOp IntVec 16 W8) = mkGenPrimOp (fsLit "maxInt8X16#")  [] [int8X16PrimTy, int8X16PrimTy] (int8X16PrimTy)+primOpInfo (VecMaxOp IntVec 8 W16) = mkGenPrimOp (fsLit "maxInt16X8#")  [] [int16X8PrimTy, int16X8PrimTy] (int16X8PrimTy)+primOpInfo (VecMaxOp IntVec 4 W32) = mkGenPrimOp (fsLit "maxInt32X4#")  [] [int32X4PrimTy, int32X4PrimTy] (int32X4PrimTy)+primOpInfo (VecMaxOp IntVec 2 W64) = mkGenPrimOp (fsLit "maxInt64X2#")  [] [int64X2PrimTy, int64X2PrimTy] (int64X2PrimTy)+primOpInfo (VecMaxOp IntVec 32 W8) = mkGenPrimOp (fsLit "maxInt8X32#")  [] [int8X32PrimTy, int8X32PrimTy] (int8X32PrimTy)+primOpInfo (VecMaxOp IntVec 16 W16) = mkGenPrimOp (fsLit "maxInt16X16#")  [] [int16X16PrimTy, int16X16PrimTy] (int16X16PrimTy)+primOpInfo (VecMaxOp IntVec 8 W32) = mkGenPrimOp (fsLit "maxInt32X8#")  [] [int32X8PrimTy, int32X8PrimTy] (int32X8PrimTy)+primOpInfo (VecMaxOp IntVec 4 W64) = mkGenPrimOp (fsLit "maxInt64X4#")  [] [int64X4PrimTy, int64X4PrimTy] (int64X4PrimTy)+primOpInfo (VecMaxOp IntVec 64 W8) = mkGenPrimOp (fsLit "maxInt8X64#")  [] [int8X64PrimTy, int8X64PrimTy] (int8X64PrimTy)+primOpInfo (VecMaxOp IntVec 32 W16) = mkGenPrimOp (fsLit "maxInt16X32#")  [] [int16X32PrimTy, int16X32PrimTy] (int16X32PrimTy)+primOpInfo (VecMaxOp IntVec 16 W32) = mkGenPrimOp (fsLit "maxInt32X16#")  [] [int32X16PrimTy, int32X16PrimTy] (int32X16PrimTy)+primOpInfo (VecMaxOp IntVec 8 W64) = mkGenPrimOp (fsLit "maxInt64X8#")  [] [int64X8PrimTy, int64X8PrimTy] (int64X8PrimTy)+primOpInfo (VecMaxOp WordVec 16 W8) = mkGenPrimOp (fsLit "maxWord8X16#")  [] [word8X16PrimTy, word8X16PrimTy] (word8X16PrimTy)+primOpInfo (VecMaxOp WordVec 8 W16) = mkGenPrimOp (fsLit "maxWord16X8#")  [] [word16X8PrimTy, word16X8PrimTy] (word16X8PrimTy)+primOpInfo (VecMaxOp WordVec 4 W32) = mkGenPrimOp (fsLit "maxWord32X4#")  [] [word32X4PrimTy, word32X4PrimTy] (word32X4PrimTy)+primOpInfo (VecMaxOp WordVec 2 W64) = mkGenPrimOp (fsLit "maxWord64X2#")  [] [word64X2PrimTy, word64X2PrimTy] (word64X2PrimTy)+primOpInfo (VecMaxOp WordVec 32 W8) = mkGenPrimOp (fsLit "maxWord8X32#")  [] [word8X32PrimTy, word8X32PrimTy] (word8X32PrimTy)+primOpInfo (VecMaxOp WordVec 16 W16) = mkGenPrimOp (fsLit "maxWord16X16#")  [] [word16X16PrimTy, word16X16PrimTy] (word16X16PrimTy)+primOpInfo (VecMaxOp WordVec 8 W32) = mkGenPrimOp (fsLit "maxWord32X8#")  [] [word32X8PrimTy, word32X8PrimTy] (word32X8PrimTy)+primOpInfo (VecMaxOp WordVec 4 W64) = mkGenPrimOp (fsLit "maxWord64X4#")  [] [word64X4PrimTy, word64X4PrimTy] (word64X4PrimTy)+primOpInfo (VecMaxOp WordVec 64 W8) = mkGenPrimOp (fsLit "maxWord8X64#")  [] [word8X64PrimTy, word8X64PrimTy] (word8X64PrimTy)+primOpInfo (VecMaxOp WordVec 32 W16) = mkGenPrimOp (fsLit "maxWord16X32#")  [] [word16X32PrimTy, word16X32PrimTy] (word16X32PrimTy)+primOpInfo (VecMaxOp WordVec 16 W32) = mkGenPrimOp (fsLit "maxWord32X16#")  [] [word32X16PrimTy, word32X16PrimTy] (word32X16PrimTy)+primOpInfo (VecMaxOp WordVec 8 W64) = mkGenPrimOp (fsLit "maxWord64X8#")  [] [word64X8PrimTy, word64X8PrimTy] (word64X8PrimTy)+primOpInfo (VecMaxOp FloatVec 4 W32) = mkGenPrimOp (fsLit "maxFloatX4#")  [] [floatX4PrimTy, floatX4PrimTy] (floatX4PrimTy)+primOpInfo (VecMaxOp FloatVec 2 W64) = mkGenPrimOp (fsLit "maxDoubleX2#")  [] [doubleX2PrimTy, doubleX2PrimTy] (doubleX2PrimTy)+primOpInfo (VecMaxOp FloatVec 8 W32) = mkGenPrimOp (fsLit "maxFloatX8#")  [] [floatX8PrimTy, floatX8PrimTy] (floatX8PrimTy)+primOpInfo (VecMaxOp FloatVec 4 W64) = mkGenPrimOp (fsLit "maxDoubleX4#")  [] [doubleX4PrimTy, doubleX4PrimTy] (doubleX4PrimTy)+primOpInfo (VecMaxOp FloatVec 16 W32) = mkGenPrimOp (fsLit "maxFloatX16#")  [] [floatX16PrimTy, floatX16PrimTy] (floatX16PrimTy)+primOpInfo (VecMaxOp FloatVec 8 W64) = mkGenPrimOp (fsLit "maxDoubleX8#")  [] [doubleX8PrimTy, doubleX8PrimTy] (doubleX8PrimTy) primOpInfo PrefetchByteArrayOp3 = mkGenPrimOp (fsLit "prefetchByteArray3#")  [deltaTyVarSpec] [byteArrayPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo PrefetchMutableByteArrayOp3 = mkGenPrimOp (fsLit "prefetchMutableByteArray3#")  [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo PrefetchAddrOp3 = mkGenPrimOp (fsLit "prefetchAddr3#")  [deltaTyVarSpec] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)
ghc-lib/stage0/compiler/build/primop-tag.hs-incl view
@@ -1,1376 +1,1495 @@ maxPrimOpTag :: Int-maxPrimOpTag = 1372-primOpTag :: PrimOp -> Int-primOpTag CharGtOp = 0-primOpTag CharGeOp = 1-primOpTag CharEqOp = 2-primOpTag CharNeOp = 3-primOpTag CharLtOp = 4-primOpTag CharLeOp = 5-primOpTag OrdOp = 6-primOpTag Int8ToIntOp = 7-primOpTag IntToInt8Op = 8-primOpTag Int8NegOp = 9-primOpTag Int8AddOp = 10-primOpTag Int8SubOp = 11-primOpTag Int8MulOp = 12-primOpTag Int8QuotOp = 13-primOpTag Int8RemOp = 14-primOpTag Int8QuotRemOp = 15-primOpTag Int8SllOp = 16-primOpTag Int8SraOp = 17-primOpTag Int8SrlOp = 18-primOpTag Int8ToWord8Op = 19-primOpTag Int8EqOp = 20-primOpTag Int8GeOp = 21-primOpTag Int8GtOp = 22-primOpTag Int8LeOp = 23-primOpTag Int8LtOp = 24-primOpTag Int8NeOp = 25-primOpTag Word8ToWordOp = 26-primOpTag WordToWord8Op = 27-primOpTag Word8AddOp = 28-primOpTag Word8SubOp = 29-primOpTag Word8MulOp = 30-primOpTag Word8QuotOp = 31-primOpTag Word8RemOp = 32-primOpTag Word8QuotRemOp = 33-primOpTag Word8AndOp = 34-primOpTag Word8OrOp = 35-primOpTag Word8XorOp = 36-primOpTag Word8NotOp = 37-primOpTag Word8SllOp = 38-primOpTag Word8SrlOp = 39-primOpTag Word8ToInt8Op = 40-primOpTag Word8EqOp = 41-primOpTag Word8GeOp = 42-primOpTag Word8GtOp = 43-primOpTag Word8LeOp = 44-primOpTag Word8LtOp = 45-primOpTag Word8NeOp = 46-primOpTag Int16ToIntOp = 47-primOpTag IntToInt16Op = 48-primOpTag Int16NegOp = 49-primOpTag Int16AddOp = 50-primOpTag Int16SubOp = 51-primOpTag Int16MulOp = 52-primOpTag Int16QuotOp = 53-primOpTag Int16RemOp = 54-primOpTag Int16QuotRemOp = 55-primOpTag Int16SllOp = 56-primOpTag Int16SraOp = 57-primOpTag Int16SrlOp = 58-primOpTag Int16ToWord16Op = 59-primOpTag Int16EqOp = 60-primOpTag Int16GeOp = 61-primOpTag Int16GtOp = 62-primOpTag Int16LeOp = 63-primOpTag Int16LtOp = 64-primOpTag Int16NeOp = 65-primOpTag Word16ToWordOp = 66-primOpTag WordToWord16Op = 67-primOpTag Word16AddOp = 68-primOpTag Word16SubOp = 69-primOpTag Word16MulOp = 70-primOpTag Word16QuotOp = 71-primOpTag Word16RemOp = 72-primOpTag Word16QuotRemOp = 73-primOpTag Word16AndOp = 74-primOpTag Word16OrOp = 75-primOpTag Word16XorOp = 76-primOpTag Word16NotOp = 77-primOpTag Word16SllOp = 78-primOpTag Word16SrlOp = 79-primOpTag Word16ToInt16Op = 80-primOpTag Word16EqOp = 81-primOpTag Word16GeOp = 82-primOpTag Word16GtOp = 83-primOpTag Word16LeOp = 84-primOpTag Word16LtOp = 85-primOpTag Word16NeOp = 86-primOpTag Int32ToIntOp = 87-primOpTag IntToInt32Op = 88-primOpTag Int32NegOp = 89-primOpTag Int32AddOp = 90-primOpTag Int32SubOp = 91-primOpTag Int32MulOp = 92-primOpTag Int32QuotOp = 93-primOpTag Int32RemOp = 94-primOpTag Int32QuotRemOp = 95-primOpTag Int32SllOp = 96-primOpTag Int32SraOp = 97-primOpTag Int32SrlOp = 98-primOpTag Int32ToWord32Op = 99-primOpTag Int32EqOp = 100-primOpTag Int32GeOp = 101-primOpTag Int32GtOp = 102-primOpTag Int32LeOp = 103-primOpTag Int32LtOp = 104-primOpTag Int32NeOp = 105-primOpTag Word32ToWordOp = 106-primOpTag WordToWord32Op = 107-primOpTag Word32AddOp = 108-primOpTag Word32SubOp = 109-primOpTag Word32MulOp = 110-primOpTag Word32QuotOp = 111-primOpTag Word32RemOp = 112-primOpTag Word32QuotRemOp = 113-primOpTag Word32AndOp = 114-primOpTag Word32OrOp = 115-primOpTag Word32XorOp = 116-primOpTag Word32NotOp = 117-primOpTag Word32SllOp = 118-primOpTag Word32SrlOp = 119-primOpTag Word32ToInt32Op = 120-primOpTag Word32EqOp = 121-primOpTag Word32GeOp = 122-primOpTag Word32GtOp = 123-primOpTag Word32LeOp = 124-primOpTag Word32LtOp = 125-primOpTag Word32NeOp = 126-primOpTag Int64ToIntOp = 127-primOpTag IntToInt64Op = 128-primOpTag Int64NegOp = 129-primOpTag Int64AddOp = 130-primOpTag Int64SubOp = 131-primOpTag Int64MulOp = 132-primOpTag Int64QuotOp = 133-primOpTag Int64RemOp = 134-primOpTag Int64SllOp = 135-primOpTag Int64SraOp = 136-primOpTag Int64SrlOp = 137-primOpTag Int64ToWord64Op = 138-primOpTag Int64EqOp = 139-primOpTag Int64GeOp = 140-primOpTag Int64GtOp = 141-primOpTag Int64LeOp = 142-primOpTag Int64LtOp = 143-primOpTag Int64NeOp = 144-primOpTag Word64ToWordOp = 145-primOpTag WordToWord64Op = 146-primOpTag Word64AddOp = 147-primOpTag Word64SubOp = 148-primOpTag Word64MulOp = 149-primOpTag Word64QuotOp = 150-primOpTag Word64RemOp = 151-primOpTag Word64AndOp = 152-primOpTag Word64OrOp = 153-primOpTag Word64XorOp = 154-primOpTag Word64NotOp = 155-primOpTag Word64SllOp = 156-primOpTag Word64SrlOp = 157-primOpTag Word64ToInt64Op = 158-primOpTag Word64EqOp = 159-primOpTag Word64GeOp = 160-primOpTag Word64GtOp = 161-primOpTag Word64LeOp = 162-primOpTag Word64LtOp = 163-primOpTag Word64NeOp = 164-primOpTag IntAddOp = 165-primOpTag IntSubOp = 166-primOpTag IntMulOp = 167-primOpTag IntMul2Op = 168-primOpTag IntMulMayOfloOp = 169-primOpTag IntQuotOp = 170-primOpTag IntRemOp = 171-primOpTag IntQuotRemOp = 172-primOpTag IntAndOp = 173-primOpTag IntOrOp = 174-primOpTag IntXorOp = 175-primOpTag IntNotOp = 176-primOpTag IntNegOp = 177-primOpTag IntAddCOp = 178-primOpTag IntSubCOp = 179-primOpTag IntGtOp = 180-primOpTag IntGeOp = 181-primOpTag IntEqOp = 182-primOpTag IntNeOp = 183-primOpTag IntLtOp = 184-primOpTag IntLeOp = 185-primOpTag ChrOp = 186-primOpTag IntToWordOp = 187-primOpTag IntToFloatOp = 188-primOpTag IntToDoubleOp = 189-primOpTag WordToFloatOp = 190-primOpTag WordToDoubleOp = 191-primOpTag IntSllOp = 192-primOpTag IntSraOp = 193-primOpTag IntSrlOp = 194-primOpTag WordAddOp = 195-primOpTag WordAddCOp = 196-primOpTag WordSubCOp = 197-primOpTag WordAdd2Op = 198-primOpTag WordSubOp = 199-primOpTag WordMulOp = 200-primOpTag WordMul2Op = 201-primOpTag WordQuotOp = 202-primOpTag WordRemOp = 203-primOpTag WordQuotRemOp = 204-primOpTag WordQuotRem2Op = 205-primOpTag WordAndOp = 206-primOpTag WordOrOp = 207-primOpTag WordXorOp = 208-primOpTag WordNotOp = 209-primOpTag WordSllOp = 210-primOpTag WordSrlOp = 211-primOpTag WordToIntOp = 212-primOpTag WordGtOp = 213-primOpTag WordGeOp = 214-primOpTag WordEqOp = 215-primOpTag WordNeOp = 216-primOpTag WordLtOp = 217-primOpTag WordLeOp = 218-primOpTag PopCnt8Op = 219-primOpTag PopCnt16Op = 220-primOpTag PopCnt32Op = 221-primOpTag PopCnt64Op = 222-primOpTag PopCntOp = 223-primOpTag Pdep8Op = 224-primOpTag Pdep16Op = 225-primOpTag Pdep32Op = 226-primOpTag Pdep64Op = 227-primOpTag PdepOp = 228-primOpTag Pext8Op = 229-primOpTag Pext16Op = 230-primOpTag Pext32Op = 231-primOpTag Pext64Op = 232-primOpTag PextOp = 233-primOpTag Clz8Op = 234-primOpTag Clz16Op = 235-primOpTag Clz32Op = 236-primOpTag Clz64Op = 237-primOpTag ClzOp = 238-primOpTag Ctz8Op = 239-primOpTag Ctz16Op = 240-primOpTag Ctz32Op = 241-primOpTag Ctz64Op = 242-primOpTag CtzOp = 243-primOpTag BSwap16Op = 244-primOpTag BSwap32Op = 245-primOpTag BSwap64Op = 246-primOpTag BSwapOp = 247-primOpTag BRev8Op = 248-primOpTag BRev16Op = 249-primOpTag BRev32Op = 250-primOpTag BRev64Op = 251-primOpTag BRevOp = 252-primOpTag Narrow8IntOp = 253-primOpTag Narrow16IntOp = 254-primOpTag Narrow32IntOp = 255-primOpTag Narrow8WordOp = 256-primOpTag Narrow16WordOp = 257-primOpTag Narrow32WordOp = 258-primOpTag DoubleGtOp = 259-primOpTag DoubleGeOp = 260-primOpTag DoubleEqOp = 261-primOpTag DoubleNeOp = 262-primOpTag DoubleLtOp = 263-primOpTag DoubleLeOp = 264-primOpTag DoubleAddOp = 265-primOpTag DoubleSubOp = 266-primOpTag DoubleMulOp = 267-primOpTag DoubleDivOp = 268-primOpTag DoubleNegOp = 269-primOpTag DoubleFabsOp = 270-primOpTag DoubleToIntOp = 271-primOpTag DoubleToFloatOp = 272-primOpTag DoubleExpOp = 273-primOpTag DoubleExpM1Op = 274-primOpTag DoubleLogOp = 275-primOpTag DoubleLog1POp = 276-primOpTag DoubleSqrtOp = 277-primOpTag DoubleSinOp = 278-primOpTag DoubleCosOp = 279-primOpTag DoubleTanOp = 280-primOpTag DoubleAsinOp = 281-primOpTag DoubleAcosOp = 282-primOpTag DoubleAtanOp = 283-primOpTag DoubleSinhOp = 284-primOpTag DoubleCoshOp = 285-primOpTag DoubleTanhOp = 286-primOpTag DoubleAsinhOp = 287-primOpTag DoubleAcoshOp = 288-primOpTag DoubleAtanhOp = 289-primOpTag DoublePowerOp = 290-primOpTag DoubleDecode_2IntOp = 291-primOpTag DoubleDecode_Int64Op = 292-primOpTag CastDoubleToWord64Op = 293-primOpTag CastWord64ToDoubleOp = 294-primOpTag FloatGtOp = 295-primOpTag FloatGeOp = 296-primOpTag FloatEqOp = 297-primOpTag FloatNeOp = 298-primOpTag FloatLtOp = 299-primOpTag FloatLeOp = 300-primOpTag FloatAddOp = 301-primOpTag FloatSubOp = 302-primOpTag FloatMulOp = 303-primOpTag FloatDivOp = 304-primOpTag FloatNegOp = 305-primOpTag FloatFabsOp = 306-primOpTag FloatToIntOp = 307-primOpTag FloatExpOp = 308-primOpTag FloatExpM1Op = 309-primOpTag FloatLogOp = 310-primOpTag FloatLog1POp = 311-primOpTag FloatSqrtOp = 312-primOpTag FloatSinOp = 313-primOpTag FloatCosOp = 314-primOpTag FloatTanOp = 315-primOpTag FloatAsinOp = 316-primOpTag FloatAcosOp = 317-primOpTag FloatAtanOp = 318-primOpTag FloatSinhOp = 319-primOpTag FloatCoshOp = 320-primOpTag FloatTanhOp = 321-primOpTag FloatAsinhOp = 322-primOpTag FloatAcoshOp = 323-primOpTag FloatAtanhOp = 324-primOpTag FloatPowerOp = 325-primOpTag FloatToDoubleOp = 326-primOpTag FloatDecode_IntOp = 327-primOpTag CastFloatToWord32Op = 328-primOpTag CastWord32ToFloatOp = 329-primOpTag FloatFMAdd = 330-primOpTag FloatFMSub = 331-primOpTag FloatFNMAdd = 332-primOpTag FloatFNMSub = 333-primOpTag DoubleFMAdd = 334-primOpTag DoubleFMSub = 335-primOpTag DoubleFNMAdd = 336-primOpTag DoubleFNMSub = 337-primOpTag NewArrayOp = 338-primOpTag ReadArrayOp = 339-primOpTag WriteArrayOp = 340-primOpTag SizeofArrayOp = 341-primOpTag SizeofMutableArrayOp = 342-primOpTag IndexArrayOp = 343-primOpTag UnsafeFreezeArrayOp = 344-primOpTag UnsafeThawArrayOp = 345-primOpTag CopyArrayOp = 346-primOpTag CopyMutableArrayOp = 347-primOpTag CloneArrayOp = 348-primOpTag CloneMutableArrayOp = 349-primOpTag FreezeArrayOp = 350-primOpTag ThawArrayOp = 351-primOpTag CasArrayOp = 352-primOpTag NewSmallArrayOp = 353-primOpTag ShrinkSmallMutableArrayOp_Char = 354-primOpTag ReadSmallArrayOp = 355-primOpTag WriteSmallArrayOp = 356-primOpTag SizeofSmallArrayOp = 357-primOpTag SizeofSmallMutableArrayOp = 358-primOpTag GetSizeofSmallMutableArrayOp = 359-primOpTag IndexSmallArrayOp = 360-primOpTag UnsafeFreezeSmallArrayOp = 361-primOpTag UnsafeThawSmallArrayOp = 362-primOpTag CopySmallArrayOp = 363-primOpTag CopySmallMutableArrayOp = 364-primOpTag CloneSmallArrayOp = 365-primOpTag CloneSmallMutableArrayOp = 366-primOpTag FreezeSmallArrayOp = 367-primOpTag ThawSmallArrayOp = 368-primOpTag CasSmallArrayOp = 369-primOpTag NewByteArrayOp_Char = 370-primOpTag NewPinnedByteArrayOp_Char = 371-primOpTag NewAlignedPinnedByteArrayOp_Char = 372-primOpTag MutableByteArrayIsPinnedOp = 373-primOpTag ByteArrayIsPinnedOp = 374-primOpTag ByteArrayContents_Char = 375-primOpTag MutableByteArrayContents_Char = 376-primOpTag ShrinkMutableByteArrayOp_Char = 377-primOpTag ResizeMutableByteArrayOp_Char = 378-primOpTag UnsafeFreezeByteArrayOp = 379-primOpTag UnsafeThawByteArrayOp = 380-primOpTag SizeofByteArrayOp = 381-primOpTag SizeofMutableByteArrayOp = 382-primOpTag GetSizeofMutableByteArrayOp = 383-primOpTag IndexByteArrayOp_Char = 384-primOpTag IndexByteArrayOp_WideChar = 385-primOpTag IndexByteArrayOp_Int = 386-primOpTag IndexByteArrayOp_Word = 387-primOpTag IndexByteArrayOp_Addr = 388-primOpTag IndexByteArrayOp_Float = 389-primOpTag IndexByteArrayOp_Double = 390-primOpTag IndexByteArrayOp_StablePtr = 391-primOpTag IndexByteArrayOp_Int8 = 392-primOpTag IndexByteArrayOp_Word8 = 393-primOpTag IndexByteArrayOp_Int16 = 394-primOpTag IndexByteArrayOp_Word16 = 395-primOpTag IndexByteArrayOp_Int32 = 396-primOpTag IndexByteArrayOp_Word32 = 397-primOpTag IndexByteArrayOp_Int64 = 398-primOpTag IndexByteArrayOp_Word64 = 399-primOpTag IndexByteArrayOp_Word8AsChar = 400-primOpTag IndexByteArrayOp_Word8AsWideChar = 401-primOpTag IndexByteArrayOp_Word8AsInt = 402-primOpTag IndexByteArrayOp_Word8AsWord = 403-primOpTag IndexByteArrayOp_Word8AsAddr = 404-primOpTag IndexByteArrayOp_Word8AsFloat = 405-primOpTag IndexByteArrayOp_Word8AsDouble = 406-primOpTag IndexByteArrayOp_Word8AsStablePtr = 407-primOpTag IndexByteArrayOp_Word8AsInt16 = 408-primOpTag IndexByteArrayOp_Word8AsWord16 = 409-primOpTag IndexByteArrayOp_Word8AsInt32 = 410-primOpTag IndexByteArrayOp_Word8AsWord32 = 411-primOpTag IndexByteArrayOp_Word8AsInt64 = 412-primOpTag IndexByteArrayOp_Word8AsWord64 = 413-primOpTag ReadByteArrayOp_Char = 414-primOpTag ReadByteArrayOp_WideChar = 415-primOpTag ReadByteArrayOp_Int = 416-primOpTag ReadByteArrayOp_Word = 417-primOpTag ReadByteArrayOp_Addr = 418-primOpTag ReadByteArrayOp_Float = 419-primOpTag ReadByteArrayOp_Double = 420-primOpTag ReadByteArrayOp_StablePtr = 421-primOpTag ReadByteArrayOp_Int8 = 422-primOpTag ReadByteArrayOp_Word8 = 423-primOpTag ReadByteArrayOp_Int16 = 424-primOpTag ReadByteArrayOp_Word16 = 425-primOpTag ReadByteArrayOp_Int32 = 426-primOpTag ReadByteArrayOp_Word32 = 427-primOpTag ReadByteArrayOp_Int64 = 428-primOpTag ReadByteArrayOp_Word64 = 429-primOpTag ReadByteArrayOp_Word8AsChar = 430-primOpTag ReadByteArrayOp_Word8AsWideChar = 431-primOpTag ReadByteArrayOp_Word8AsInt = 432-primOpTag ReadByteArrayOp_Word8AsWord = 433-primOpTag ReadByteArrayOp_Word8AsAddr = 434-primOpTag ReadByteArrayOp_Word8AsFloat = 435-primOpTag ReadByteArrayOp_Word8AsDouble = 436-primOpTag ReadByteArrayOp_Word8AsStablePtr = 437-primOpTag ReadByteArrayOp_Word8AsInt16 = 438-primOpTag ReadByteArrayOp_Word8AsWord16 = 439-primOpTag ReadByteArrayOp_Word8AsInt32 = 440-primOpTag ReadByteArrayOp_Word8AsWord32 = 441-primOpTag ReadByteArrayOp_Word8AsInt64 = 442-primOpTag ReadByteArrayOp_Word8AsWord64 = 443-primOpTag WriteByteArrayOp_Char = 444-primOpTag WriteByteArrayOp_WideChar = 445-primOpTag WriteByteArrayOp_Int = 446-primOpTag WriteByteArrayOp_Word = 447-primOpTag WriteByteArrayOp_Addr = 448-primOpTag WriteByteArrayOp_Float = 449-primOpTag WriteByteArrayOp_Double = 450-primOpTag WriteByteArrayOp_StablePtr = 451-primOpTag WriteByteArrayOp_Int8 = 452-primOpTag WriteByteArrayOp_Word8 = 453-primOpTag WriteByteArrayOp_Int16 = 454-primOpTag WriteByteArrayOp_Word16 = 455-primOpTag WriteByteArrayOp_Int32 = 456-primOpTag WriteByteArrayOp_Word32 = 457-primOpTag WriteByteArrayOp_Int64 = 458-primOpTag WriteByteArrayOp_Word64 = 459-primOpTag WriteByteArrayOp_Word8AsChar = 460-primOpTag WriteByteArrayOp_Word8AsWideChar = 461-primOpTag WriteByteArrayOp_Word8AsInt = 462-primOpTag WriteByteArrayOp_Word8AsWord = 463-primOpTag WriteByteArrayOp_Word8AsAddr = 464-primOpTag WriteByteArrayOp_Word8AsFloat = 465-primOpTag WriteByteArrayOp_Word8AsDouble = 466-primOpTag WriteByteArrayOp_Word8AsStablePtr = 467-primOpTag WriteByteArrayOp_Word8AsInt16 = 468-primOpTag WriteByteArrayOp_Word8AsWord16 = 469-primOpTag WriteByteArrayOp_Word8AsInt32 = 470-primOpTag WriteByteArrayOp_Word8AsWord32 = 471-primOpTag WriteByteArrayOp_Word8AsInt64 = 472-primOpTag WriteByteArrayOp_Word8AsWord64 = 473-primOpTag CompareByteArraysOp = 474-primOpTag CopyByteArrayOp = 475-primOpTag CopyMutableByteArrayOp = 476-primOpTag CopyMutableByteArrayNonOverlappingOp = 477-primOpTag CopyByteArrayToAddrOp = 478-primOpTag CopyMutableByteArrayToAddrOp = 479-primOpTag CopyAddrToByteArrayOp = 480-primOpTag CopyAddrToAddrOp = 481-primOpTag CopyAddrToAddrNonOverlappingOp = 482-primOpTag SetByteArrayOp = 483-primOpTag SetAddrRangeOp = 484-primOpTag AtomicReadByteArrayOp_Int = 485-primOpTag AtomicWriteByteArrayOp_Int = 486-primOpTag CasByteArrayOp_Int = 487-primOpTag CasByteArrayOp_Int8 = 488-primOpTag CasByteArrayOp_Int16 = 489-primOpTag CasByteArrayOp_Int32 = 490-primOpTag CasByteArrayOp_Int64 = 491-primOpTag FetchAddByteArrayOp_Int = 492-primOpTag FetchSubByteArrayOp_Int = 493-primOpTag FetchAndByteArrayOp_Int = 494-primOpTag FetchNandByteArrayOp_Int = 495-primOpTag FetchOrByteArrayOp_Int = 496-primOpTag FetchXorByteArrayOp_Int = 497-primOpTag AddrAddOp = 498-primOpTag AddrSubOp = 499-primOpTag AddrRemOp = 500-primOpTag AddrToIntOp = 501-primOpTag IntToAddrOp = 502-primOpTag AddrGtOp = 503-primOpTag AddrGeOp = 504-primOpTag AddrEqOp = 505-primOpTag AddrNeOp = 506-primOpTag AddrLtOp = 507-primOpTag AddrLeOp = 508-primOpTag IndexOffAddrOp_Char = 509-primOpTag IndexOffAddrOp_WideChar = 510-primOpTag IndexOffAddrOp_Int = 511-primOpTag IndexOffAddrOp_Word = 512-primOpTag IndexOffAddrOp_Addr = 513-primOpTag IndexOffAddrOp_Float = 514-primOpTag IndexOffAddrOp_Double = 515-primOpTag IndexOffAddrOp_StablePtr = 516-primOpTag IndexOffAddrOp_Int8 = 517-primOpTag IndexOffAddrOp_Word8 = 518-primOpTag IndexOffAddrOp_Int16 = 519-primOpTag IndexOffAddrOp_Word16 = 520-primOpTag IndexOffAddrOp_Int32 = 521-primOpTag IndexOffAddrOp_Word32 = 522-primOpTag IndexOffAddrOp_Int64 = 523-primOpTag IndexOffAddrOp_Word64 = 524-primOpTag IndexOffAddrOp_Word8AsChar = 525-primOpTag IndexOffAddrOp_Word8AsWideChar = 526-primOpTag IndexOffAddrOp_Word8AsInt = 527-primOpTag IndexOffAddrOp_Word8AsWord = 528-primOpTag IndexOffAddrOp_Word8AsAddr = 529-primOpTag IndexOffAddrOp_Word8AsFloat = 530-primOpTag IndexOffAddrOp_Word8AsDouble = 531-primOpTag IndexOffAddrOp_Word8AsStablePtr = 532-primOpTag IndexOffAddrOp_Word8AsInt16 = 533-primOpTag IndexOffAddrOp_Word8AsWord16 = 534-primOpTag IndexOffAddrOp_Word8AsInt32 = 535-primOpTag IndexOffAddrOp_Word8AsWord32 = 536-primOpTag IndexOffAddrOp_Word8AsInt64 = 537-primOpTag IndexOffAddrOp_Word8AsWord64 = 538-primOpTag ReadOffAddrOp_Char = 539-primOpTag ReadOffAddrOp_WideChar = 540-primOpTag ReadOffAddrOp_Int = 541-primOpTag ReadOffAddrOp_Word = 542-primOpTag ReadOffAddrOp_Addr = 543-primOpTag ReadOffAddrOp_Float = 544-primOpTag ReadOffAddrOp_Double = 545-primOpTag ReadOffAddrOp_StablePtr = 546-primOpTag ReadOffAddrOp_Int8 = 547-primOpTag ReadOffAddrOp_Word8 = 548-primOpTag ReadOffAddrOp_Int16 = 549-primOpTag ReadOffAddrOp_Word16 = 550-primOpTag ReadOffAddrOp_Int32 = 551-primOpTag ReadOffAddrOp_Word32 = 552-primOpTag ReadOffAddrOp_Int64 = 553-primOpTag ReadOffAddrOp_Word64 = 554-primOpTag ReadOffAddrOp_Word8AsChar = 555-primOpTag ReadOffAddrOp_Word8AsWideChar = 556-primOpTag ReadOffAddrOp_Word8AsInt = 557-primOpTag ReadOffAddrOp_Word8AsWord = 558-primOpTag ReadOffAddrOp_Word8AsAddr = 559-primOpTag ReadOffAddrOp_Word8AsFloat = 560-primOpTag ReadOffAddrOp_Word8AsDouble = 561-primOpTag ReadOffAddrOp_Word8AsStablePtr = 562-primOpTag ReadOffAddrOp_Word8AsInt16 = 563-primOpTag ReadOffAddrOp_Word8AsWord16 = 564-primOpTag ReadOffAddrOp_Word8AsInt32 = 565-primOpTag ReadOffAddrOp_Word8AsWord32 = 566-primOpTag ReadOffAddrOp_Word8AsInt64 = 567-primOpTag ReadOffAddrOp_Word8AsWord64 = 568-primOpTag WriteOffAddrOp_Char = 569-primOpTag WriteOffAddrOp_WideChar = 570-primOpTag WriteOffAddrOp_Int = 571-primOpTag WriteOffAddrOp_Word = 572-primOpTag WriteOffAddrOp_Addr = 573-primOpTag WriteOffAddrOp_Float = 574-primOpTag WriteOffAddrOp_Double = 575-primOpTag WriteOffAddrOp_StablePtr = 576-primOpTag WriteOffAddrOp_Int8 = 577-primOpTag WriteOffAddrOp_Word8 = 578-primOpTag WriteOffAddrOp_Int16 = 579-primOpTag WriteOffAddrOp_Word16 = 580-primOpTag WriteOffAddrOp_Int32 = 581-primOpTag WriteOffAddrOp_Word32 = 582-primOpTag WriteOffAddrOp_Int64 = 583-primOpTag WriteOffAddrOp_Word64 = 584-primOpTag WriteOffAddrOp_Word8AsChar = 585-primOpTag WriteOffAddrOp_Word8AsWideChar = 586-primOpTag WriteOffAddrOp_Word8AsInt = 587-primOpTag WriteOffAddrOp_Word8AsWord = 588-primOpTag WriteOffAddrOp_Word8AsAddr = 589-primOpTag WriteOffAddrOp_Word8AsFloat = 590-primOpTag WriteOffAddrOp_Word8AsDouble = 591-primOpTag WriteOffAddrOp_Word8AsStablePtr = 592-primOpTag WriteOffAddrOp_Word8AsInt16 = 593-primOpTag WriteOffAddrOp_Word8AsWord16 = 594-primOpTag WriteOffAddrOp_Word8AsInt32 = 595-primOpTag WriteOffAddrOp_Word8AsWord32 = 596-primOpTag WriteOffAddrOp_Word8AsInt64 = 597-primOpTag WriteOffAddrOp_Word8AsWord64 = 598-primOpTag InterlockedExchange_Addr = 599-primOpTag InterlockedExchange_Word = 600-primOpTag CasAddrOp_Addr = 601-primOpTag CasAddrOp_Word = 602-primOpTag CasAddrOp_Word8 = 603-primOpTag CasAddrOp_Word16 = 604-primOpTag CasAddrOp_Word32 = 605-primOpTag CasAddrOp_Word64 = 606-primOpTag FetchAddAddrOp_Word = 607-primOpTag FetchSubAddrOp_Word = 608-primOpTag FetchAndAddrOp_Word = 609-primOpTag FetchNandAddrOp_Word = 610-primOpTag FetchOrAddrOp_Word = 611-primOpTag FetchXorAddrOp_Word = 612-primOpTag AtomicReadAddrOp_Word = 613-primOpTag AtomicWriteAddrOp_Word = 614-primOpTag NewMutVarOp = 615-primOpTag ReadMutVarOp = 616-primOpTag WriteMutVarOp = 617-primOpTag AtomicSwapMutVarOp = 618-primOpTag AtomicModifyMutVar2Op = 619-primOpTag AtomicModifyMutVar_Op = 620-primOpTag CasMutVarOp = 621-primOpTag CatchOp = 622-primOpTag RaiseOp = 623-primOpTag RaiseUnderflowOp = 624-primOpTag RaiseOverflowOp = 625-primOpTag RaiseDivZeroOp = 626-primOpTag RaiseIOOp = 627-primOpTag MaskAsyncExceptionsOp = 628-primOpTag MaskUninterruptibleOp = 629-primOpTag UnmaskAsyncExceptionsOp = 630-primOpTag MaskStatus = 631-primOpTag NewPromptTagOp = 632-primOpTag PromptOp = 633-primOpTag Control0Op = 634-primOpTag AtomicallyOp = 635-primOpTag RetryOp = 636-primOpTag CatchRetryOp = 637-primOpTag CatchSTMOp = 638-primOpTag NewTVarOp = 639-primOpTag ReadTVarOp = 640-primOpTag ReadTVarIOOp = 641-primOpTag WriteTVarOp = 642-primOpTag NewMVarOp = 643-primOpTag TakeMVarOp = 644-primOpTag TryTakeMVarOp = 645-primOpTag PutMVarOp = 646-primOpTag TryPutMVarOp = 647-primOpTag ReadMVarOp = 648-primOpTag TryReadMVarOp = 649-primOpTag IsEmptyMVarOp = 650-primOpTag NewIOPortOp = 651-primOpTag ReadIOPortOp = 652-primOpTag WriteIOPortOp = 653-primOpTag DelayOp = 654-primOpTag WaitReadOp = 655-primOpTag WaitWriteOp = 656-primOpTag ForkOp = 657-primOpTag ForkOnOp = 658-primOpTag KillThreadOp = 659-primOpTag YieldOp = 660-primOpTag MyThreadIdOp = 661-primOpTag LabelThreadOp = 662-primOpTag IsCurrentThreadBoundOp = 663-primOpTag NoDuplicateOp = 664-primOpTag GetThreadLabelOp = 665-primOpTag ThreadStatusOp = 666-primOpTag ListThreadsOp = 667-primOpTag MkWeakOp = 668-primOpTag MkWeakNoFinalizerOp = 669-primOpTag AddCFinalizerToWeakOp = 670-primOpTag DeRefWeakOp = 671-primOpTag FinalizeWeakOp = 672-primOpTag TouchOp = 673-primOpTag MakeStablePtrOp = 674-primOpTag DeRefStablePtrOp = 675-primOpTag EqStablePtrOp = 676-primOpTag MakeStableNameOp = 677-primOpTag StableNameToIntOp = 678-primOpTag CompactNewOp = 679-primOpTag CompactResizeOp = 680-primOpTag CompactContainsOp = 681-primOpTag CompactContainsAnyOp = 682-primOpTag CompactGetFirstBlockOp = 683-primOpTag CompactGetNextBlockOp = 684-primOpTag CompactAllocateBlockOp = 685-primOpTag CompactFixupPointersOp = 686-primOpTag CompactAdd = 687-primOpTag CompactAddWithSharing = 688-primOpTag CompactSize = 689-primOpTag ReallyUnsafePtrEqualityOp = 690-primOpTag ParOp = 691-primOpTag SparkOp = 692-primOpTag SeqOp = 693-primOpTag GetSparkOp = 694-primOpTag NumSparks = 695-primOpTag KeepAliveOp = 696-primOpTag DataToTagSmallOp = 697-primOpTag DataToTagLargeOp = 698-primOpTag TagToEnumOp = 699-primOpTag AddrToAnyOp = 700-primOpTag AnyToAddrOp = 701-primOpTag MkApUpd0_Op = 702-primOpTag NewBCOOp = 703-primOpTag UnpackClosureOp = 704-primOpTag ClosureSizeOp = 705-primOpTag GetApStackValOp = 706-primOpTag GetCCSOfOp = 707-primOpTag GetCurrentCCSOp = 708-primOpTag ClearCCSOp = 709-primOpTag WhereFromOp = 710-primOpTag TraceEventOp = 711-primOpTag TraceEventBinaryOp = 712-primOpTag TraceMarkerOp = 713-primOpTag SetThreadAllocationCounter = 714-primOpTag (VecBroadcastOp IntVec 16 W8) = 715-primOpTag (VecBroadcastOp IntVec 8 W16) = 716-primOpTag (VecBroadcastOp IntVec 4 W32) = 717-primOpTag (VecBroadcastOp IntVec 2 W64) = 718-primOpTag (VecBroadcastOp IntVec 32 W8) = 719-primOpTag (VecBroadcastOp IntVec 16 W16) = 720-primOpTag (VecBroadcastOp IntVec 8 W32) = 721-primOpTag (VecBroadcastOp IntVec 4 W64) = 722-primOpTag (VecBroadcastOp IntVec 64 W8) = 723-primOpTag (VecBroadcastOp IntVec 32 W16) = 724-primOpTag (VecBroadcastOp IntVec 16 W32) = 725-primOpTag (VecBroadcastOp IntVec 8 W64) = 726-primOpTag (VecBroadcastOp WordVec 16 W8) = 727-primOpTag (VecBroadcastOp WordVec 8 W16) = 728-primOpTag (VecBroadcastOp WordVec 4 W32) = 729-primOpTag (VecBroadcastOp WordVec 2 W64) = 730-primOpTag (VecBroadcastOp WordVec 32 W8) = 731-primOpTag (VecBroadcastOp WordVec 16 W16) = 732-primOpTag (VecBroadcastOp WordVec 8 W32) = 733-primOpTag (VecBroadcastOp WordVec 4 W64) = 734-primOpTag (VecBroadcastOp WordVec 64 W8) = 735-primOpTag (VecBroadcastOp WordVec 32 W16) = 736-primOpTag (VecBroadcastOp WordVec 16 W32) = 737-primOpTag (VecBroadcastOp WordVec 8 W64) = 738-primOpTag (VecBroadcastOp FloatVec 4 W32) = 739-primOpTag (VecBroadcastOp FloatVec 2 W64) = 740-primOpTag (VecBroadcastOp FloatVec 8 W32) = 741-primOpTag (VecBroadcastOp FloatVec 4 W64) = 742-primOpTag (VecBroadcastOp FloatVec 16 W32) = 743-primOpTag (VecBroadcastOp FloatVec 8 W64) = 744-primOpTag (VecPackOp IntVec 16 W8) = 745-primOpTag (VecPackOp IntVec 8 W16) = 746-primOpTag (VecPackOp IntVec 4 W32) = 747-primOpTag (VecPackOp IntVec 2 W64) = 748-primOpTag (VecPackOp IntVec 32 W8) = 749-primOpTag (VecPackOp IntVec 16 W16) = 750-primOpTag (VecPackOp IntVec 8 W32) = 751-primOpTag (VecPackOp IntVec 4 W64) = 752-primOpTag (VecPackOp IntVec 64 W8) = 753-primOpTag (VecPackOp IntVec 32 W16) = 754-primOpTag (VecPackOp IntVec 16 W32) = 755-primOpTag (VecPackOp IntVec 8 W64) = 756-primOpTag (VecPackOp WordVec 16 W8) = 757-primOpTag (VecPackOp WordVec 8 W16) = 758-primOpTag (VecPackOp WordVec 4 W32) = 759-primOpTag (VecPackOp WordVec 2 W64) = 760-primOpTag (VecPackOp WordVec 32 W8) = 761-primOpTag (VecPackOp WordVec 16 W16) = 762-primOpTag (VecPackOp WordVec 8 W32) = 763-primOpTag (VecPackOp WordVec 4 W64) = 764-primOpTag (VecPackOp WordVec 64 W8) = 765-primOpTag (VecPackOp WordVec 32 W16) = 766-primOpTag (VecPackOp WordVec 16 W32) = 767-primOpTag (VecPackOp WordVec 8 W64) = 768-primOpTag (VecPackOp FloatVec 4 W32) = 769-primOpTag (VecPackOp FloatVec 2 W64) = 770-primOpTag (VecPackOp FloatVec 8 W32) = 771-primOpTag (VecPackOp FloatVec 4 W64) = 772-primOpTag (VecPackOp FloatVec 16 W32) = 773-primOpTag (VecPackOp FloatVec 8 W64) = 774-primOpTag (VecUnpackOp IntVec 16 W8) = 775-primOpTag (VecUnpackOp IntVec 8 W16) = 776-primOpTag (VecUnpackOp IntVec 4 W32) = 777-primOpTag (VecUnpackOp IntVec 2 W64) = 778-primOpTag (VecUnpackOp IntVec 32 W8) = 779-primOpTag (VecUnpackOp IntVec 16 W16) = 780-primOpTag (VecUnpackOp IntVec 8 W32) = 781-primOpTag (VecUnpackOp IntVec 4 W64) = 782-primOpTag (VecUnpackOp IntVec 64 W8) = 783-primOpTag (VecUnpackOp IntVec 32 W16) = 784-primOpTag (VecUnpackOp IntVec 16 W32) = 785-primOpTag (VecUnpackOp IntVec 8 W64) = 786-primOpTag (VecUnpackOp WordVec 16 W8) = 787-primOpTag (VecUnpackOp WordVec 8 W16) = 788-primOpTag (VecUnpackOp WordVec 4 W32) = 789-primOpTag (VecUnpackOp WordVec 2 W64) = 790-primOpTag (VecUnpackOp WordVec 32 W8) = 791-primOpTag (VecUnpackOp WordVec 16 W16) = 792-primOpTag (VecUnpackOp WordVec 8 W32) = 793-primOpTag (VecUnpackOp WordVec 4 W64) = 794-primOpTag (VecUnpackOp WordVec 64 W8) = 795-primOpTag (VecUnpackOp WordVec 32 W16) = 796-primOpTag (VecUnpackOp WordVec 16 W32) = 797-primOpTag (VecUnpackOp WordVec 8 W64) = 798-primOpTag (VecUnpackOp FloatVec 4 W32) = 799-primOpTag (VecUnpackOp FloatVec 2 W64) = 800-primOpTag (VecUnpackOp FloatVec 8 W32) = 801-primOpTag (VecUnpackOp FloatVec 4 W64) = 802-primOpTag (VecUnpackOp FloatVec 16 W32) = 803-primOpTag (VecUnpackOp FloatVec 8 W64) = 804-primOpTag (VecInsertOp IntVec 16 W8) = 805-primOpTag (VecInsertOp IntVec 8 W16) = 806-primOpTag (VecInsertOp IntVec 4 W32) = 807-primOpTag (VecInsertOp IntVec 2 W64) = 808-primOpTag (VecInsertOp IntVec 32 W8) = 809-primOpTag (VecInsertOp IntVec 16 W16) = 810-primOpTag (VecInsertOp IntVec 8 W32) = 811-primOpTag (VecInsertOp IntVec 4 W64) = 812-primOpTag (VecInsertOp IntVec 64 W8) = 813-primOpTag (VecInsertOp IntVec 32 W16) = 814-primOpTag (VecInsertOp IntVec 16 W32) = 815-primOpTag (VecInsertOp IntVec 8 W64) = 816-primOpTag (VecInsertOp WordVec 16 W8) = 817-primOpTag (VecInsertOp WordVec 8 W16) = 818-primOpTag (VecInsertOp WordVec 4 W32) = 819-primOpTag (VecInsertOp WordVec 2 W64) = 820-primOpTag (VecInsertOp WordVec 32 W8) = 821-primOpTag (VecInsertOp WordVec 16 W16) = 822-primOpTag (VecInsertOp WordVec 8 W32) = 823-primOpTag (VecInsertOp WordVec 4 W64) = 824-primOpTag (VecInsertOp WordVec 64 W8) = 825-primOpTag (VecInsertOp WordVec 32 W16) = 826-primOpTag (VecInsertOp WordVec 16 W32) = 827-primOpTag (VecInsertOp WordVec 8 W64) = 828-primOpTag (VecInsertOp FloatVec 4 W32) = 829-primOpTag (VecInsertOp FloatVec 2 W64) = 830-primOpTag (VecInsertOp FloatVec 8 W32) = 831-primOpTag (VecInsertOp FloatVec 4 W64) = 832-primOpTag (VecInsertOp FloatVec 16 W32) = 833-primOpTag (VecInsertOp FloatVec 8 W64) = 834-primOpTag (VecAddOp IntVec 16 W8) = 835-primOpTag (VecAddOp IntVec 8 W16) = 836-primOpTag (VecAddOp IntVec 4 W32) = 837-primOpTag (VecAddOp IntVec 2 W64) = 838-primOpTag (VecAddOp IntVec 32 W8) = 839-primOpTag (VecAddOp IntVec 16 W16) = 840-primOpTag (VecAddOp IntVec 8 W32) = 841-primOpTag (VecAddOp IntVec 4 W64) = 842-primOpTag (VecAddOp IntVec 64 W8) = 843-primOpTag (VecAddOp IntVec 32 W16) = 844-primOpTag (VecAddOp IntVec 16 W32) = 845-primOpTag (VecAddOp IntVec 8 W64) = 846-primOpTag (VecAddOp WordVec 16 W8) = 847-primOpTag (VecAddOp WordVec 8 W16) = 848-primOpTag (VecAddOp WordVec 4 W32) = 849-primOpTag (VecAddOp WordVec 2 W64) = 850-primOpTag (VecAddOp WordVec 32 W8) = 851-primOpTag (VecAddOp WordVec 16 W16) = 852-primOpTag (VecAddOp WordVec 8 W32) = 853-primOpTag (VecAddOp WordVec 4 W64) = 854-primOpTag (VecAddOp WordVec 64 W8) = 855-primOpTag (VecAddOp WordVec 32 W16) = 856-primOpTag (VecAddOp WordVec 16 W32) = 857-primOpTag (VecAddOp WordVec 8 W64) = 858-primOpTag (VecAddOp FloatVec 4 W32) = 859-primOpTag (VecAddOp FloatVec 2 W64) = 860-primOpTag (VecAddOp FloatVec 8 W32) = 861-primOpTag (VecAddOp FloatVec 4 W64) = 862-primOpTag (VecAddOp FloatVec 16 W32) = 863-primOpTag (VecAddOp FloatVec 8 W64) = 864-primOpTag (VecSubOp IntVec 16 W8) = 865-primOpTag (VecSubOp IntVec 8 W16) = 866-primOpTag (VecSubOp IntVec 4 W32) = 867-primOpTag (VecSubOp IntVec 2 W64) = 868-primOpTag (VecSubOp IntVec 32 W8) = 869-primOpTag (VecSubOp IntVec 16 W16) = 870-primOpTag (VecSubOp IntVec 8 W32) = 871-primOpTag (VecSubOp IntVec 4 W64) = 872-primOpTag (VecSubOp IntVec 64 W8) = 873-primOpTag (VecSubOp IntVec 32 W16) = 874-primOpTag (VecSubOp IntVec 16 W32) = 875-primOpTag (VecSubOp IntVec 8 W64) = 876-primOpTag (VecSubOp WordVec 16 W8) = 877-primOpTag (VecSubOp WordVec 8 W16) = 878-primOpTag (VecSubOp WordVec 4 W32) = 879-primOpTag (VecSubOp WordVec 2 W64) = 880-primOpTag (VecSubOp WordVec 32 W8) = 881-primOpTag (VecSubOp WordVec 16 W16) = 882-primOpTag (VecSubOp WordVec 8 W32) = 883-primOpTag (VecSubOp WordVec 4 W64) = 884-primOpTag (VecSubOp WordVec 64 W8) = 885-primOpTag (VecSubOp WordVec 32 W16) = 886-primOpTag (VecSubOp WordVec 16 W32) = 887-primOpTag (VecSubOp WordVec 8 W64) = 888-primOpTag (VecSubOp FloatVec 4 W32) = 889-primOpTag (VecSubOp FloatVec 2 W64) = 890-primOpTag (VecSubOp FloatVec 8 W32) = 891-primOpTag (VecSubOp FloatVec 4 W64) = 892-primOpTag (VecSubOp FloatVec 16 W32) = 893-primOpTag (VecSubOp FloatVec 8 W64) = 894-primOpTag (VecMulOp IntVec 16 W8) = 895-primOpTag (VecMulOp IntVec 8 W16) = 896-primOpTag (VecMulOp IntVec 4 W32) = 897-primOpTag (VecMulOp IntVec 2 W64) = 898-primOpTag (VecMulOp IntVec 32 W8) = 899-primOpTag (VecMulOp IntVec 16 W16) = 900-primOpTag (VecMulOp IntVec 8 W32) = 901-primOpTag (VecMulOp IntVec 4 W64) = 902-primOpTag (VecMulOp IntVec 64 W8) = 903-primOpTag (VecMulOp IntVec 32 W16) = 904-primOpTag (VecMulOp IntVec 16 W32) = 905-primOpTag (VecMulOp IntVec 8 W64) = 906-primOpTag (VecMulOp WordVec 16 W8) = 907-primOpTag (VecMulOp WordVec 8 W16) = 908-primOpTag (VecMulOp WordVec 4 W32) = 909-primOpTag (VecMulOp WordVec 2 W64) = 910-primOpTag (VecMulOp WordVec 32 W8) = 911-primOpTag (VecMulOp WordVec 16 W16) = 912-primOpTag (VecMulOp WordVec 8 W32) = 913-primOpTag (VecMulOp WordVec 4 W64) = 914-primOpTag (VecMulOp WordVec 64 W8) = 915-primOpTag (VecMulOp WordVec 32 W16) = 916-primOpTag (VecMulOp WordVec 16 W32) = 917-primOpTag (VecMulOp WordVec 8 W64) = 918-primOpTag (VecMulOp FloatVec 4 W32) = 919-primOpTag (VecMulOp FloatVec 2 W64) = 920-primOpTag (VecMulOp FloatVec 8 W32) = 921-primOpTag (VecMulOp FloatVec 4 W64) = 922-primOpTag (VecMulOp FloatVec 16 W32) = 923-primOpTag (VecMulOp FloatVec 8 W64) = 924-primOpTag (VecDivOp FloatVec 4 W32) = 925-primOpTag (VecDivOp FloatVec 2 W64) = 926-primOpTag (VecDivOp FloatVec 8 W32) = 927-primOpTag (VecDivOp FloatVec 4 W64) = 928-primOpTag (VecDivOp FloatVec 16 W32) = 929-primOpTag (VecDivOp FloatVec 8 W64) = 930-primOpTag (VecQuotOp IntVec 16 W8) = 931-primOpTag (VecQuotOp IntVec 8 W16) = 932-primOpTag (VecQuotOp IntVec 4 W32) = 933-primOpTag (VecQuotOp IntVec 2 W64) = 934-primOpTag (VecQuotOp IntVec 32 W8) = 935-primOpTag (VecQuotOp IntVec 16 W16) = 936-primOpTag (VecQuotOp IntVec 8 W32) = 937-primOpTag (VecQuotOp IntVec 4 W64) = 938-primOpTag (VecQuotOp IntVec 64 W8) = 939-primOpTag (VecQuotOp IntVec 32 W16) = 940-primOpTag (VecQuotOp IntVec 16 W32) = 941-primOpTag (VecQuotOp IntVec 8 W64) = 942-primOpTag (VecQuotOp WordVec 16 W8) = 943-primOpTag (VecQuotOp WordVec 8 W16) = 944-primOpTag (VecQuotOp WordVec 4 W32) = 945-primOpTag (VecQuotOp WordVec 2 W64) = 946-primOpTag (VecQuotOp WordVec 32 W8) = 947-primOpTag (VecQuotOp WordVec 16 W16) = 948-primOpTag (VecQuotOp WordVec 8 W32) = 949-primOpTag (VecQuotOp WordVec 4 W64) = 950-primOpTag (VecQuotOp WordVec 64 W8) = 951-primOpTag (VecQuotOp WordVec 32 W16) = 952-primOpTag (VecQuotOp WordVec 16 W32) = 953-primOpTag (VecQuotOp WordVec 8 W64) = 954-primOpTag (VecRemOp IntVec 16 W8) = 955-primOpTag (VecRemOp IntVec 8 W16) = 956-primOpTag (VecRemOp IntVec 4 W32) = 957-primOpTag (VecRemOp IntVec 2 W64) = 958-primOpTag (VecRemOp IntVec 32 W8) = 959-primOpTag (VecRemOp IntVec 16 W16) = 960-primOpTag (VecRemOp IntVec 8 W32) = 961-primOpTag (VecRemOp IntVec 4 W64) = 962-primOpTag (VecRemOp IntVec 64 W8) = 963-primOpTag (VecRemOp IntVec 32 W16) = 964-primOpTag (VecRemOp IntVec 16 W32) = 965-primOpTag (VecRemOp IntVec 8 W64) = 966-primOpTag (VecRemOp WordVec 16 W8) = 967-primOpTag (VecRemOp WordVec 8 W16) = 968-primOpTag (VecRemOp WordVec 4 W32) = 969-primOpTag (VecRemOp WordVec 2 W64) = 970-primOpTag (VecRemOp WordVec 32 W8) = 971-primOpTag (VecRemOp WordVec 16 W16) = 972-primOpTag (VecRemOp WordVec 8 W32) = 973-primOpTag (VecRemOp WordVec 4 W64) = 974-primOpTag (VecRemOp WordVec 64 W8) = 975-primOpTag (VecRemOp WordVec 32 W16) = 976-primOpTag (VecRemOp WordVec 16 W32) = 977-primOpTag (VecRemOp WordVec 8 W64) = 978-primOpTag (VecNegOp IntVec 16 W8) = 979-primOpTag (VecNegOp IntVec 8 W16) = 980-primOpTag (VecNegOp IntVec 4 W32) = 981-primOpTag (VecNegOp IntVec 2 W64) = 982-primOpTag (VecNegOp IntVec 32 W8) = 983-primOpTag (VecNegOp IntVec 16 W16) = 984-primOpTag (VecNegOp IntVec 8 W32) = 985-primOpTag (VecNegOp IntVec 4 W64) = 986-primOpTag (VecNegOp IntVec 64 W8) = 987-primOpTag (VecNegOp IntVec 32 W16) = 988-primOpTag (VecNegOp IntVec 16 W32) = 989-primOpTag (VecNegOp IntVec 8 W64) = 990-primOpTag (VecNegOp FloatVec 4 W32) = 991-primOpTag (VecNegOp FloatVec 2 W64) = 992-primOpTag (VecNegOp FloatVec 8 W32) = 993-primOpTag (VecNegOp FloatVec 4 W64) = 994-primOpTag (VecNegOp FloatVec 16 W32) = 995-primOpTag (VecNegOp FloatVec 8 W64) = 996-primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 997-primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 998-primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 999-primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 1000-primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 1001-primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 1002-primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 1003-primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 1004-primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 1005-primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 1006-primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 1007-primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 1008-primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 1009-primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 1010-primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 1011-primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 1012-primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 1013-primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 1014-primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 1015-primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 1016-primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 1017-primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 1018-primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 1019-primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 1020-primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 1021-primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 1022-primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 1023-primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 1024-primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 1025-primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 1026-primOpTag (VecReadByteArrayOp IntVec 16 W8) = 1027-primOpTag (VecReadByteArrayOp IntVec 8 W16) = 1028-primOpTag (VecReadByteArrayOp IntVec 4 W32) = 1029-primOpTag (VecReadByteArrayOp IntVec 2 W64) = 1030-primOpTag (VecReadByteArrayOp IntVec 32 W8) = 1031-primOpTag (VecReadByteArrayOp IntVec 16 W16) = 1032-primOpTag (VecReadByteArrayOp IntVec 8 W32) = 1033-primOpTag (VecReadByteArrayOp IntVec 4 W64) = 1034-primOpTag (VecReadByteArrayOp IntVec 64 W8) = 1035-primOpTag (VecReadByteArrayOp IntVec 32 W16) = 1036-primOpTag (VecReadByteArrayOp IntVec 16 W32) = 1037-primOpTag (VecReadByteArrayOp IntVec 8 W64) = 1038-primOpTag (VecReadByteArrayOp WordVec 16 W8) = 1039-primOpTag (VecReadByteArrayOp WordVec 8 W16) = 1040-primOpTag (VecReadByteArrayOp WordVec 4 W32) = 1041-primOpTag (VecReadByteArrayOp WordVec 2 W64) = 1042-primOpTag (VecReadByteArrayOp WordVec 32 W8) = 1043-primOpTag (VecReadByteArrayOp WordVec 16 W16) = 1044-primOpTag (VecReadByteArrayOp WordVec 8 W32) = 1045-primOpTag (VecReadByteArrayOp WordVec 4 W64) = 1046-primOpTag (VecReadByteArrayOp WordVec 64 W8) = 1047-primOpTag (VecReadByteArrayOp WordVec 32 W16) = 1048-primOpTag (VecReadByteArrayOp WordVec 16 W32) = 1049-primOpTag (VecReadByteArrayOp WordVec 8 W64) = 1050-primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 1051-primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 1052-primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 1053-primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 1054-primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 1055-primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 1056-primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 1057-primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 1058-primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 1059-primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 1060-primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 1061-primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 1062-primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 1063-primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 1064-primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 1065-primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 1066-primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1067-primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1068-primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1069-primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1070-primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1071-primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1072-primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1073-primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1074-primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1075-primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1076-primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1077-primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1078-primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1079-primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1080-primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1081-primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1082-primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1083-primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1084-primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1085-primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1086-primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1087-primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1088-primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1089-primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1090-primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1091-primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1092-primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1093-primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1094-primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1095-primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1096-primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1097-primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1098-primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1099-primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1100-primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1101-primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1102-primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1103-primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1104-primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1105-primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1106-primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1107-primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1108-primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1109-primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1110-primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1111-primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1112-primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1113-primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1114-primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1115-primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1116-primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1117-primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1118-primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1119-primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1120-primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1121-primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1122-primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1123-primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1124-primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1125-primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1126-primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1127-primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1128-primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1129-primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1130-primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1131-primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1132-primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1133-primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1134-primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1135-primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1136-primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1137-primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1138-primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1139-primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1140-primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1141-primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1142-primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1143-primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1144-primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1145-primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1146-primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1147-primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1148-primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1149-primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1150-primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1151-primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1152-primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1153-primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1154-primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1155-primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1156-primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1157-primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1158-primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1159-primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1160-primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1161-primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1162-primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1163-primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1164-primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1165-primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1166-primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1167-primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1168-primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1169-primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1170-primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1171-primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1172-primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1173-primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1174-primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1175-primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1176-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1177-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1178-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1179-primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1180-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1181-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1182-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1183-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1184-primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1185-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1186-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1187-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1188-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1189-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1190-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1191-primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1192-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1193-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1194-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1195-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1196-primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1197-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1198-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1199-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1200-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1201-primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1202-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1203-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1204-primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1205-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1206-primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1207-primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1208-primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1209-primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1210-primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1211-primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1212-primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1213-primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1214-primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1215-primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1216-primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1217-primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1218-primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1219-primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1220-primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1221-primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1222-primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1223-primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1224-primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1225-primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1226-primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1227-primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1228-primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1229-primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1230-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1231-primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1232-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1233-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1234-primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1235-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1236-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1237-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1238-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1239-primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1240-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1241-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1242-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1243-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1244-primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1245-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1246-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1247-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1248-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1249-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1250-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1251-primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1252-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1253-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1254-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1255-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1256-primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1257-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1258-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1259-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1260-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1261-primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1262-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1263-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1264-primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1265-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1266-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1267-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1268-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1269-primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1270-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1271-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1272-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1273-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1274-primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1275-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1276-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1277-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1278-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1279-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1280-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1281-primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1282-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1283-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1284-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1285-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1286-primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1287-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1288-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1289-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1290-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1291-primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1292-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1293-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1294-primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1295-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1296-primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1297-primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1298-primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1299-primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1300-primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1301-primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1302-primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1303-primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1304-primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1305-primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1306-primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1307-primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1308-primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1309-primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1310-primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1311-primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1312-primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1313-primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1314-primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1315-primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1316-primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1317-primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1318-primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1319-primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1320-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1321-primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1322-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1323-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1324-primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1325-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1326-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1327-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1328-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1329-primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1330-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1331-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1332-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1333-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1334-primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1335-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1336-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1337-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1338-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1339-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1340-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1341-primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1342-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1343-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1344-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1345-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1346-primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1347-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1348-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1349-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1350-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1351-primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1352-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1353-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1354-primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1355-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1356-primOpTag PrefetchByteArrayOp3 = 1357-primOpTag PrefetchMutableByteArrayOp3 = 1358-primOpTag PrefetchAddrOp3 = 1359-primOpTag PrefetchValueOp3 = 1360-primOpTag PrefetchByteArrayOp2 = 1361-primOpTag PrefetchMutableByteArrayOp2 = 1362-primOpTag PrefetchAddrOp2 = 1363-primOpTag PrefetchValueOp2 = 1364-primOpTag PrefetchByteArrayOp1 = 1365-primOpTag PrefetchMutableByteArrayOp1 = 1366-primOpTag PrefetchAddrOp1 = 1367-primOpTag PrefetchValueOp1 = 1368-primOpTag PrefetchByteArrayOp0 = 1369-primOpTag PrefetchMutableByteArrayOp0 = 1370-primOpTag PrefetchAddrOp0 = 1371-primOpTag PrefetchValueOp0 = 1372+maxPrimOpTag = 1491+primOpTag :: PrimOp -> Int+primOpTag CharGtOp = 0+primOpTag CharGeOp = 1+primOpTag CharEqOp = 2+primOpTag CharNeOp = 3+primOpTag CharLtOp = 4+primOpTag CharLeOp = 5+primOpTag OrdOp = 6+primOpTag Int8ToIntOp = 7+primOpTag IntToInt8Op = 8+primOpTag Int8NegOp = 9+primOpTag Int8AddOp = 10+primOpTag Int8SubOp = 11+primOpTag Int8MulOp = 12+primOpTag Int8QuotOp = 13+primOpTag Int8RemOp = 14+primOpTag Int8QuotRemOp = 15+primOpTag Int8SllOp = 16+primOpTag Int8SraOp = 17+primOpTag Int8SrlOp = 18+primOpTag Int8ToWord8Op = 19+primOpTag Int8EqOp = 20+primOpTag Int8GeOp = 21+primOpTag Int8GtOp = 22+primOpTag Int8LeOp = 23+primOpTag Int8LtOp = 24+primOpTag Int8NeOp = 25+primOpTag Word8ToWordOp = 26+primOpTag WordToWord8Op = 27+primOpTag Word8AddOp = 28+primOpTag Word8SubOp = 29+primOpTag Word8MulOp = 30+primOpTag Word8QuotOp = 31+primOpTag Word8RemOp = 32+primOpTag Word8QuotRemOp = 33+primOpTag Word8AndOp = 34+primOpTag Word8OrOp = 35+primOpTag Word8XorOp = 36+primOpTag Word8NotOp = 37+primOpTag Word8SllOp = 38+primOpTag Word8SrlOp = 39+primOpTag Word8ToInt8Op = 40+primOpTag Word8EqOp = 41+primOpTag Word8GeOp = 42+primOpTag Word8GtOp = 43+primOpTag Word8LeOp = 44+primOpTag Word8LtOp = 45+primOpTag Word8NeOp = 46+primOpTag Int16ToIntOp = 47+primOpTag IntToInt16Op = 48+primOpTag Int16NegOp = 49+primOpTag Int16AddOp = 50+primOpTag Int16SubOp = 51+primOpTag Int16MulOp = 52+primOpTag Int16QuotOp = 53+primOpTag Int16RemOp = 54+primOpTag Int16QuotRemOp = 55+primOpTag Int16SllOp = 56+primOpTag Int16SraOp = 57+primOpTag Int16SrlOp = 58+primOpTag Int16ToWord16Op = 59+primOpTag Int16EqOp = 60+primOpTag Int16GeOp = 61+primOpTag Int16GtOp = 62+primOpTag Int16LeOp = 63+primOpTag Int16LtOp = 64+primOpTag Int16NeOp = 65+primOpTag Word16ToWordOp = 66+primOpTag WordToWord16Op = 67+primOpTag Word16AddOp = 68+primOpTag Word16SubOp = 69+primOpTag Word16MulOp = 70+primOpTag Word16QuotOp = 71+primOpTag Word16RemOp = 72+primOpTag Word16QuotRemOp = 73+primOpTag Word16AndOp = 74+primOpTag Word16OrOp = 75+primOpTag Word16XorOp = 76+primOpTag Word16NotOp = 77+primOpTag Word16SllOp = 78+primOpTag Word16SrlOp = 79+primOpTag Word16ToInt16Op = 80+primOpTag Word16EqOp = 81+primOpTag Word16GeOp = 82+primOpTag Word16GtOp = 83+primOpTag Word16LeOp = 84+primOpTag Word16LtOp = 85+primOpTag Word16NeOp = 86+primOpTag Int32ToIntOp = 87+primOpTag IntToInt32Op = 88+primOpTag Int32NegOp = 89+primOpTag Int32AddOp = 90+primOpTag Int32SubOp = 91+primOpTag Int32MulOp = 92+primOpTag Int32QuotOp = 93+primOpTag Int32RemOp = 94+primOpTag Int32QuotRemOp = 95+primOpTag Int32SllOp = 96+primOpTag Int32SraOp = 97+primOpTag Int32SrlOp = 98+primOpTag Int32ToWord32Op = 99+primOpTag Int32EqOp = 100+primOpTag Int32GeOp = 101+primOpTag Int32GtOp = 102+primOpTag Int32LeOp = 103+primOpTag Int32LtOp = 104+primOpTag Int32NeOp = 105+primOpTag Word32ToWordOp = 106+primOpTag WordToWord32Op = 107+primOpTag Word32AddOp = 108+primOpTag Word32SubOp = 109+primOpTag Word32MulOp = 110+primOpTag Word32QuotOp = 111+primOpTag Word32RemOp = 112+primOpTag Word32QuotRemOp = 113+primOpTag Word32AndOp = 114+primOpTag Word32OrOp = 115+primOpTag Word32XorOp = 116+primOpTag Word32NotOp = 117+primOpTag Word32SllOp = 118+primOpTag Word32SrlOp = 119+primOpTag Word32ToInt32Op = 120+primOpTag Word32EqOp = 121+primOpTag Word32GeOp = 122+primOpTag Word32GtOp = 123+primOpTag Word32LeOp = 124+primOpTag Word32LtOp = 125+primOpTag Word32NeOp = 126+primOpTag Int64ToIntOp = 127+primOpTag IntToInt64Op = 128+primOpTag Int64NegOp = 129+primOpTag Int64AddOp = 130+primOpTag Int64SubOp = 131+primOpTag Int64MulOp = 132+primOpTag Int64QuotOp = 133+primOpTag Int64RemOp = 134+primOpTag Int64SllOp = 135+primOpTag Int64SraOp = 136+primOpTag Int64SrlOp = 137+primOpTag Int64ToWord64Op = 138+primOpTag Int64EqOp = 139+primOpTag Int64GeOp = 140+primOpTag Int64GtOp = 141+primOpTag Int64LeOp = 142+primOpTag Int64LtOp = 143+primOpTag Int64NeOp = 144+primOpTag Word64ToWordOp = 145+primOpTag WordToWord64Op = 146+primOpTag Word64AddOp = 147+primOpTag Word64SubOp = 148+primOpTag Word64MulOp = 149+primOpTag Word64QuotOp = 150+primOpTag Word64RemOp = 151+primOpTag Word64AndOp = 152+primOpTag Word64OrOp = 153+primOpTag Word64XorOp = 154+primOpTag Word64NotOp = 155+primOpTag Word64SllOp = 156+primOpTag Word64SrlOp = 157+primOpTag Word64ToInt64Op = 158+primOpTag Word64EqOp = 159+primOpTag Word64GeOp = 160+primOpTag Word64GtOp = 161+primOpTag Word64LeOp = 162+primOpTag Word64LtOp = 163+primOpTag Word64NeOp = 164+primOpTag IntAddOp = 165+primOpTag IntSubOp = 166+primOpTag IntMulOp = 167+primOpTag IntMul2Op = 168+primOpTag IntMulMayOfloOp = 169+primOpTag IntQuotOp = 170+primOpTag IntRemOp = 171+primOpTag IntQuotRemOp = 172+primOpTag IntAndOp = 173+primOpTag IntOrOp = 174+primOpTag IntXorOp = 175+primOpTag IntNotOp = 176+primOpTag IntNegOp = 177+primOpTag IntAddCOp = 178+primOpTag IntSubCOp = 179+primOpTag IntGtOp = 180+primOpTag IntGeOp = 181+primOpTag IntEqOp = 182+primOpTag IntNeOp = 183+primOpTag IntLtOp = 184+primOpTag IntLeOp = 185+primOpTag ChrOp = 186+primOpTag IntToWordOp = 187+primOpTag IntToFloatOp = 188+primOpTag IntToDoubleOp = 189+primOpTag WordToFloatOp = 190+primOpTag WordToDoubleOp = 191+primOpTag IntSllOp = 192+primOpTag IntSraOp = 193+primOpTag IntSrlOp = 194+primOpTag WordAddOp = 195+primOpTag WordAddCOp = 196+primOpTag WordSubCOp = 197+primOpTag WordAdd2Op = 198+primOpTag WordSubOp = 199+primOpTag WordMulOp = 200+primOpTag WordMul2Op = 201+primOpTag WordQuotOp = 202+primOpTag WordRemOp = 203+primOpTag WordQuotRemOp = 204+primOpTag WordQuotRem2Op = 205+primOpTag WordAndOp = 206+primOpTag WordOrOp = 207+primOpTag WordXorOp = 208+primOpTag WordNotOp = 209+primOpTag WordSllOp = 210+primOpTag WordSrlOp = 211+primOpTag WordToIntOp = 212+primOpTag WordGtOp = 213+primOpTag WordGeOp = 214+primOpTag WordEqOp = 215+primOpTag WordNeOp = 216+primOpTag WordLtOp = 217+primOpTag WordLeOp = 218+primOpTag PopCnt8Op = 219+primOpTag PopCnt16Op = 220+primOpTag PopCnt32Op = 221+primOpTag PopCnt64Op = 222+primOpTag PopCntOp = 223+primOpTag Pdep8Op = 224+primOpTag Pdep16Op = 225+primOpTag Pdep32Op = 226+primOpTag Pdep64Op = 227+primOpTag PdepOp = 228+primOpTag Pext8Op = 229+primOpTag Pext16Op = 230+primOpTag Pext32Op = 231+primOpTag Pext64Op = 232+primOpTag PextOp = 233+primOpTag Clz8Op = 234+primOpTag Clz16Op = 235+primOpTag Clz32Op = 236+primOpTag Clz64Op = 237+primOpTag ClzOp = 238+primOpTag Ctz8Op = 239+primOpTag Ctz16Op = 240+primOpTag Ctz32Op = 241+primOpTag Ctz64Op = 242+primOpTag CtzOp = 243+primOpTag BSwap16Op = 244+primOpTag BSwap32Op = 245+primOpTag BSwap64Op = 246+primOpTag BSwapOp = 247+primOpTag BRev8Op = 248+primOpTag BRev16Op = 249+primOpTag BRev32Op = 250+primOpTag BRev64Op = 251+primOpTag BRevOp = 252+primOpTag Narrow8IntOp = 253+primOpTag Narrow16IntOp = 254+primOpTag Narrow32IntOp = 255+primOpTag Narrow8WordOp = 256+primOpTag Narrow16WordOp = 257+primOpTag Narrow32WordOp = 258+primOpTag DoubleGtOp = 259+primOpTag DoubleGeOp = 260+primOpTag DoubleEqOp = 261+primOpTag DoubleNeOp = 262+primOpTag DoubleLtOp = 263+primOpTag DoubleLeOp = 264+primOpTag DoubleMinOp = 265+primOpTag DoubleMaxOp = 266+primOpTag DoubleAddOp = 267+primOpTag DoubleSubOp = 268+primOpTag DoubleMulOp = 269+primOpTag DoubleDivOp = 270+primOpTag DoubleNegOp = 271+primOpTag DoubleFabsOp = 272+primOpTag DoubleToIntOp = 273+primOpTag DoubleToFloatOp = 274+primOpTag DoubleExpOp = 275+primOpTag DoubleExpM1Op = 276+primOpTag DoubleLogOp = 277+primOpTag DoubleLog1POp = 278+primOpTag DoubleSqrtOp = 279+primOpTag DoubleSinOp = 280+primOpTag DoubleCosOp = 281+primOpTag DoubleTanOp = 282+primOpTag DoubleAsinOp = 283+primOpTag DoubleAcosOp = 284+primOpTag DoubleAtanOp = 285+primOpTag DoubleSinhOp = 286+primOpTag DoubleCoshOp = 287+primOpTag DoubleTanhOp = 288+primOpTag DoubleAsinhOp = 289+primOpTag DoubleAcoshOp = 290+primOpTag DoubleAtanhOp = 291+primOpTag DoublePowerOp = 292+primOpTag DoubleDecode_2IntOp = 293+primOpTag DoubleDecode_Int64Op = 294+primOpTag CastDoubleToWord64Op = 295+primOpTag CastWord64ToDoubleOp = 296+primOpTag FloatGtOp = 297+primOpTag FloatGeOp = 298+primOpTag FloatEqOp = 299+primOpTag FloatNeOp = 300+primOpTag FloatLtOp = 301+primOpTag FloatLeOp = 302+primOpTag FloatMinOp = 303+primOpTag FloatMaxOp = 304+primOpTag FloatAddOp = 305+primOpTag FloatSubOp = 306+primOpTag FloatMulOp = 307+primOpTag FloatDivOp = 308+primOpTag FloatNegOp = 309+primOpTag FloatFabsOp = 310+primOpTag FloatToIntOp = 311+primOpTag FloatExpOp = 312+primOpTag FloatExpM1Op = 313+primOpTag FloatLogOp = 314+primOpTag FloatLog1POp = 315+primOpTag FloatSqrtOp = 316+primOpTag FloatSinOp = 317+primOpTag FloatCosOp = 318+primOpTag FloatTanOp = 319+primOpTag FloatAsinOp = 320+primOpTag FloatAcosOp = 321+primOpTag FloatAtanOp = 322+primOpTag FloatSinhOp = 323+primOpTag FloatCoshOp = 324+primOpTag FloatTanhOp = 325+primOpTag FloatAsinhOp = 326+primOpTag FloatAcoshOp = 327+primOpTag FloatAtanhOp = 328+primOpTag FloatPowerOp = 329+primOpTag FloatToDoubleOp = 330+primOpTag FloatDecode_IntOp = 331+primOpTag CastFloatToWord32Op = 332+primOpTag CastWord32ToFloatOp = 333+primOpTag FloatFMAdd = 334+primOpTag FloatFMSub = 335+primOpTag FloatFNMAdd = 336+primOpTag FloatFNMSub = 337+primOpTag DoubleFMAdd = 338+primOpTag DoubleFMSub = 339+primOpTag DoubleFNMAdd = 340+primOpTag DoubleFNMSub = 341+primOpTag NewArrayOp = 342+primOpTag ReadArrayOp = 343+primOpTag WriteArrayOp = 344+primOpTag SizeofArrayOp = 345+primOpTag SizeofMutableArrayOp = 346+primOpTag IndexArrayOp = 347+primOpTag UnsafeFreezeArrayOp = 348+primOpTag UnsafeThawArrayOp = 349+primOpTag CopyArrayOp = 350+primOpTag CopyMutableArrayOp = 351+primOpTag CloneArrayOp = 352+primOpTag CloneMutableArrayOp = 353+primOpTag FreezeArrayOp = 354+primOpTag ThawArrayOp = 355+primOpTag CasArrayOp = 356+primOpTag NewSmallArrayOp = 357+primOpTag ShrinkSmallMutableArrayOp_Char = 358+primOpTag ReadSmallArrayOp = 359+primOpTag WriteSmallArrayOp = 360+primOpTag SizeofSmallArrayOp = 361+primOpTag SizeofSmallMutableArrayOp = 362+primOpTag GetSizeofSmallMutableArrayOp = 363+primOpTag IndexSmallArrayOp = 364+primOpTag UnsafeFreezeSmallArrayOp = 365+primOpTag UnsafeThawSmallArrayOp = 366+primOpTag CopySmallArrayOp = 367+primOpTag CopySmallMutableArrayOp = 368+primOpTag CloneSmallArrayOp = 369+primOpTag CloneSmallMutableArrayOp = 370+primOpTag FreezeSmallArrayOp = 371+primOpTag ThawSmallArrayOp = 372+primOpTag CasSmallArrayOp = 373+primOpTag NewByteArrayOp_Char = 374+primOpTag NewPinnedByteArrayOp_Char = 375+primOpTag NewAlignedPinnedByteArrayOp_Char = 376+primOpTag MutableByteArrayIsPinnedOp = 377+primOpTag ByteArrayIsPinnedOp = 378+primOpTag ByteArrayIsWeaklyPinnedOp = 379+primOpTag MutableByteArrayIsWeaklyPinnedOp = 380+primOpTag ByteArrayContents_Char = 381+primOpTag MutableByteArrayContents_Char = 382+primOpTag ShrinkMutableByteArrayOp_Char = 383+primOpTag ResizeMutableByteArrayOp_Char = 384+primOpTag UnsafeFreezeByteArrayOp = 385+primOpTag UnsafeThawByteArrayOp = 386+primOpTag SizeofByteArrayOp = 387+primOpTag SizeofMutableByteArrayOp = 388+primOpTag GetSizeofMutableByteArrayOp = 389+primOpTag IndexByteArrayOp_Char = 390+primOpTag IndexByteArrayOp_WideChar = 391+primOpTag IndexByteArrayOp_Int = 392+primOpTag IndexByteArrayOp_Word = 393+primOpTag IndexByteArrayOp_Addr = 394+primOpTag IndexByteArrayOp_Float = 395+primOpTag IndexByteArrayOp_Double = 396+primOpTag IndexByteArrayOp_StablePtr = 397+primOpTag IndexByteArrayOp_Int8 = 398+primOpTag IndexByteArrayOp_Word8 = 399+primOpTag IndexByteArrayOp_Int16 = 400+primOpTag IndexByteArrayOp_Word16 = 401+primOpTag IndexByteArrayOp_Int32 = 402+primOpTag IndexByteArrayOp_Word32 = 403+primOpTag IndexByteArrayOp_Int64 = 404+primOpTag IndexByteArrayOp_Word64 = 405+primOpTag IndexByteArrayOp_Word8AsChar = 406+primOpTag IndexByteArrayOp_Word8AsWideChar = 407+primOpTag IndexByteArrayOp_Word8AsInt = 408+primOpTag IndexByteArrayOp_Word8AsWord = 409+primOpTag IndexByteArrayOp_Word8AsAddr = 410+primOpTag IndexByteArrayOp_Word8AsFloat = 411+primOpTag IndexByteArrayOp_Word8AsDouble = 412+primOpTag IndexByteArrayOp_Word8AsStablePtr = 413+primOpTag IndexByteArrayOp_Word8AsInt16 = 414+primOpTag IndexByteArrayOp_Word8AsWord16 = 415+primOpTag IndexByteArrayOp_Word8AsInt32 = 416+primOpTag IndexByteArrayOp_Word8AsWord32 = 417+primOpTag IndexByteArrayOp_Word8AsInt64 = 418+primOpTag IndexByteArrayOp_Word8AsWord64 = 419+primOpTag ReadByteArrayOp_Char = 420+primOpTag ReadByteArrayOp_WideChar = 421+primOpTag ReadByteArrayOp_Int = 422+primOpTag ReadByteArrayOp_Word = 423+primOpTag ReadByteArrayOp_Addr = 424+primOpTag ReadByteArrayOp_Float = 425+primOpTag ReadByteArrayOp_Double = 426+primOpTag ReadByteArrayOp_StablePtr = 427+primOpTag ReadByteArrayOp_Int8 = 428+primOpTag ReadByteArrayOp_Word8 = 429+primOpTag ReadByteArrayOp_Int16 = 430+primOpTag ReadByteArrayOp_Word16 = 431+primOpTag ReadByteArrayOp_Int32 = 432+primOpTag ReadByteArrayOp_Word32 = 433+primOpTag ReadByteArrayOp_Int64 = 434+primOpTag ReadByteArrayOp_Word64 = 435+primOpTag ReadByteArrayOp_Word8AsChar = 436+primOpTag ReadByteArrayOp_Word8AsWideChar = 437+primOpTag ReadByteArrayOp_Word8AsInt = 438+primOpTag ReadByteArrayOp_Word8AsWord = 439+primOpTag ReadByteArrayOp_Word8AsAddr = 440+primOpTag ReadByteArrayOp_Word8AsFloat = 441+primOpTag ReadByteArrayOp_Word8AsDouble = 442+primOpTag ReadByteArrayOp_Word8AsStablePtr = 443+primOpTag ReadByteArrayOp_Word8AsInt16 = 444+primOpTag ReadByteArrayOp_Word8AsWord16 = 445+primOpTag ReadByteArrayOp_Word8AsInt32 = 446+primOpTag ReadByteArrayOp_Word8AsWord32 = 447+primOpTag ReadByteArrayOp_Word8AsInt64 = 448+primOpTag ReadByteArrayOp_Word8AsWord64 = 449+primOpTag WriteByteArrayOp_Char = 450+primOpTag WriteByteArrayOp_WideChar = 451+primOpTag WriteByteArrayOp_Int = 452+primOpTag WriteByteArrayOp_Word = 453+primOpTag WriteByteArrayOp_Addr = 454+primOpTag WriteByteArrayOp_Float = 455+primOpTag WriteByteArrayOp_Double = 456+primOpTag WriteByteArrayOp_StablePtr = 457+primOpTag WriteByteArrayOp_Int8 = 458+primOpTag WriteByteArrayOp_Word8 = 459+primOpTag WriteByteArrayOp_Int16 = 460+primOpTag WriteByteArrayOp_Word16 = 461+primOpTag WriteByteArrayOp_Int32 = 462+primOpTag WriteByteArrayOp_Word32 = 463+primOpTag WriteByteArrayOp_Int64 = 464+primOpTag WriteByteArrayOp_Word64 = 465+primOpTag WriteByteArrayOp_Word8AsChar = 466+primOpTag WriteByteArrayOp_Word8AsWideChar = 467+primOpTag WriteByteArrayOp_Word8AsInt = 468+primOpTag WriteByteArrayOp_Word8AsWord = 469+primOpTag WriteByteArrayOp_Word8AsAddr = 470+primOpTag WriteByteArrayOp_Word8AsFloat = 471+primOpTag WriteByteArrayOp_Word8AsDouble = 472+primOpTag WriteByteArrayOp_Word8AsStablePtr = 473+primOpTag WriteByteArrayOp_Word8AsInt16 = 474+primOpTag WriteByteArrayOp_Word8AsWord16 = 475+primOpTag WriteByteArrayOp_Word8AsInt32 = 476+primOpTag WriteByteArrayOp_Word8AsWord32 = 477+primOpTag WriteByteArrayOp_Word8AsInt64 = 478+primOpTag WriteByteArrayOp_Word8AsWord64 = 479+primOpTag CompareByteArraysOp = 480+primOpTag CopyByteArrayOp = 481+primOpTag CopyMutableByteArrayOp = 482+primOpTag CopyMutableByteArrayNonOverlappingOp = 483+primOpTag CopyByteArrayToAddrOp = 484+primOpTag CopyMutableByteArrayToAddrOp = 485+primOpTag CopyAddrToByteArrayOp = 486+primOpTag CopyAddrToAddrOp = 487+primOpTag CopyAddrToAddrNonOverlappingOp = 488+primOpTag SetByteArrayOp = 489+primOpTag SetAddrRangeOp = 490+primOpTag AtomicReadByteArrayOp_Int = 491+primOpTag AtomicWriteByteArrayOp_Int = 492+primOpTag CasByteArrayOp_Int = 493+primOpTag CasByteArrayOp_Int8 = 494+primOpTag CasByteArrayOp_Int16 = 495+primOpTag CasByteArrayOp_Int32 = 496+primOpTag CasByteArrayOp_Int64 = 497+primOpTag FetchAddByteArrayOp_Int = 498+primOpTag FetchSubByteArrayOp_Int = 499+primOpTag FetchAndByteArrayOp_Int = 500+primOpTag FetchNandByteArrayOp_Int = 501+primOpTag FetchOrByteArrayOp_Int = 502+primOpTag FetchXorByteArrayOp_Int = 503+primOpTag AddrAddOp = 504+primOpTag AddrSubOp = 505+primOpTag AddrRemOp = 506+primOpTag AddrToIntOp = 507+primOpTag IntToAddrOp = 508+primOpTag AddrGtOp = 509+primOpTag AddrGeOp = 510+primOpTag AddrEqOp = 511+primOpTag AddrNeOp = 512+primOpTag AddrLtOp = 513+primOpTag AddrLeOp = 514+primOpTag IndexOffAddrOp_Char = 515+primOpTag IndexOffAddrOp_WideChar = 516+primOpTag IndexOffAddrOp_Int = 517+primOpTag IndexOffAddrOp_Word = 518+primOpTag IndexOffAddrOp_Addr = 519+primOpTag IndexOffAddrOp_Float = 520+primOpTag IndexOffAddrOp_Double = 521+primOpTag IndexOffAddrOp_StablePtr = 522+primOpTag IndexOffAddrOp_Int8 = 523+primOpTag IndexOffAddrOp_Word8 = 524+primOpTag IndexOffAddrOp_Int16 = 525+primOpTag IndexOffAddrOp_Word16 = 526+primOpTag IndexOffAddrOp_Int32 = 527+primOpTag IndexOffAddrOp_Word32 = 528+primOpTag IndexOffAddrOp_Int64 = 529+primOpTag IndexOffAddrOp_Word64 = 530+primOpTag IndexOffAddrOp_Word8AsChar = 531+primOpTag IndexOffAddrOp_Word8AsWideChar = 532+primOpTag IndexOffAddrOp_Word8AsInt = 533+primOpTag IndexOffAddrOp_Word8AsWord = 534+primOpTag IndexOffAddrOp_Word8AsAddr = 535+primOpTag IndexOffAddrOp_Word8AsFloat = 536+primOpTag IndexOffAddrOp_Word8AsDouble = 537+primOpTag IndexOffAddrOp_Word8AsStablePtr = 538+primOpTag IndexOffAddrOp_Word8AsInt16 = 539+primOpTag IndexOffAddrOp_Word8AsWord16 = 540+primOpTag IndexOffAddrOp_Word8AsInt32 = 541+primOpTag IndexOffAddrOp_Word8AsWord32 = 542+primOpTag IndexOffAddrOp_Word8AsInt64 = 543+primOpTag IndexOffAddrOp_Word8AsWord64 = 544+primOpTag ReadOffAddrOp_Char = 545+primOpTag ReadOffAddrOp_WideChar = 546+primOpTag ReadOffAddrOp_Int = 547+primOpTag ReadOffAddrOp_Word = 548+primOpTag ReadOffAddrOp_Addr = 549+primOpTag ReadOffAddrOp_Float = 550+primOpTag ReadOffAddrOp_Double = 551+primOpTag ReadOffAddrOp_StablePtr = 552+primOpTag ReadOffAddrOp_Int8 = 553+primOpTag ReadOffAddrOp_Word8 = 554+primOpTag ReadOffAddrOp_Int16 = 555+primOpTag ReadOffAddrOp_Word16 = 556+primOpTag ReadOffAddrOp_Int32 = 557+primOpTag ReadOffAddrOp_Word32 = 558+primOpTag ReadOffAddrOp_Int64 = 559+primOpTag ReadOffAddrOp_Word64 = 560+primOpTag ReadOffAddrOp_Word8AsChar = 561+primOpTag ReadOffAddrOp_Word8AsWideChar = 562+primOpTag ReadOffAddrOp_Word8AsInt = 563+primOpTag ReadOffAddrOp_Word8AsWord = 564+primOpTag ReadOffAddrOp_Word8AsAddr = 565+primOpTag ReadOffAddrOp_Word8AsFloat = 566+primOpTag ReadOffAddrOp_Word8AsDouble = 567+primOpTag ReadOffAddrOp_Word8AsStablePtr = 568+primOpTag ReadOffAddrOp_Word8AsInt16 = 569+primOpTag ReadOffAddrOp_Word8AsWord16 = 570+primOpTag ReadOffAddrOp_Word8AsInt32 = 571+primOpTag ReadOffAddrOp_Word8AsWord32 = 572+primOpTag ReadOffAddrOp_Word8AsInt64 = 573+primOpTag ReadOffAddrOp_Word8AsWord64 = 574+primOpTag WriteOffAddrOp_Char = 575+primOpTag WriteOffAddrOp_WideChar = 576+primOpTag WriteOffAddrOp_Int = 577+primOpTag WriteOffAddrOp_Word = 578+primOpTag WriteOffAddrOp_Addr = 579+primOpTag WriteOffAddrOp_Float = 580+primOpTag WriteOffAddrOp_Double = 581+primOpTag WriteOffAddrOp_StablePtr = 582+primOpTag WriteOffAddrOp_Int8 = 583+primOpTag WriteOffAddrOp_Word8 = 584+primOpTag WriteOffAddrOp_Int16 = 585+primOpTag WriteOffAddrOp_Word16 = 586+primOpTag WriteOffAddrOp_Int32 = 587+primOpTag WriteOffAddrOp_Word32 = 588+primOpTag WriteOffAddrOp_Int64 = 589+primOpTag WriteOffAddrOp_Word64 = 590+primOpTag WriteOffAddrOp_Word8AsChar = 591+primOpTag WriteOffAddrOp_Word8AsWideChar = 592+primOpTag WriteOffAddrOp_Word8AsInt = 593+primOpTag WriteOffAddrOp_Word8AsWord = 594+primOpTag WriteOffAddrOp_Word8AsAddr = 595+primOpTag WriteOffAddrOp_Word8AsFloat = 596+primOpTag WriteOffAddrOp_Word8AsDouble = 597+primOpTag WriteOffAddrOp_Word8AsStablePtr = 598+primOpTag WriteOffAddrOp_Word8AsInt16 = 599+primOpTag WriteOffAddrOp_Word8AsWord16 = 600+primOpTag WriteOffAddrOp_Word8AsInt32 = 601+primOpTag WriteOffAddrOp_Word8AsWord32 = 602+primOpTag WriteOffAddrOp_Word8AsInt64 = 603+primOpTag WriteOffAddrOp_Word8AsWord64 = 604+primOpTag InterlockedExchange_Addr = 605+primOpTag InterlockedExchange_Word = 606+primOpTag CasAddrOp_Addr = 607+primOpTag CasAddrOp_Word = 608+primOpTag CasAddrOp_Word8 = 609+primOpTag CasAddrOp_Word16 = 610+primOpTag CasAddrOp_Word32 = 611+primOpTag CasAddrOp_Word64 = 612+primOpTag FetchAddAddrOp_Word = 613+primOpTag FetchSubAddrOp_Word = 614+primOpTag FetchAndAddrOp_Word = 615+primOpTag FetchNandAddrOp_Word = 616+primOpTag FetchOrAddrOp_Word = 617+primOpTag FetchXorAddrOp_Word = 618+primOpTag AtomicReadAddrOp_Word = 619+primOpTag AtomicWriteAddrOp_Word = 620+primOpTag NewMutVarOp = 621+primOpTag ReadMutVarOp = 622+primOpTag WriteMutVarOp = 623+primOpTag AtomicSwapMutVarOp = 624+primOpTag AtomicModifyMutVar2Op = 625+primOpTag AtomicModifyMutVar_Op = 626+primOpTag CasMutVarOp = 627+primOpTag CatchOp = 628+primOpTag RaiseOp = 629+primOpTag RaiseUnderflowOp = 630+primOpTag RaiseOverflowOp = 631+primOpTag RaiseDivZeroOp = 632+primOpTag RaiseIOOp = 633+primOpTag MaskAsyncExceptionsOp = 634+primOpTag MaskUninterruptibleOp = 635+primOpTag UnmaskAsyncExceptionsOp = 636+primOpTag MaskStatus = 637+primOpTag NewPromptTagOp = 638+primOpTag PromptOp = 639+primOpTag Control0Op = 640+primOpTag AtomicallyOp = 641+primOpTag RetryOp = 642+primOpTag CatchRetryOp = 643+primOpTag CatchSTMOp = 644+primOpTag NewTVarOp = 645+primOpTag ReadTVarOp = 646+primOpTag ReadTVarIOOp = 647+primOpTag WriteTVarOp = 648+primOpTag NewMVarOp = 649+primOpTag TakeMVarOp = 650+primOpTag TryTakeMVarOp = 651+primOpTag PutMVarOp = 652+primOpTag TryPutMVarOp = 653+primOpTag ReadMVarOp = 654+primOpTag TryReadMVarOp = 655+primOpTag IsEmptyMVarOp = 656+primOpTag NewIOPortOp = 657+primOpTag ReadIOPortOp = 658+primOpTag WriteIOPortOp = 659+primOpTag DelayOp = 660+primOpTag WaitReadOp = 661+primOpTag WaitWriteOp = 662+primOpTag ForkOp = 663+primOpTag ForkOnOp = 664+primOpTag KillThreadOp = 665+primOpTag YieldOp = 666+primOpTag MyThreadIdOp = 667+primOpTag LabelThreadOp = 668+primOpTag IsCurrentThreadBoundOp = 669+primOpTag NoDuplicateOp = 670+primOpTag GetThreadLabelOp = 671+primOpTag ThreadStatusOp = 672+primOpTag ListThreadsOp = 673+primOpTag MkWeakOp = 674+primOpTag MkWeakNoFinalizerOp = 675+primOpTag AddCFinalizerToWeakOp = 676+primOpTag DeRefWeakOp = 677+primOpTag FinalizeWeakOp = 678+primOpTag TouchOp = 679+primOpTag MakeStablePtrOp = 680+primOpTag DeRefStablePtrOp = 681+primOpTag EqStablePtrOp = 682+primOpTag MakeStableNameOp = 683+primOpTag StableNameToIntOp = 684+primOpTag CompactNewOp = 685+primOpTag CompactResizeOp = 686+primOpTag CompactContainsOp = 687+primOpTag CompactContainsAnyOp = 688+primOpTag CompactGetFirstBlockOp = 689+primOpTag CompactGetNextBlockOp = 690+primOpTag CompactAllocateBlockOp = 691+primOpTag CompactFixupPointersOp = 692+primOpTag CompactAdd = 693+primOpTag CompactAddWithSharing = 694+primOpTag CompactSize = 695+primOpTag ReallyUnsafePtrEqualityOp = 696+primOpTag ParOp = 697+primOpTag SparkOp = 698+primOpTag GetSparkOp = 699+primOpTag NumSparks = 700+primOpTag KeepAliveOp = 701+primOpTag DataToTagSmallOp = 702+primOpTag DataToTagLargeOp = 703+primOpTag TagToEnumOp = 704+primOpTag AddrToAnyOp = 705+primOpTag AnyToAddrOp = 706+primOpTag MkApUpd0_Op = 707+primOpTag NewBCOOp = 708+primOpTag UnpackClosureOp = 709+primOpTag ClosureSizeOp = 710+primOpTag GetApStackValOp = 711+primOpTag GetCCSOfOp = 712+primOpTag GetCurrentCCSOp = 713+primOpTag ClearCCSOp = 714+primOpTag WhereFromOp = 715+primOpTag TraceEventOp = 716+primOpTag TraceEventBinaryOp = 717+primOpTag TraceMarkerOp = 718+primOpTag SetThreadAllocationCounter = 719+primOpTag (VecBroadcastOp IntVec 16 W8) = 720+primOpTag (VecBroadcastOp IntVec 8 W16) = 721+primOpTag (VecBroadcastOp IntVec 4 W32) = 722+primOpTag (VecBroadcastOp IntVec 2 W64) = 723+primOpTag (VecBroadcastOp IntVec 32 W8) = 724+primOpTag (VecBroadcastOp IntVec 16 W16) = 725+primOpTag (VecBroadcastOp IntVec 8 W32) = 726+primOpTag (VecBroadcastOp IntVec 4 W64) = 727+primOpTag (VecBroadcastOp IntVec 64 W8) = 728+primOpTag (VecBroadcastOp IntVec 32 W16) = 729+primOpTag (VecBroadcastOp IntVec 16 W32) = 730+primOpTag (VecBroadcastOp IntVec 8 W64) = 731+primOpTag (VecBroadcastOp WordVec 16 W8) = 732+primOpTag (VecBroadcastOp WordVec 8 W16) = 733+primOpTag (VecBroadcastOp WordVec 4 W32) = 734+primOpTag (VecBroadcastOp WordVec 2 W64) = 735+primOpTag (VecBroadcastOp WordVec 32 W8) = 736+primOpTag (VecBroadcastOp WordVec 16 W16) = 737+primOpTag (VecBroadcastOp WordVec 8 W32) = 738+primOpTag (VecBroadcastOp WordVec 4 W64) = 739+primOpTag (VecBroadcastOp WordVec 64 W8) = 740+primOpTag (VecBroadcastOp WordVec 32 W16) = 741+primOpTag (VecBroadcastOp WordVec 16 W32) = 742+primOpTag (VecBroadcastOp WordVec 8 W64) = 743+primOpTag (VecBroadcastOp FloatVec 4 W32) = 744+primOpTag (VecBroadcastOp FloatVec 2 W64) = 745+primOpTag (VecBroadcastOp FloatVec 8 W32) = 746+primOpTag (VecBroadcastOp FloatVec 4 W64) = 747+primOpTag (VecBroadcastOp FloatVec 16 W32) = 748+primOpTag (VecBroadcastOp FloatVec 8 W64) = 749+primOpTag (VecPackOp IntVec 16 W8) = 750+primOpTag (VecPackOp IntVec 8 W16) = 751+primOpTag (VecPackOp IntVec 4 W32) = 752+primOpTag (VecPackOp IntVec 2 W64) = 753+primOpTag (VecPackOp IntVec 32 W8) = 754+primOpTag (VecPackOp IntVec 16 W16) = 755+primOpTag (VecPackOp IntVec 8 W32) = 756+primOpTag (VecPackOp IntVec 4 W64) = 757+primOpTag (VecPackOp IntVec 64 W8) = 758+primOpTag (VecPackOp IntVec 32 W16) = 759+primOpTag (VecPackOp IntVec 16 W32) = 760+primOpTag (VecPackOp IntVec 8 W64) = 761+primOpTag (VecPackOp WordVec 16 W8) = 762+primOpTag (VecPackOp WordVec 8 W16) = 763+primOpTag (VecPackOp WordVec 4 W32) = 764+primOpTag (VecPackOp WordVec 2 W64) = 765+primOpTag (VecPackOp WordVec 32 W8) = 766+primOpTag (VecPackOp WordVec 16 W16) = 767+primOpTag (VecPackOp WordVec 8 W32) = 768+primOpTag (VecPackOp WordVec 4 W64) = 769+primOpTag (VecPackOp WordVec 64 W8) = 770+primOpTag (VecPackOp WordVec 32 W16) = 771+primOpTag (VecPackOp WordVec 16 W32) = 772+primOpTag (VecPackOp WordVec 8 W64) = 773+primOpTag (VecPackOp FloatVec 4 W32) = 774+primOpTag (VecPackOp FloatVec 2 W64) = 775+primOpTag (VecPackOp FloatVec 8 W32) = 776+primOpTag (VecPackOp FloatVec 4 W64) = 777+primOpTag (VecPackOp FloatVec 16 W32) = 778+primOpTag (VecPackOp FloatVec 8 W64) = 779+primOpTag (VecUnpackOp IntVec 16 W8) = 780+primOpTag (VecUnpackOp IntVec 8 W16) = 781+primOpTag (VecUnpackOp IntVec 4 W32) = 782+primOpTag (VecUnpackOp IntVec 2 W64) = 783+primOpTag (VecUnpackOp IntVec 32 W8) = 784+primOpTag (VecUnpackOp IntVec 16 W16) = 785+primOpTag (VecUnpackOp IntVec 8 W32) = 786+primOpTag (VecUnpackOp IntVec 4 W64) = 787+primOpTag (VecUnpackOp IntVec 64 W8) = 788+primOpTag (VecUnpackOp IntVec 32 W16) = 789+primOpTag (VecUnpackOp IntVec 16 W32) = 790+primOpTag (VecUnpackOp IntVec 8 W64) = 791+primOpTag (VecUnpackOp WordVec 16 W8) = 792+primOpTag (VecUnpackOp WordVec 8 W16) = 793+primOpTag (VecUnpackOp WordVec 4 W32) = 794+primOpTag (VecUnpackOp WordVec 2 W64) = 795+primOpTag (VecUnpackOp WordVec 32 W8) = 796+primOpTag (VecUnpackOp WordVec 16 W16) = 797+primOpTag (VecUnpackOp WordVec 8 W32) = 798+primOpTag (VecUnpackOp WordVec 4 W64) = 799+primOpTag (VecUnpackOp WordVec 64 W8) = 800+primOpTag (VecUnpackOp WordVec 32 W16) = 801+primOpTag (VecUnpackOp WordVec 16 W32) = 802+primOpTag (VecUnpackOp WordVec 8 W64) = 803+primOpTag (VecUnpackOp FloatVec 4 W32) = 804+primOpTag (VecUnpackOp FloatVec 2 W64) = 805+primOpTag (VecUnpackOp FloatVec 8 W32) = 806+primOpTag (VecUnpackOp FloatVec 4 W64) = 807+primOpTag (VecUnpackOp FloatVec 16 W32) = 808+primOpTag (VecUnpackOp FloatVec 8 W64) = 809+primOpTag (VecInsertOp IntVec 16 W8) = 810+primOpTag (VecInsertOp IntVec 8 W16) = 811+primOpTag (VecInsertOp IntVec 4 W32) = 812+primOpTag (VecInsertOp IntVec 2 W64) = 813+primOpTag (VecInsertOp IntVec 32 W8) = 814+primOpTag (VecInsertOp IntVec 16 W16) = 815+primOpTag (VecInsertOp IntVec 8 W32) = 816+primOpTag (VecInsertOp IntVec 4 W64) = 817+primOpTag (VecInsertOp IntVec 64 W8) = 818+primOpTag (VecInsertOp IntVec 32 W16) = 819+primOpTag (VecInsertOp IntVec 16 W32) = 820+primOpTag (VecInsertOp IntVec 8 W64) = 821+primOpTag (VecInsertOp WordVec 16 W8) = 822+primOpTag (VecInsertOp WordVec 8 W16) = 823+primOpTag (VecInsertOp WordVec 4 W32) = 824+primOpTag (VecInsertOp WordVec 2 W64) = 825+primOpTag (VecInsertOp WordVec 32 W8) = 826+primOpTag (VecInsertOp WordVec 16 W16) = 827+primOpTag (VecInsertOp WordVec 8 W32) = 828+primOpTag (VecInsertOp WordVec 4 W64) = 829+primOpTag (VecInsertOp WordVec 64 W8) = 830+primOpTag (VecInsertOp WordVec 32 W16) = 831+primOpTag (VecInsertOp WordVec 16 W32) = 832+primOpTag (VecInsertOp WordVec 8 W64) = 833+primOpTag (VecInsertOp FloatVec 4 W32) = 834+primOpTag (VecInsertOp FloatVec 2 W64) = 835+primOpTag (VecInsertOp FloatVec 8 W32) = 836+primOpTag (VecInsertOp FloatVec 4 W64) = 837+primOpTag (VecInsertOp FloatVec 16 W32) = 838+primOpTag (VecInsertOp FloatVec 8 W64) = 839+primOpTag (VecAddOp IntVec 16 W8) = 840+primOpTag (VecAddOp IntVec 8 W16) = 841+primOpTag (VecAddOp IntVec 4 W32) = 842+primOpTag (VecAddOp IntVec 2 W64) = 843+primOpTag (VecAddOp IntVec 32 W8) = 844+primOpTag (VecAddOp IntVec 16 W16) = 845+primOpTag (VecAddOp IntVec 8 W32) = 846+primOpTag (VecAddOp IntVec 4 W64) = 847+primOpTag (VecAddOp IntVec 64 W8) = 848+primOpTag (VecAddOp IntVec 32 W16) = 849+primOpTag (VecAddOp IntVec 16 W32) = 850+primOpTag (VecAddOp IntVec 8 W64) = 851+primOpTag (VecAddOp WordVec 16 W8) = 852+primOpTag (VecAddOp WordVec 8 W16) = 853+primOpTag (VecAddOp WordVec 4 W32) = 854+primOpTag (VecAddOp WordVec 2 W64) = 855+primOpTag (VecAddOp WordVec 32 W8) = 856+primOpTag (VecAddOp WordVec 16 W16) = 857+primOpTag (VecAddOp WordVec 8 W32) = 858+primOpTag (VecAddOp WordVec 4 W64) = 859+primOpTag (VecAddOp WordVec 64 W8) = 860+primOpTag (VecAddOp WordVec 32 W16) = 861+primOpTag (VecAddOp WordVec 16 W32) = 862+primOpTag (VecAddOp WordVec 8 W64) = 863+primOpTag (VecAddOp FloatVec 4 W32) = 864+primOpTag (VecAddOp FloatVec 2 W64) = 865+primOpTag (VecAddOp FloatVec 8 W32) = 866+primOpTag (VecAddOp FloatVec 4 W64) = 867+primOpTag (VecAddOp FloatVec 16 W32) = 868+primOpTag (VecAddOp FloatVec 8 W64) = 869+primOpTag (VecSubOp IntVec 16 W8) = 870+primOpTag (VecSubOp IntVec 8 W16) = 871+primOpTag (VecSubOp IntVec 4 W32) = 872+primOpTag (VecSubOp IntVec 2 W64) = 873+primOpTag (VecSubOp IntVec 32 W8) = 874+primOpTag (VecSubOp IntVec 16 W16) = 875+primOpTag (VecSubOp IntVec 8 W32) = 876+primOpTag (VecSubOp IntVec 4 W64) = 877+primOpTag (VecSubOp IntVec 64 W8) = 878+primOpTag (VecSubOp IntVec 32 W16) = 879+primOpTag (VecSubOp IntVec 16 W32) = 880+primOpTag (VecSubOp IntVec 8 W64) = 881+primOpTag (VecSubOp WordVec 16 W8) = 882+primOpTag (VecSubOp WordVec 8 W16) = 883+primOpTag (VecSubOp WordVec 4 W32) = 884+primOpTag (VecSubOp WordVec 2 W64) = 885+primOpTag (VecSubOp WordVec 32 W8) = 886+primOpTag (VecSubOp WordVec 16 W16) = 887+primOpTag (VecSubOp WordVec 8 W32) = 888+primOpTag (VecSubOp WordVec 4 W64) = 889+primOpTag (VecSubOp WordVec 64 W8) = 890+primOpTag (VecSubOp WordVec 32 W16) = 891+primOpTag (VecSubOp WordVec 16 W32) = 892+primOpTag (VecSubOp WordVec 8 W64) = 893+primOpTag (VecSubOp FloatVec 4 W32) = 894+primOpTag (VecSubOp FloatVec 2 W64) = 895+primOpTag (VecSubOp FloatVec 8 W32) = 896+primOpTag (VecSubOp FloatVec 4 W64) = 897+primOpTag (VecSubOp FloatVec 16 W32) = 898+primOpTag (VecSubOp FloatVec 8 W64) = 899+primOpTag (VecMulOp IntVec 16 W8) = 900+primOpTag (VecMulOp IntVec 8 W16) = 901+primOpTag (VecMulOp IntVec 4 W32) = 902+primOpTag (VecMulOp IntVec 2 W64) = 903+primOpTag (VecMulOp IntVec 32 W8) = 904+primOpTag (VecMulOp IntVec 16 W16) = 905+primOpTag (VecMulOp IntVec 8 W32) = 906+primOpTag (VecMulOp IntVec 4 W64) = 907+primOpTag (VecMulOp IntVec 64 W8) = 908+primOpTag (VecMulOp IntVec 32 W16) = 909+primOpTag (VecMulOp IntVec 16 W32) = 910+primOpTag (VecMulOp IntVec 8 W64) = 911+primOpTag (VecMulOp WordVec 16 W8) = 912+primOpTag (VecMulOp WordVec 8 W16) = 913+primOpTag (VecMulOp WordVec 4 W32) = 914+primOpTag (VecMulOp WordVec 2 W64) = 915+primOpTag (VecMulOp WordVec 32 W8) = 916+primOpTag (VecMulOp WordVec 16 W16) = 917+primOpTag (VecMulOp WordVec 8 W32) = 918+primOpTag (VecMulOp WordVec 4 W64) = 919+primOpTag (VecMulOp WordVec 64 W8) = 920+primOpTag (VecMulOp WordVec 32 W16) = 921+primOpTag (VecMulOp WordVec 16 W32) = 922+primOpTag (VecMulOp WordVec 8 W64) = 923+primOpTag (VecMulOp FloatVec 4 W32) = 924+primOpTag (VecMulOp FloatVec 2 W64) = 925+primOpTag (VecMulOp FloatVec 8 W32) = 926+primOpTag (VecMulOp FloatVec 4 W64) = 927+primOpTag (VecMulOp FloatVec 16 W32) = 928+primOpTag (VecMulOp FloatVec 8 W64) = 929+primOpTag (VecDivOp FloatVec 4 W32) = 930+primOpTag (VecDivOp FloatVec 2 W64) = 931+primOpTag (VecDivOp FloatVec 8 W32) = 932+primOpTag (VecDivOp FloatVec 4 W64) = 933+primOpTag (VecDivOp FloatVec 16 W32) = 934+primOpTag (VecDivOp FloatVec 8 W64) = 935+primOpTag (VecQuotOp IntVec 16 W8) = 936+primOpTag (VecQuotOp IntVec 8 W16) = 937+primOpTag (VecQuotOp IntVec 4 W32) = 938+primOpTag (VecQuotOp IntVec 2 W64) = 939+primOpTag (VecQuotOp IntVec 32 W8) = 940+primOpTag (VecQuotOp IntVec 16 W16) = 941+primOpTag (VecQuotOp IntVec 8 W32) = 942+primOpTag (VecQuotOp IntVec 4 W64) = 943+primOpTag (VecQuotOp IntVec 64 W8) = 944+primOpTag (VecQuotOp IntVec 32 W16) = 945+primOpTag (VecQuotOp IntVec 16 W32) = 946+primOpTag (VecQuotOp IntVec 8 W64) = 947+primOpTag (VecQuotOp WordVec 16 W8) = 948+primOpTag (VecQuotOp WordVec 8 W16) = 949+primOpTag (VecQuotOp WordVec 4 W32) = 950+primOpTag (VecQuotOp WordVec 2 W64) = 951+primOpTag (VecQuotOp WordVec 32 W8) = 952+primOpTag (VecQuotOp WordVec 16 W16) = 953+primOpTag (VecQuotOp WordVec 8 W32) = 954+primOpTag (VecQuotOp WordVec 4 W64) = 955+primOpTag (VecQuotOp WordVec 64 W8) = 956+primOpTag (VecQuotOp WordVec 32 W16) = 957+primOpTag (VecQuotOp WordVec 16 W32) = 958+primOpTag (VecQuotOp WordVec 8 W64) = 959+primOpTag (VecRemOp IntVec 16 W8) = 960+primOpTag (VecRemOp IntVec 8 W16) = 961+primOpTag (VecRemOp IntVec 4 W32) = 962+primOpTag (VecRemOp IntVec 2 W64) = 963+primOpTag (VecRemOp IntVec 32 W8) = 964+primOpTag (VecRemOp IntVec 16 W16) = 965+primOpTag (VecRemOp IntVec 8 W32) = 966+primOpTag (VecRemOp IntVec 4 W64) = 967+primOpTag (VecRemOp IntVec 64 W8) = 968+primOpTag (VecRemOp IntVec 32 W16) = 969+primOpTag (VecRemOp IntVec 16 W32) = 970+primOpTag (VecRemOp IntVec 8 W64) = 971+primOpTag (VecRemOp WordVec 16 W8) = 972+primOpTag (VecRemOp WordVec 8 W16) = 973+primOpTag (VecRemOp WordVec 4 W32) = 974+primOpTag (VecRemOp WordVec 2 W64) = 975+primOpTag (VecRemOp WordVec 32 W8) = 976+primOpTag (VecRemOp WordVec 16 W16) = 977+primOpTag (VecRemOp WordVec 8 W32) = 978+primOpTag (VecRemOp WordVec 4 W64) = 979+primOpTag (VecRemOp WordVec 64 W8) = 980+primOpTag (VecRemOp WordVec 32 W16) = 981+primOpTag (VecRemOp WordVec 16 W32) = 982+primOpTag (VecRemOp WordVec 8 W64) = 983+primOpTag (VecNegOp IntVec 16 W8) = 984+primOpTag (VecNegOp IntVec 8 W16) = 985+primOpTag (VecNegOp IntVec 4 W32) = 986+primOpTag (VecNegOp IntVec 2 W64) = 987+primOpTag (VecNegOp IntVec 32 W8) = 988+primOpTag (VecNegOp IntVec 16 W16) = 989+primOpTag (VecNegOp IntVec 8 W32) = 990+primOpTag (VecNegOp IntVec 4 W64) = 991+primOpTag (VecNegOp IntVec 64 W8) = 992+primOpTag (VecNegOp IntVec 32 W16) = 993+primOpTag (VecNegOp IntVec 16 W32) = 994+primOpTag (VecNegOp IntVec 8 W64) = 995+primOpTag (VecNegOp FloatVec 4 W32) = 996+primOpTag (VecNegOp FloatVec 2 W64) = 997+primOpTag (VecNegOp FloatVec 8 W32) = 998+primOpTag (VecNegOp FloatVec 4 W64) = 999+primOpTag (VecNegOp FloatVec 16 W32) = 1000+primOpTag (VecNegOp FloatVec 8 W64) = 1001+primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 1002+primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 1003+primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 1004+primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 1005+primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 1006+primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 1007+primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 1008+primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 1009+primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 1010+primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 1011+primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 1012+primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 1013+primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 1014+primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 1015+primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 1016+primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 1017+primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 1018+primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 1019+primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 1020+primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 1021+primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 1022+primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 1023+primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 1024+primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 1025+primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 1026+primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 1027+primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 1028+primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 1029+primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 1030+primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 1031+primOpTag (VecReadByteArrayOp IntVec 16 W8) = 1032+primOpTag (VecReadByteArrayOp IntVec 8 W16) = 1033+primOpTag (VecReadByteArrayOp IntVec 4 W32) = 1034+primOpTag (VecReadByteArrayOp IntVec 2 W64) = 1035+primOpTag (VecReadByteArrayOp IntVec 32 W8) = 1036+primOpTag (VecReadByteArrayOp IntVec 16 W16) = 1037+primOpTag (VecReadByteArrayOp IntVec 8 W32) = 1038+primOpTag (VecReadByteArrayOp IntVec 4 W64) = 1039+primOpTag (VecReadByteArrayOp IntVec 64 W8) = 1040+primOpTag (VecReadByteArrayOp IntVec 32 W16) = 1041+primOpTag (VecReadByteArrayOp IntVec 16 W32) = 1042+primOpTag (VecReadByteArrayOp IntVec 8 W64) = 1043+primOpTag (VecReadByteArrayOp WordVec 16 W8) = 1044+primOpTag (VecReadByteArrayOp WordVec 8 W16) = 1045+primOpTag (VecReadByteArrayOp WordVec 4 W32) = 1046+primOpTag (VecReadByteArrayOp WordVec 2 W64) = 1047+primOpTag (VecReadByteArrayOp WordVec 32 W8) = 1048+primOpTag (VecReadByteArrayOp WordVec 16 W16) = 1049+primOpTag (VecReadByteArrayOp WordVec 8 W32) = 1050+primOpTag (VecReadByteArrayOp WordVec 4 W64) = 1051+primOpTag (VecReadByteArrayOp WordVec 64 W8) = 1052+primOpTag (VecReadByteArrayOp WordVec 32 W16) = 1053+primOpTag (VecReadByteArrayOp WordVec 16 W32) = 1054+primOpTag (VecReadByteArrayOp WordVec 8 W64) = 1055+primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 1056+primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 1057+primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 1058+primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 1059+primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 1060+primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 1061+primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 1062+primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 1063+primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 1064+primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 1065+primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 1066+primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 1067+primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 1068+primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 1069+primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 1070+primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 1071+primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1072+primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1073+primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1074+primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1075+primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1076+primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1077+primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1078+primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1079+primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1080+primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1081+primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1082+primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1083+primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1084+primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1085+primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1086+primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1087+primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1088+primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1089+primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1090+primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1091+primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1092+primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1093+primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1094+primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1095+primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1096+primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1097+primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1098+primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1099+primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1100+primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1101+primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1102+primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1103+primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1104+primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1105+primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1106+primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1107+primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1108+primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1109+primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1110+primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1111+primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1112+primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1113+primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1114+primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1115+primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1116+primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1117+primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1118+primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1119+primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1120+primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1121+primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1122+primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1123+primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1124+primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1125+primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1126+primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1127+primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1128+primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1129+primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1130+primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1131+primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1132+primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1133+primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1134+primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1135+primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1136+primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1137+primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1138+primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1139+primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1140+primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1141+primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1142+primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1143+primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1144+primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1145+primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1146+primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1147+primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1148+primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1149+primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1150+primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1151+primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1152+primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1153+primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1154+primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1155+primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1156+primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1157+primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1158+primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1159+primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1160+primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1161+primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1162+primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1163+primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1164+primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1165+primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1166+primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1167+primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1168+primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1169+primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1170+primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1171+primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1172+primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1173+primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1174+primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1175+primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1176+primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1177+primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1178+primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1179+primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1180+primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1181+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1182+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1183+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1184+primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1185+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1186+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1187+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1188+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1189+primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1190+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1191+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1192+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1193+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1194+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1195+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1196+primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1197+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1198+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1199+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1200+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1201+primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1202+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1203+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1204+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1205+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1206+primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1207+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1208+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1209+primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1210+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1211+primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1212+primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1213+primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1214+primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1215+primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1216+primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1217+primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1218+primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1219+primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1220+primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1221+primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1222+primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1223+primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1224+primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1225+primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1226+primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1227+primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1228+primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1229+primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1230+primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1231+primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1232+primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1233+primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1234+primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1235+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1236+primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1237+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1238+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1239+primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1240+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1241+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1242+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1243+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1244+primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1245+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1246+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1247+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1248+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1249+primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1250+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1251+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1252+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1253+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1254+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1255+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1256+primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1257+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1258+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1259+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1260+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1261+primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1262+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1263+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1264+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1265+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1266+primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1267+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1268+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1269+primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1270+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1271+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1272+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1273+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1274+primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1275+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1276+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1277+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1278+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1279+primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1280+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1281+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1282+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1283+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1284+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1285+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1286+primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1287+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1288+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1289+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1290+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1291+primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1292+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1293+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1294+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1295+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1296+primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1297+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1298+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1299+primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1300+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1301+primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1302+primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1303+primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1304+primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1305+primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1306+primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1307+primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1308+primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1309+primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1310+primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1311+primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1312+primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1313+primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1314+primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1315+primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1316+primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1317+primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1318+primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1319+primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1320+primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1321+primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1322+primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1323+primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1324+primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1325+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1326+primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1327+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1328+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1329+primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1330+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1331+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1332+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1333+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1334+primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1335+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1336+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1337+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1338+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1339+primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1340+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1341+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1342+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1343+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1344+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1345+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1346+primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1347+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1348+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1349+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1350+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1351+primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1352+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1353+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1354+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1355+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1356+primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1357+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1358+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1359+primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1360+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1361+primOpTag (VecFMAdd FloatVec 4 W32) = 1362+primOpTag (VecFMAdd FloatVec 2 W64) = 1363+primOpTag (VecFMAdd FloatVec 8 W32) = 1364+primOpTag (VecFMAdd FloatVec 4 W64) = 1365+primOpTag (VecFMAdd FloatVec 16 W32) = 1366+primOpTag (VecFMAdd FloatVec 8 W64) = 1367+primOpTag (VecFMSub FloatVec 4 W32) = 1368+primOpTag (VecFMSub FloatVec 2 W64) = 1369+primOpTag (VecFMSub FloatVec 8 W32) = 1370+primOpTag (VecFMSub FloatVec 4 W64) = 1371+primOpTag (VecFMSub FloatVec 16 W32) = 1372+primOpTag (VecFMSub FloatVec 8 W64) = 1373+primOpTag (VecFNMAdd FloatVec 4 W32) = 1374+primOpTag (VecFNMAdd FloatVec 2 W64) = 1375+primOpTag (VecFNMAdd FloatVec 8 W32) = 1376+primOpTag (VecFNMAdd FloatVec 4 W64) = 1377+primOpTag (VecFNMAdd FloatVec 16 W32) = 1378+primOpTag (VecFNMAdd FloatVec 8 W64) = 1379+primOpTag (VecFNMSub FloatVec 4 W32) = 1380+primOpTag (VecFNMSub FloatVec 2 W64) = 1381+primOpTag (VecFNMSub FloatVec 8 W32) = 1382+primOpTag (VecFNMSub FloatVec 4 W64) = 1383+primOpTag (VecFNMSub FloatVec 16 W32) = 1384+primOpTag (VecFNMSub FloatVec 8 W64) = 1385+primOpTag (VecShuffleOp IntVec 16 W8) = 1386+primOpTag (VecShuffleOp IntVec 8 W16) = 1387+primOpTag (VecShuffleOp IntVec 4 W32) = 1388+primOpTag (VecShuffleOp IntVec 2 W64) = 1389+primOpTag (VecShuffleOp IntVec 32 W8) = 1390+primOpTag (VecShuffleOp IntVec 16 W16) = 1391+primOpTag (VecShuffleOp IntVec 8 W32) = 1392+primOpTag (VecShuffleOp IntVec 4 W64) = 1393+primOpTag (VecShuffleOp IntVec 64 W8) = 1394+primOpTag (VecShuffleOp IntVec 32 W16) = 1395+primOpTag (VecShuffleOp IntVec 16 W32) = 1396+primOpTag (VecShuffleOp IntVec 8 W64) = 1397+primOpTag (VecShuffleOp WordVec 16 W8) = 1398+primOpTag (VecShuffleOp WordVec 8 W16) = 1399+primOpTag (VecShuffleOp WordVec 4 W32) = 1400+primOpTag (VecShuffleOp WordVec 2 W64) = 1401+primOpTag (VecShuffleOp WordVec 32 W8) = 1402+primOpTag (VecShuffleOp WordVec 16 W16) = 1403+primOpTag (VecShuffleOp WordVec 8 W32) = 1404+primOpTag (VecShuffleOp WordVec 4 W64) = 1405+primOpTag (VecShuffleOp WordVec 64 W8) = 1406+primOpTag (VecShuffleOp WordVec 32 W16) = 1407+primOpTag (VecShuffleOp WordVec 16 W32) = 1408+primOpTag (VecShuffleOp WordVec 8 W64) = 1409+primOpTag (VecShuffleOp FloatVec 4 W32) = 1410+primOpTag (VecShuffleOp FloatVec 2 W64) = 1411+primOpTag (VecShuffleOp FloatVec 8 W32) = 1412+primOpTag (VecShuffleOp FloatVec 4 W64) = 1413+primOpTag (VecShuffleOp FloatVec 16 W32) = 1414+primOpTag (VecShuffleOp FloatVec 8 W64) = 1415+primOpTag (VecMinOp IntVec 16 W8) = 1416+primOpTag (VecMinOp IntVec 8 W16) = 1417+primOpTag (VecMinOp IntVec 4 W32) = 1418+primOpTag (VecMinOp IntVec 2 W64) = 1419+primOpTag (VecMinOp IntVec 32 W8) = 1420+primOpTag (VecMinOp IntVec 16 W16) = 1421+primOpTag (VecMinOp IntVec 8 W32) = 1422+primOpTag (VecMinOp IntVec 4 W64) = 1423+primOpTag (VecMinOp IntVec 64 W8) = 1424+primOpTag (VecMinOp IntVec 32 W16) = 1425+primOpTag (VecMinOp IntVec 16 W32) = 1426+primOpTag (VecMinOp IntVec 8 W64) = 1427+primOpTag (VecMinOp WordVec 16 W8) = 1428+primOpTag (VecMinOp WordVec 8 W16) = 1429+primOpTag (VecMinOp WordVec 4 W32) = 1430+primOpTag (VecMinOp WordVec 2 W64) = 1431+primOpTag (VecMinOp WordVec 32 W8) = 1432+primOpTag (VecMinOp WordVec 16 W16) = 1433+primOpTag (VecMinOp WordVec 8 W32) = 1434+primOpTag (VecMinOp WordVec 4 W64) = 1435+primOpTag (VecMinOp WordVec 64 W8) = 1436+primOpTag (VecMinOp WordVec 32 W16) = 1437+primOpTag (VecMinOp WordVec 16 W32) = 1438+primOpTag (VecMinOp WordVec 8 W64) = 1439+primOpTag (VecMinOp FloatVec 4 W32) = 1440+primOpTag (VecMinOp FloatVec 2 W64) = 1441+primOpTag (VecMinOp FloatVec 8 W32) = 1442+primOpTag (VecMinOp FloatVec 4 W64) = 1443+primOpTag (VecMinOp FloatVec 16 W32) = 1444+primOpTag (VecMinOp FloatVec 8 W64) = 1445+primOpTag (VecMaxOp IntVec 16 W8) = 1446+primOpTag (VecMaxOp IntVec 8 W16) = 1447+primOpTag (VecMaxOp IntVec 4 W32) = 1448+primOpTag (VecMaxOp IntVec 2 W64) = 1449+primOpTag (VecMaxOp IntVec 32 W8) = 1450+primOpTag (VecMaxOp IntVec 16 W16) = 1451+primOpTag (VecMaxOp IntVec 8 W32) = 1452+primOpTag (VecMaxOp IntVec 4 W64) = 1453+primOpTag (VecMaxOp IntVec 64 W8) = 1454+primOpTag (VecMaxOp IntVec 32 W16) = 1455+primOpTag (VecMaxOp IntVec 16 W32) = 1456+primOpTag (VecMaxOp IntVec 8 W64) = 1457+primOpTag (VecMaxOp WordVec 16 W8) = 1458+primOpTag (VecMaxOp WordVec 8 W16) = 1459+primOpTag (VecMaxOp WordVec 4 W32) = 1460+primOpTag (VecMaxOp WordVec 2 W64) = 1461+primOpTag (VecMaxOp WordVec 32 W8) = 1462+primOpTag (VecMaxOp WordVec 16 W16) = 1463+primOpTag (VecMaxOp WordVec 8 W32) = 1464+primOpTag (VecMaxOp WordVec 4 W64) = 1465+primOpTag (VecMaxOp WordVec 64 W8) = 1466+primOpTag (VecMaxOp WordVec 32 W16) = 1467+primOpTag (VecMaxOp WordVec 16 W32) = 1468+primOpTag (VecMaxOp WordVec 8 W64) = 1469+primOpTag (VecMaxOp FloatVec 4 W32) = 1470+primOpTag (VecMaxOp FloatVec 2 W64) = 1471+primOpTag (VecMaxOp FloatVec 8 W32) = 1472+primOpTag (VecMaxOp FloatVec 4 W64) = 1473+primOpTag (VecMaxOp FloatVec 16 W32) = 1474+primOpTag (VecMaxOp FloatVec 8 W64) = 1475+primOpTag PrefetchByteArrayOp3 = 1476+primOpTag PrefetchMutableByteArrayOp3 = 1477+primOpTag PrefetchAddrOp3 = 1478+primOpTag PrefetchValueOp3 = 1479+primOpTag PrefetchByteArrayOp2 = 1480+primOpTag PrefetchMutableByteArrayOp2 = 1481+primOpTag PrefetchAddrOp2 = 1482+primOpTag PrefetchValueOp2 = 1483+primOpTag PrefetchByteArrayOp1 = 1484+primOpTag PrefetchMutableByteArrayOp1 = 1485+primOpTag PrefetchAddrOp1 = 1486+primOpTag PrefetchValueOp1 = 1487+primOpTag PrefetchByteArrayOp0 = 1488+primOpTag PrefetchMutableByteArrayOp0 = 1489+primOpTag PrefetchAddrOp0 = 1490+primOpTag PrefetchValueOp0 = 1491
ghc-lib/stage0/lib/llvm-targets view
@@ -1,6 +1,4 @@-[("i386-unknown-windows", ("e-m:x-p:32:32-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", ""))-,("i686-unknown-windows", ("e-m:x-p:32:32-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", ""))-,("x86_64-unknown-windows", ("e-m:w-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))+[("x86_64-unknown-windows-gnu", ("e-m:w-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("arm-unknown-linux-gnueabi", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align")) ,("arm-unknown-linux-gnueabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) ,("arm-unknown-linux-musleabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))@@ -45,12 +43,9 @@ ,("riscv64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+m +a +f +d +c +relax")) ,("loongarch64-unknown-linux-gnu", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+f +d")) ,("loongarch64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+f +d"))-,("i386-apple-darwin", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "penryn", "")) ,("x86_64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "penryn", "")) ,("arm64-apple-darwin", ("e-m:o-i64:64-i128:128-n32:64-S128", "generic", "+v8.3a +fp-armv8 +neon +crc +crypto +fullfp16 +ras +lse +rdm +rcpc +zcm +zcz +sha2 +aes"))-,("armv7-apple-ios", ("e-m:o-p:32:32-Fi8-f64:32:64-v64:32:64-v128:32:128-a:0:32-n32-S32", "generic", "")) ,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes"))-,("i386-apple-ios", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) ,("x86_64-apple-ios", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) ,("amd64-portbld-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("x86_64-unknown-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
ghc-lib/stage0/lib/settings view
@@ -1,30 +1,30 @@-[("C compiler command", "/usr/local/opt/ccache/libexec/gcc")+[("C compiler command", "gcc") ,("C compiler flags", "--target=x86_64-apple-darwin -Qunused-arguments")-,("C++ compiler command", "/usr/local/opt/ccache/libexec/g++")+,("C++ compiler command", "g++") ,("C++ compiler flags", "--target=x86_64-apple-darwin") ,("C compiler link flags", "--target=x86_64-apple-darwin -Wl,-no_fixup_chains -Wl,-no_warn_duplicate_libraries") ,("C compiler supports -no-pie", "NO")-,("CPP command", "/usr/local/opt/ccache/libexec/gcc")+,("CPP command", "gcc") ,("CPP flags", "-E")-,("Haskell CPP command", "/usr/local/opt/ccache/libexec/gcc")+,("Haskell CPP command", "gcc") ,("Haskell CPP flags", "-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs")-,("JavaScript CPP command", "/usr/local/opt/ccache/libexec/gcc")+,("JavaScript CPP command", "gcc") ,("JavaScript CPP flags", "-E -CC -Wno-unicode -nostdinc")-,("C-- CPP command", "/usr/local/opt/ccache/libexec/gcc")+,("C-- CPP command", "gcc") ,("C-- CPP flags", "-E") ,("C-- CPP supports -g0", "YES") ,("ld supports compact unwind", "YES") ,("ld supports filelist", "YES") ,("ld supports single module", "NO") ,("ld is GNU ld", "NO")-,("Merge objects command", "/usr/local/anaconda3/bin/ld")+,("Merge objects command", "ld") ,("Merge objects flags", "-r") ,("Merge objects supports response files", "YES")-,("ar command", "/usr/local/anaconda3/bin/ar")+,("ar command", "ar") ,("ar flags", "qcls") ,("ar supports at file", "NO") ,("ar supports -L", "NO")-,("ranlib command", "/usr/local/anaconda3/bin/ranlib")+,("ranlib command", "ranlib") ,("otool command", "otool") ,("install_name_tool command", "install_name_tool") ,("windres command", "/bin/false")@@ -43,13 +43,15 @@ ,("LLVM target", "x86_64-apple-darwin") ,("LLVM llc command", "llc") ,("LLVM opt command", "opt")-,("LLVM llvm-as command", "clang")+,("LLVM llvm-as command", "clang-19") ,("Use inplace MinGW toolchain", "NO")+,("target RTS linker only supports shared libraries", "NO") ,("Use interpreter", "YES") ,("Support SMP", "YES")-,("RTS ways", "v")+,("RTS ways", "v thr thr_debug thr_debug_p thr_debug_p_dyn thr_debug_dyn thr_p thr_p_dyn thr_dyn debug debug_p debug_p_dyn debug_dyn p p_dyn dyn") ,("Tables next to code", "YES") ,("Leading underscore", "YES") ,("Use LibFFI", "NO") ,("RTS expects libdw", "NO")+,("Relative Global Package DB", "../../stage1/lib/package.conf.d") ]
ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs view
@@ -3,19 +3,19 @@ import Prelude -- See Note [Why do we import Prelude here?]  cProjectGitCommitId   :: String-cProjectGitCommitId   = "3f4d7d38b9661435bdde981451ac50c4335ed090"+cProjectGitCommitId   = "daf659b6e3c8f2a84100fbee797cd9d457c00df5"  cProjectVersion       :: String-cProjectVersion       = "9.10.3"+cProjectVersion       = "9.12.1"  cProjectVersionInt    :: String-cProjectVersionInt    = "910"+cProjectVersionInt    = "912"  cProjectPatchLevel    :: String-cProjectPatchLevel    = "3"+cProjectPatchLevel    = "1"  cProjectPatchLevel1   :: String-cProjectPatchLevel1   = "3"+cProjectPatchLevel1   = "1"  cProjectPatchLevel2   :: String cProjectPatchLevel2   = "0"
ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h view
@@ -3,6 +3,7 @@ // MAX_Real_Vanilla_REG 6 // MAX_Real_Float_REG 6 // MAX_Real_Double_REG 6+// MAX_Real_XMM_REG 6 // MAX_Real_Long_REG 0 // WORD_SIZE 8 // BITMAP_BITS_SHIFT 6
ghc-lib/stage0/rts/build/include/ghcautoconf.h view
@@ -78,9 +78,6 @@ /* Define to 1 if using 'alloca.c'. */ /* #undef C_ALLOCA */ -/* Enable Native I/O manager as default. */-/* #undef DEFAULT_NATIVE_IO_MANAGER */- /* Define to 1 if your processor stores words of floats with the most    significant byte first */ /* #undef FLOAT_WORDS_BIGENDIAN */@@ -382,6 +379,36 @@  /* Define to 1 if 'vfork' works. */ #define HAVE_WORKING_VFORK 1++/* Define to 1 if the mio I/O manager should be built */+#define IOMGR_BUILD_MIO 1++/* Define to 1 if the select I/O manager should be built */+#define IOMGR_BUILD_SELECT 1++/* Define to 1 if the win32-legacy I/O manager should be built */+/* #undef IOMGR_BUILD_WIN32_LEGACY */++/* Define to 1 if the winio I/O manager should be built */+/* #undef IOMGR_BUILD_WINIO */++/* Define to 1 if the select I/O manager is the default for the non-threaded+   RTS */+#define IOMGR_DEFAULT_NON_THREADED_SELECT 1++/* Define to 1 if the win32-legacy I/O manager is the default for the+   non-threaded RTS */+/* #undef IOMGR_DEFAULT_NON_THREADED_WIN32_LEGACY */++/* Define to 1 if the winio I/O manager is the default for the non-threaded+   RTS */+/* #undef IOMGR_DEFAULT_NON_THREADED_WINIO */++/* Define to 1 if the mio I/O manager is the default for the threaded RTS */+#define IOMGR_DEFAULT_THREADED_MIO 1++/* Define to 1 if the winio I/O manager is the default for the threaded RTS */+/* #undef IOMGR_DEFAULT_THREADED_WINIO */  /* Define to 1 if C symbols have a leading underscore added by the compiler.    */
ghc/ghc-bin.cabal view
@@ -2,7 +2,7 @@ -- ./configure.  Make sure you are editing ghc-bin.cabal.in, not ghc-bin.cabal.  Name: ghc-bin-Version: 9.10.3+Version: 9.12.1 Copyright: XXX -- License: XXX -- License-File: XXX@@ -36,11 +36,11 @@                    bytestring >= 0.9 && < 0.13,                    directory  >= 1   && < 1.4,                    process    >= 1   && < 1.7,-                   filepath   >= 1   && < 1.6,+                   filepath   >= 1.5 && < 1.6,                    containers >= 0.5 && < 0.8,                    transformers >= 0.5 && < 0.7,-                   ghc-boot      == 9.10.3,-                   ghc           == 9.10.3+                   ghc-boot      == 9.12.1,+                   ghc           == 9.12.1      if os(windows)         Build-Depends: Win32  >= 2.3 && < 2.15@@ -57,11 +57,11 @@         -- NB: this is never built by the bootstrapping GHC+libraries         Build-depends:             deepseq        >= 1.4 && < 1.6,-            ghc-prim       >= 0.5.0 && < 0.13,-            ghci           == 9.10.3,+            ghc-prim       >= 0.5.0 && < 0.14,+            ghci           == 9.12.1,             haskeline      == 0.8.*,             exceptions     == 0.10.*,-            time           >= 1.8 && < 1.13+            time           >= 1.8 && < 1.15         CPP-Options: -DHAVE_INTERNAL_INTERPRETER         Other-Modules:             GHCi.Leak
+ libraries/ghc-boot-th-internal/GHC/Internal/TH/Lib/Map.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Safe #-}++-- This is a non-exposed internal module+--+-- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost+-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.+--+-- [1] see https://hackage.haskell.org/package/containers-0.5.5.1+--+-- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.++module GHC.Internal.TH.Lib.Map+    ( Map+    , empty+    , insert+    , GHC.Internal.TH.Lib.Map.lookup+    ) where++import Prelude++data Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)+              | Tip++type Size     = Int++empty :: Map k a+empty = Tip+{-# INLINE empty #-}++singleton :: k -> a -> Map k a+singleton k x = Bin 1 k x Tip Tip+{-# INLINE singleton #-}++size :: Map k a -> Int+size Tip              = 0+size (Bin sz _ _ _ _) = sz+{-# INLINE size #-}++lookup :: Ord k => k -> Map k a -> Maybe a+lookup = go+  where+    go _ Tip = Nothing+    go !k (Bin _ kx x l r) = case compare k kx of+      LT -> go k l+      GT -> go k r+      EQ -> Just x+{-# INLINABLE lookup #-}+++insert :: Ord k => k -> a -> Map k a -> Map k a+insert = go+  where+    go :: Ord k => k -> a -> Map k a -> Map k a+    go !kx x Tip = singleton kx x+    go !kx x (Bin sz ky y l r) =+        case compare kx ky of+            LT -> balanceL ky y (go kx x l) r+            GT -> balanceR ky y l (go kx x r)+            EQ -> Bin sz kx x l r+{-# INLINABLE insert #-}++balanceL :: k -> a -> Map k a -> Map k a -> Map k a+balanceL k x l r = case r of+  Tip -> case l of+           Tip -> Bin 1 k x Tip Tip+           (Bin _ _ _ Tip Tip) -> Bin 2 k x l Tip+           (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) -> Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)+           (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) -> Bin 3 lk lx ll (Bin 1 k x Tip Tip)+           (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr))+             | lrs < ratio*lls -> Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)+             | otherwise -> Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)++  (Bin rs _ _ _ _) -> case l of+           Tip -> Bin (1+rs) k x Tip r++           (Bin ls lk lx ll lr)+              | ls > delta*rs  -> case (ll, lr) of+                   (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr)+                     | lrs < ratio*lls -> Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)+                     | otherwise -> Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)+                   (_, _) -> error "Failure in Data.Map.balanceL"+              | otherwise -> Bin (1+ls+rs) k x l r+{-# NOINLINE balanceL #-}++balanceR :: k -> a -> Map k a -> Map k a -> Map k a+balanceR k x l r = case l of+  Tip -> case r of+           Tip -> Bin 1 k x Tip Tip+           (Bin _ _ _ Tip Tip) -> Bin 2 k x Tip r+           (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) -> Bin 3 rk rx (Bin 1 k x Tip Tip) rr+           (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) -> Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)+           (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _))+             | rls < ratio*rrs -> Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr+             | otherwise -> Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)++  (Bin ls _ _ _ _) -> case r of+           Tip -> Bin (1+ls) k x l Tip++           (Bin rs rk rx rl rr)+              | rs > delta*ls  -> case (rl, rr) of+                   (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _)+                     | rls < ratio*rrs -> Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr+                     | otherwise -> Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)+                   (_, _) -> error "Failure in Data.Map.balanceR"+              | otherwise -> Bin (1+ls+rs) k x l r+{-# NOINLINE balanceR #-}++delta,ratio :: Int+delta = 3+ratio = 2
+ libraries/ghc-boot-th-internal/GHC/Internal/TH/Ppr.hs view
@@ -0,0 +1,1096 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE LambdaCase #-}+-- | contains a prettyprinter for the+-- Template Haskell datatypes++module GHC.Internal.TH.Ppr where+    -- All of the exports from this module should+    -- be "public" functions.  The main module TH+    -- re-exports them all.++import Text.PrettyPrint (render)+import GHC.Internal.TH.PprLib+import GHC.Internal.TH.Syntax+import Data.Word ( Word8 )+import Data.Char ( toLower, chr )+import Data.List ( intersperse )+import GHC.Show  ( showMultiLineString )+import GHC.Lexeme( isVarSymChar )+import Data.Ratio ( numerator, denominator )+import Data.Foldable ( toList )+import qualified Data.List.NonEmpty as NE+import Prelude hiding ((<>))++nestDepth :: Int+nestDepth = 4++type Precedence = Int+appPrec, opPrec, unopPrec, funPrec, qualPrec, sigPrec, noPrec :: Precedence+appPrec  = 6    -- Argument of a function or type application+opPrec   = 5    -- Argument of an infix operator+unopPrec = 4    -- Argument of an unresolved infix operator+funPrec  = 3    -- Argument of a function arrow+qualPrec = 2    -- Forall-qualified type or result of a function arrow+sigPrec  = 1    -- Argument of an explicit type signature+noPrec   = 0    -- Others++parensIf :: Bool -> Doc -> Doc+parensIf True d = parens d+parensIf False d = d++------------------------------++pprint :: Ppr a => a -> String+pprint x = render $ to_HPJ_Doc $ ppr x++class Ppr a where+    ppr :: a -> Doc+    ppr_list :: [a] -> Doc+    ppr_list = vcat . map ppr++instance Ppr a => Ppr [a] where+    ppr x = ppr_list x++------------------------------+instance Ppr Name where+    ppr v = pprName v++------------------------------+instance Ppr Info where+    ppr (TyConI d)     = ppr d+    ppr (ClassI d is)  = ppr d $$ vcat (map ppr is)+    ppr (FamilyI d is) = ppr d $$ vcat (map ppr is)+    ppr (PrimTyConI name arity is_unlifted)+      = text "Primitive"+        <+> (if is_unlifted then text "unlifted" else empty)+        <+> text "type constructor" <+> quotes (ppr name)+        <+> parens (text "arity" <+> int arity)+    ppr (ClassOpI v ty cls)+      = text "Class op from" <+> ppr cls <> colon <+> ppr_sig v ty+    ppr (DataConI v ty tc)+      = text "Constructor from" <+> ppr tc <> colon <+> ppr_sig v ty+    ppr (PatSynI nm ty) = pprPatSynSig nm ty+    ppr (TyVarI v ty)+      = text "Type variable" <+> ppr v <+> equals <+> ppr ty+    ppr (VarI v ty mb_d)+      = vcat [ppr_sig v ty,+              case mb_d of { Nothing -> empty; Just d -> ppr d }]++ppr_sig :: Name -> Type -> Doc+ppr_sig v ty = pprName' Applied v <+> dcolon <+> ppr ty++pprFixity :: Name -> Fixity -> NamespaceSpecifier -> Doc+pprFixity _ f _ | f == defaultFixity = empty+pprFixity v (Fixity i d) ns_spec+  = ppr_fix d <+> int i <+> pprNamespaceSpecifier ns_spec <+> pprName' Infix v+    where ppr_fix InfixR = text "infixr"+          ppr_fix InfixL = text "infixl"+          ppr_fix InfixN = text "infix"++pprNamespaceSpecifier :: NamespaceSpecifier -> Doc+pprNamespaceSpecifier NoNamespaceSpecifier = empty+pprNamespaceSpecifier TypeNamespaceSpecifier = text "type"+pprNamespaceSpecifier DataNamespaceSpecifier = text "data"++-- | Pretty prints a pattern synonym type signature+pprPatSynSig :: Name -> PatSynType -> Doc+pprPatSynSig nm ty+  = text "pattern" <+> pprPrefixOcc nm <+> dcolon <+> pprPatSynType ty++-- | Pretty prints a pattern synonym's type; follows the usual+-- conventions to print a pattern synonym type compactly, yet+-- unambiguously. See the note on 'PatSynType' and the section on+-- pattern synonyms in the GHC user's guide for more information.+pprPatSynType :: PatSynType -> Doc+pprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))+  | null exTys,  null provs = ppr (ForallT uniTys reqs ty'')+  | null uniTys, null reqs  = noreqs <+> ppr ty'+  | null reqs               = pprForallBndrs uniTys <+> noreqs <+> ppr ty'+  | otherwise               = ppr ty+  where noreqs = text "() =>"+        pprForallBndrs tvs = text "forall" <+> hsep (map ppr tvs) <+> text "."+pprPatSynType ty            = ppr ty++------------------------------+instance Ppr Module where+  ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)++instance Ppr ModuleInfo where+  ppr (ModuleInfo imps) = text "Module" <+> vcat (map ppr imps)++------------------------------+instance Ppr Exp where+    ppr = pprExp noPrec++pprPrefixOcc :: Name -> Doc+-- Print operators with parens around them+pprPrefixOcc n = parensIf (isSymOcc n) (ppr n)++isSymOcc :: Name -> Bool+isSymOcc n+  = case nameBase n of+      []    -> True  -- Empty name; weird+      (c:_) -> isVarSymChar c+                   -- c.f. isVarSymChar in GHC itself++pprInfixExp :: Exp -> Doc+pprInfixExp (VarE v) = pprName' Infix v+pprInfixExp (ConE v) = pprName' Infix v+pprInfixExp (UnboundVarE v) = pprName' Infix v+-- This case will only ever be reached in exceptional circumstances.+-- For example, when printing an error message in case of a malformed expression.+pprInfixExp e = text "`" <> ppr e <> text "`"++pprExp :: Precedence -> Exp -> Doc+pprExp _ (VarE v)     = pprName' Applied v+pprExp _ (ConE c)     = pprName' Applied c+pprExp i (LitE l)     = pprLit i l+pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1+                                              <+> pprExp appPrec e2+pprExp i (AppTypeE e t)+ = parensIf (i >= appPrec) $ pprExp opPrec e <+> char '@' <> pprParendType t+pprExp _ (ParensE e)  = parens (pprExp noPrec e)+pprExp i (UInfixE e1 op e2)+ = parensIf (i > unopPrec) $ pprExp unopPrec e1+                         <+> pprInfixExp op+                         <+> pprExp unopPrec e2+pprExp i (InfixE (Just e1) op (Just e2))+ = parensIf (i >= opPrec) $ pprExp opPrec e1+                        <+> pprInfixExp op+                        <+> pprExp opPrec e2+pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1+                                    <+> pprInfixExp op+                                    <+> pprMaybeExp noPrec me2+pprExp i (LamE [] e) = pprExp i e -- #13856+pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)+                                           <+> text "->" <+> ppr e+pprExp i (LamCaseE ms)+  = parensIf (i > noPrec) $ text "\\case" $$ braces (semiSep ms)+pprExp i (LamCasesE ms)+  = parensIf (i > noPrec) $ text "\\cases" $$ braces (semi_sep ms)+  where semi_sep = sep . punctuate semi . map (pprClause False)+pprExp i (TupE es)+  | [Just e] <- es+  = pprExp i (ConE (tupleDataName 1) `AppE` e)+  | otherwise+  = parens (commaSepWith (pprMaybeExp noPrec) es)+pprExp _ (UnboxedTupE es) = hashParens (commaSepWith (pprMaybeExp noPrec) es)+pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity+-- Nesting in Cond is to avoid potential problems in do statements+pprExp i (CondE guard true false)+ = parensIf (i > noPrec) $ sep [text "if"   <+> ppr guard,+                       nest 1 $ text "then" <+> ppr true,+                       nest 1 $ text "else" <+> ppr false]+pprExp i (MultiIfE alts)+  = parensIf (i > noPrec) $ vcat $+      case alts of+        []            -> [text "if {}"]+        (alt : alts') -> text "if" <+> pprGuarded arrow alt+                         : map (nest 3 . pprGuarded arrow) alts'+pprExp i (LetE ds_ e) = parensIf (i > noPrec) $ text "let" <+> pprDecs ds_+                                             $$ text " in" <+> ppr e+  where+    pprDecs []  = empty+    pprDecs [d] = ppr d+    pprDecs ds  = braces (semiSep ds)++pprExp i (CaseE e ms)+ = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"+                        $$ braces (semiSep ms)+pprExp i (DoE m ss_) = parensIf (i > noPrec) $+    pprQualifier m <> text "do" <+> pprStms ss_+  where+    pprQualifier Nothing = empty+    pprQualifier (Just modName) = text (modString modName) <> char '.'+    pprStms []  = empty+    pprStms [s] = ppr s+    pprStms ss  = braces (semiSep ss)+pprExp i (MDoE m ss_) = parensIf (i > noPrec) $+    pprQualifier m <> text "mdo" <+> pprStms ss_+  where+    pprQualifier Nothing = empty+    pprQualifier (Just modName) = text (modString modName) <> char '.'+    pprStms []  = empty+    pprStms [s] = ppr s+    pprStms ss  = braces (semiSep ss)++pprExp _ (CompE []) = text "<<Empty CompExp>>"+-- This will probably break with fixity declarations - would need a ';'+pprExp _ (CompE ss) =+    if null ss'+       -- If there are no statements in a list comprehension besides the last+       -- one, we simply treat it like a normal list.+       then text "[" <> ppr s <> text "]"+       else text "[" <> ppr s+        <+> bar+        <+> commaSep ss'+         <> text "]"+  where s = last ss+        ss' = init ss+pprExp _ (ArithSeqE d) = ppr d+pprExp _ (ListE es) = brackets (commaSep es)+pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e+                                          <+> dcolon <+> pprType sigPrec t+pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs)+pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)+pprExp i (StaticE e) = parensIf (i >= appPrec) $+                         text "static"<+> pprExp appPrec e+pprExp _ (UnboundVarE v) = pprName' Applied v+pprExp _ (LabelE s) = text "#" <> text s+pprExp _ (ImplicitParamVarE n) = text ('?' : n)+pprExp _ (GetFieldE e f) = pprExp appPrec e <> text ('.': f)+pprExp _ (ProjectionE xs) = parens $ hcat $ map ((char '.'<>) . text) $ toList xs+pprExp _ (TypedBracketE e) = text "[||" <> ppr e <> text "||]"+pprExp _ (TypedSpliceE e) = text "$$" <> pprExp appPrec e+pprExp i (TypeE t) = parensIf (i > noPrec) $ text "type" <+> ppr t+pprExp i (ForallVisE tvars body) =+  parensIf (i >= funPrec) $ sep [pprForallVis tvars [], pprExp qualPrec body]+pprExp i (ForallE tvars body) =+  parensIf (i >= funPrec) $ sep [pprForall tvars [], pprExp qualPrec body]+pprExp i (ConstrainedE ctx body) =+  parensIf (i >= funPrec) $ sep [pprCtxWith pprExp ctx, pprExp qualPrec body]++pprFields :: [(Name,Exp)] -> Doc+pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e)++pprMaybeExp :: Precedence -> Maybe Exp -> Doc+pprMaybeExp _ Nothing = empty+pprMaybeExp i (Just e) = pprExp i e++------------------------------+instance Ppr Stmt where+    ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e+    ppr (LetS ds) = text "let" <+> (braces (semiSep ds))+    ppr (NoBindS e) = ppr e+    ppr (ParS sss) = sep $ punctuate bar+                         $ map commaSep sss+    ppr (RecS ss) = text "rec" <+> (braces (semiSep ss))++------------------------------+instance Ppr Match where+    ppr (Match p rhs ds) = pprMatchPat p <+> pprBody False rhs+                        $$ where_clause ds++pprMatchPat :: Pat -> Doc+-- Everything except pattern signatures bind more tightly than (->)+pprMatchPat p@(SigP {}) = parens (ppr p)+pprMatchPat p           = ppr p++------------------------------+pprGuarded :: Doc -> (Guard, Exp) -> Doc+pprGuarded eqDoc (guard, expr) = case guard of+  NormalG guardExpr -> bar <+> ppr guardExpr <+> eqDoc <+> ppr expr+  PatG    stmts     -> bar <+> vcat (punctuate comma $ map ppr stmts) $$+                         nest nestDepth (eqDoc <+> ppr expr)++------------------------------+pprBody :: Bool -> Body -> Doc+pprBody eq body = case body of+    GuardedB xs -> nest nestDepth $ vcat $ map (pprGuarded eqDoc) xs+    NormalB  e  -> eqDoc <+> ppr e+  where eqDoc | eq        = equals+              | otherwise = arrow++------------------------------+pprClause :: Bool -> Clause -> Doc+pprClause eqDoc (Clause ps rhs ds)+  = hsep (map (pprPat appPrec) ps) <+> pprBody eqDoc rhs+    $$ where_clause ds++------------------------------+instance Ppr Lit where+  ppr = pprLit noPrec++pprLit :: Precedence -> Lit -> Doc+pprLit i (IntPrimL x)    = parensIf (i > noPrec && x < 0)+                                    (integer x <> char '#')+pprLit _ (WordPrimL x)    = integer x <> text "##"+pprLit i (FloatPrimL x)  = parensIf (i > noPrec && x < 0)+                                    (float (fromRational x) <> char '#')+pprLit i (DoublePrimL x) = parensIf (i > noPrec && x < 0)+                                    (double (fromRational x) <> text "##")+pprLit i (IntegerL x)    = parensIf (i > noPrec && x < 0) (integer x)+pprLit _ (CharL c)       = text (show c)+pprLit _ (CharPrimL c)   = text (show c) <> char '#'+pprLit _ (StringL s)     = pprString s+pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'+pprLit _ (BytesPrimL {}) = pprString "<binary data>"+pprLit i (RationalL rat)+  | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1+  -- if the denominator has prime factors other than 2 and 5+  -- or can't be represented as Double, show as fraction+  = parensIf (i > noPrec) $+    integer (numerator rat) <+> char '/' <+> integer (denominator rat)+  | rat /= 0 && (zeroes < -2 || zeroes > 6),+    let (n, d) = properFraction (rat / magnitude)+  -- if < 0.01 or >= 100_000_000, use scientific notation+  = parensIf (i > noPrec && rat < 0)+             (integer n+              <> (if d == 0 then empty else char '.' <> decimals (abs d))+              <> char 'e' <> integer zeroes)+  | let (n, d) = properFraction rat+  = parensIf (i > noPrec && rat < 0)+             (integer n <> char '.'+              <> if d == 0 then char '0' else decimals (abs d))+  where zeroes :: Integer+        zeroes = log10 (abs rat)+        log10 :: Rational -> Integer+        log10 x+          | x >= 10 = 1 + log10 (x / 10)+          | x < 1 = -1 + log10 (x * 10)+          | otherwise = 0+        magnitude :: Rational+        magnitude = 10 ^^ zeroes+        withoutFactor :: Integer -> Integer -> Integer+        withoutFactor _ 0 = 0+        withoutFactor p n+          | (n', 0) <- divMod n p = withoutFactor p n'+          | otherwise = n+        -- | Expects the argument 0 <= x < 1+        decimals :: Rational -> Doc+        decimals x+          | x == 0 = empty+          | otherwise = integer n <> decimals d+          where (n, d) = properFraction (x * 10)++bytesToString :: [Word8] -> String+bytesToString = map (chr . fromIntegral)++pprString :: String -> Doc+-- Print newlines as newlines with Haskell string escape notation,+-- not as '\n'.  For other non-printables use regular escape notation.+pprString s = vcat (map text (showMultiLineString s))++------------------------------+instance Ppr Pat where+    ppr = pprPat noPrec++pprPat :: Precedence -> Pat -> Doc+pprPat i (LitP l)     = pprLit i l+pprPat _ (VarP v)     = pprName' Applied v+pprPat i (TupP ps)+  | [_] <- ps+  = pprPat i (ConP (tupleDataName 1) [] ps)+  | otherwise+  = parens (commaSep ps)+pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)+pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity+pprPat i (ConP s ts ps)  = parensIf (i >= appPrec) $+      pprName' Applied s+  <+> sep (map (\t -> char '@' <> pprParendType t) ts)+  <+> sep (map (pprPat appPrec) ps)+pprPat _ (ParensP p)  = parens $ pprPat noPrec p+pprPat i (UInfixP p1 n p2)+                      = parensIf (i > unopPrec) (pprPat unopPrec p1 <+>+                                                 pprName' Infix n   <+>+                                                 pprPat unopPrec p2)+pprPat i (InfixP p1 n p2)+                      = parensIf (i >= opPrec) (pprPat opPrec p1 <+>+                                                pprName' Infix n <+>+                                                pprPat opPrec p2)+pprPat i (TildeP p)   = parensIf (i > noPrec) $ char '~' <> pprPat appPrec p+pprPat i (BangP p)    = parensIf (i > noPrec) $ char '!' <> pprPat appPrec p+pprPat i (AsP v p)    = parensIf (i > noPrec) $ ppr v <> text "@"+                                                      <> pprPat appPrec p+pprPat _ WildP        = text "_"+pprPat _ (RecP nm fs)+ = parens $     pprName' Applied nm+            <+> braces (sep $ punctuate comma $+                        map (\(s,p) -> pprName' Applied s <+> equals <+> ppr p) fs)+pprPat _ (ListP ps) = brackets (commaSep ps)+pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> dcolon <+> ppr t+pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p+pprPat _ (TypeP t) = parens $ text "type" <+> ppr t+pprPat _ (InvisP t) = parens $ text "@" <+> ppr t+pprPat _ (OrP t) = parens $ semiSep (NE.toList t)++------------------------------+instance Ppr Dec where+    ppr = ppr_dec True++ppr_dec :: Bool     -- ^ declaration on the toplevel?+        -> Dec+        -> Doc+ppr_dec isTop (FunD f cs)   = layout $ map (\c -> pprPrefixOcc f <+> ppr c) cs+  where+    layout :: [Doc] -> Doc+    layout = if isTop then vcat else semiSepWith id+ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r+                          $$ where_clause ds+ppr_dec _ (TySynD t xs rhs)+  = ppr_tySyn empty (Just t) (hsep (map ppr xs)) rhs+ppr_dec isTop (DataD ctxt t xs ksig cs decs)+  = ppr_data isTop empty ctxt (Just t) (hsep (map ppr xs)) ksig cs decs+ppr_dec isTop (NewtypeD ctxt t xs ksig c decs)+  = ppr_newtype isTop empty ctxt (Just t) (sep (map ppr xs)) ksig c decs+ppr_dec isTop (TypeDataD t xs ksig cs)+  = ppr_type_data isTop empty [] (Just t) (hsep (map ppr xs)) ksig cs []+ppr_dec _  (ClassD ctxt c xs fds ds)+  = text "class" <+> pprCxt ctxt <+> pprName' Applied c <+> hsep (map ppr xs) <+> ppr fds+    $$ where_clause ds+ppr_dec _ (InstanceD o ctxt i ds) =+        text "instance" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i+                                  $$ where_clause ds+ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> dcolon <+> ppr t+ppr_dec _ (KiSigD f k)  = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k+ppr_dec _ (ForeignD f)  = ppr f+ppr_dec _ (InfixD fx ns_spec n) = pprFixity n fx ns_spec+ppr_dec _ (DefaultD tys) =+        text "default" <+> parens (sep $ punctuate comma $ map ppr tys)+ppr_dec _ (PragmaD p)   = ppr p+ppr_dec isTop (DataFamilyD tc tvs kind)+  = text "data" <+> maybeFamily <+> pprName' Applied tc <+> hsep (map ppr tvs) <+> maybeKind+  where+    maybeFamily | isTop     = text "family"+                | otherwise = empty+    maybeKind | (Just k') <- kind = dcolon <+> ppr k'+              | otherwise = empty+ppr_dec isTop (DataInstD ctxt bndrs ty ksig cs decs)+  = ppr_data isTop (maybeInst <+> ppr_bndrs bndrs)+             ctxt Nothing (ppr ty) ksig cs decs+  where+    maybeInst | isTop     = text "instance"+              | otherwise = empty+ppr_dec isTop (NewtypeInstD ctxt bndrs ty ksig c decs)+  = ppr_newtype isTop (maybeInst <+> ppr_bndrs bndrs)+                ctxt Nothing (ppr ty) ksig c decs+  where+    maybeInst | isTop     = text "instance"+              | otherwise = empty+ppr_dec isTop (TySynInstD (TySynEqn mb_bndrs ty rhs))+  = ppr_tySyn (maybeInst <+> ppr_bndrs mb_bndrs)+              Nothing (ppr ty) rhs+  where+    maybeInst | isTop     = text "instance"+              | otherwise = empty+ppr_dec isTop (OpenTypeFamilyD tfhead)+  = text "type" <+> maybeFamily <+> ppr_tf_head tfhead+  where+    maybeFamily | isTop     = text "family"+                | otherwise = empty+ppr_dec _ (ClosedTypeFamilyD tfhead eqns)+  = hang (text "type family" <+> ppr_tf_head tfhead <+> text "where")+      nestDepth (vcat (map ppr_eqn eqns))+  where+    ppr_eqn (TySynEqn mb_bndrs lhs rhs)+      = ppr_bndrs mb_bndrs <+> ppr lhs <+> text "=" <+> ppr rhs+ppr_dec _ (RoleAnnotD name roles)+  = hsep [ text "type role", pprName' Applied name ] <+> hsep (map ppr roles)+ppr_dec _ (StandaloneDerivD ds cxt ty)+  = hsep [ text "deriving"+         , maybe empty ppr_deriv_strategy ds+         , text "instance"+         , pprCxt cxt+         , ppr ty ]+ppr_dec _ (DefaultSigD n ty)+  = hsep [ text "default", pprPrefixOcc n, dcolon, ppr ty ]+ppr_dec _ (PatSynD name args dir pat)+  = text "pattern" <+> pprNameArgs <+> ppr dir <+> pprPatRHS+  where+    pprNameArgs | InfixPatSyn a1 a2 <- args = ppr a1 <+> pprName' Infix name <+> ppr a2+                | otherwise                 = pprName' Applied name <+> ppr args+    pprPatRHS   | ExplBidir cls <- dir = hang (ppr pat <+> text "where")+                                              nestDepth+                                              (vcat $ (pprName' Applied name <+>) . ppr <$> cls)+                | otherwise            = ppr pat+ppr_dec _ (PatSynSigD name ty)+  = pprPatSynSig name ty+ppr_dec _ (ImplicitParamBindD n e)+  = hsep [text ('?' : n), text "=", ppr e]++ppr_deriv_strategy :: DerivStrategy -> Doc+ppr_deriv_strategy ds =+  case ds of+    StockStrategy    -> text "stock"+    AnyclassStrategy -> text "anyclass"+    NewtypeStrategy  -> text "newtype"+    ViaStrategy ty   -> text "via" <+> pprParendType ty++ppr_overlap :: Overlap -> Doc+ppr_overlap o = text $+  case o of+    Overlaps      -> "{-# OVERLAPS #-}"+    Overlappable  -> "{-# OVERLAPPABLE #-}"+    Overlapping   -> "{-# OVERLAPPING #-}"+    Incoherent    -> "{-# INCOHERENT #-}"++ppr_data :: Bool     -- ^ declaration on the toplevel?+         -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]+         -> Doc+ppr_data = ppr_typedef "data"++ppr_newtype :: Bool     -- ^ declaration on the toplevel?+            -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]+            -> Doc+ppr_newtype isTop maybeInst ctxt t argsDoc ksig c decs+  = ppr_typedef "newtype" isTop maybeInst ctxt t argsDoc ksig [c] decs++ppr_type_data :: Bool     -- ^ declaration on the toplevel?+              -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]+              -> Doc+ppr_type_data = ppr_typedef "type data"++ppr_typedef :: String -> Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc+ppr_typedef data_or_newtype isTop maybeInst ctxt t argsDoc ksig cs decs+  = sep [text data_or_newtype <+> maybeInst+            <+> pprCxt ctxt+            <+> case t of+                 Just n -> pprName' Applied n <+> argsDoc+                 Nothing -> argsDoc+            <+> ksigDoc <+> maybeWhere,+         nest nestDepth (layout (pref $ map ppr cs)),+         if null decs+           then empty+           else nest nestDepth+              $ vcat $ map ppr_deriv_clause decs]+  where+    pref :: [Doc] -> [Doc]+    pref xs | isGadtDecl = xs+    pref []              = []      -- No constructors; can't happen in H98+    pref (d:ds)          = (char '=' <+> d):map (bar <+>) ds++    layout :: [Doc] -> Doc+    layout | isGadtDecl && not isTop = braces . semiSepWith id+           | otherwise = vcat++    maybeWhere :: Doc+    maybeWhere | isGadtDecl = text "where"+               | otherwise  = empty++    isGadtDecl :: Bool+    isGadtDecl = not (null cs) && all isGadtCon cs+        where isGadtCon (GadtC _ _ _   ) = True+              isGadtCon (RecGadtC _ _ _) = True+              isGadtCon (ForallC _ _ x ) = isGadtCon x+              isGadtCon  _               = False++    ksigDoc = case ksig of+                Nothing -> empty+                Just k  -> dcolon <+> ppr k+++ppr_deriv_clause :: DerivClause -> Doc+ppr_deriv_clause (DerivClause ds ctxt)+  = text "deriving" <+> pp_strat_before+                    <+> ppr_cxt_preds appPrec ctxt+                    <+> pp_strat_after+  where+    -- @via@ is unique in that in comes /after/ the class being derived,+    -- so we must special-case it.+    (pp_strat_before, pp_strat_after) =+      case ds of+        Just (via@ViaStrategy{}) -> (empty, ppr_deriv_strategy via)+        _                        -> (maybe empty ppr_deriv_strategy ds, empty)++ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc+ppr_tySyn maybeInst t argsDoc rhs+  = text "type" <+> maybeInst+    <+> case t of+         Just n -> pprName' Applied n <+> argsDoc+         Nothing -> argsDoc+    <+> text "=" <+> ppr rhs++ppr_tf_head :: TypeFamilyHead -> Doc+ppr_tf_head (TypeFamilyHead tc tvs res inj)+  = pprName' Applied tc <+> hsep (map ppr tvs) <+> ppr res <+> maybeInj+  where+    maybeInj | (Just inj') <- inj = ppr inj'+             | otherwise          = empty++ppr_bndrs :: PprFlag flag => Maybe [TyVarBndr flag] -> Doc+ppr_bndrs (Just bndrs) = text "forall" <+> sep (map ppr bndrs) <> text "."+ppr_bndrs Nothing = empty++------------------------------+instance Ppr FunDep where+    ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)+    ppr_list [] = empty+    ppr_list xs = bar <+> commaSep xs++------------------------------+instance Ppr FamilyResultSig where+    ppr NoSig           = empty+    ppr (KindSig k)     = dcolon <+> ppr k+    ppr (TyVarSig bndr) = text "=" <+> ppr bndr++------------------------------+instance Ppr InjectivityAnn where+    ppr (InjectivityAnn lhs rhs) =+        bar <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)++------------------------------+instance Ppr Foreign where+    ppr (ImportF callconv safety impent as typ)+       = text "foreign import"+     <+> showtextl callconv+     <+> showtextl safety+     <+> text (show impent)+     <+> pprName' Applied as+     <+> dcolon <+> ppr typ+    ppr (ExportF callconv expent as typ)+        = text "foreign export"+      <+> showtextl callconv+      <+> text (show expent)+      <+> pprName' Applied as+      <+> dcolon <+> ppr typ++------------------------------+instance Ppr Pragma where+    ppr (InlineP n inline rm phases)+       = text "{-#"+     <+> ppr inline+     <+> ppr rm+     <+> ppr phases+     <+> pprName' Applied n+     <+> text "#-}"+    ppr (OpaqueP n)+       = text "{-# OPAQUE" <+> pprName' Applied n <+> text "#-}"+    ppr (SpecialiseP n ty inline phases)+       =   text "{-# SPECIALISE"+       <+> maybe empty ppr inline+       <+> ppr phases+       <+> sep [ pprName' Applied n <+> dcolon+               , nest 2 $ ppr ty ]+       <+> text "#-}"+    ppr (SpecialiseInstP inst)+       = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"+    ppr (RuleP n ty_bndrs tm_bndrs lhs rhs phases)+       = sep [ text "{-# RULES" <+> pprString n <+> ppr phases+             , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs+                                               <+> ppr lhs+             , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]+      where ppr_ty_forall Nothing      = empty+            ppr_ty_forall (Just bndrs) = text "forall"+                                         <+> fsep (map ppr bndrs)+                                         <+> char '.'+            ppr_tm_forall Nothing | null tm_bndrs = empty+            ppr_tm_forall _ = text "forall"+                              <+> fsep (map ppr tm_bndrs)+                              <+> char '.'+    ppr (AnnP tgt expr)+       = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}"+      where target1 ModuleAnnotation    = text "module"+            target1 (TypeAnnotation t)  = text "type" <+> pprName' Applied t+            target1 (ValueAnnotation v) = pprName' Applied v+    ppr (LineP line file)+       = text "{-# LINE" <+> int line <+> text (show file) <+> text "#-}"+    ppr (CompleteP cls mty)+       = text "{-# COMPLETE" <+> (fsep $ punctuate comma $ map (pprName' Applied) cls)+                <+> maybe empty (\ty -> dcolon <+> pprName' Applied ty) mty <+> text "#-}"+    ppr (SCCP nm str)+       = text "{-# SCC" <+> pprName' Applied nm <+> maybe empty pprString str <+> text "#-}"++------------------------------+instance Ppr Inline where+    ppr NoInline  = text "NOINLINE"+    ppr Inline    = text "INLINE"+    ppr Inlinable = text "INLINABLE"++------------------------------+instance Ppr RuleMatch where+    ppr ConLike = text "CONLIKE"+    ppr FunLike = empty++------------------------------+instance Ppr Phases where+    ppr AllPhases       = empty+    ppr (FromPhase i)   = brackets $ int i+    ppr (BeforePhase i) = brackets $ char '~' <> int i++------------------------------+instance Ppr RuleBndr where+    ppr (RuleVar n)         = ppr n+    ppr (TypedRuleVar n ty) = parens $ ppr n <+> dcolon <+> ppr ty++------------------------------+instance Ppr Clause where+    ppr = pprClause True++------------------------------+instance Ppr Con where+    ppr (NormalC c sts) = pprName' Applied c <+> sep (map pprBangType sts)++    ppr (RecC c vsts)+        = pprName' Applied c <+> braces (sep (punctuate comma $ map pprVarBangType vsts))++    ppr (InfixC st1 c st2) = pprBangType st1+                         <+> pprName' Infix c+                         <+> pprBangType st2++    ppr (ForallC ns ctxt (GadtC cs sts ty))+        = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt+      <+> pprGadtRHS sts ty++    ppr (ForallC ns ctxt (RecGadtC cs vsts ty))+        = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt+      <+> pprRecFields vsts ty++    ppr (ForallC ns ctxt con)+        = pprForall ns ctxt <+> ppr con++    ppr (GadtC cs sts ty)+        = commaSepApplied cs <+> dcolon <+> pprGadtRHS sts ty++    ppr (RecGadtC cs vsts ty)+        = commaSepApplied cs <+> dcolon <+> pprRecFields vsts ty++instance Ppr PatSynDir where+  ppr Unidir        = text "<-"+  ppr ImplBidir     = text "="+  ppr (ExplBidir _) = text "<-"+    -- the ExplBidir's clauses are pretty printed together with the+    -- entire pattern synonym; so only print the direction here.++instance Ppr PatSynArgs where+  ppr (PrefixPatSyn args) = sep $ map ppr args+  ppr (InfixPatSyn a1 a2) = ppr a1 <+> ppr a2+  ppr (RecordPatSyn sels) = braces $ sep (punctuate comma (map (pprName' Applied) sels))++commaSepApplied :: [Name] -> Doc+commaSepApplied = commaSepWith (pprName' Applied)++pprForall :: [TyVarBndr Specificity] -> Cxt -> Doc+pprForall = pprForall' ForallInvis++pprForallVis :: [TyVarBndr ()] -> Cxt -> Doc+pprForallVis = pprForall' ForallVis++pprForall' :: PprFlag flag => ForallVisFlag -> [TyVarBndr flag] -> Cxt -> Doc+pprForall' fvf tvs cxt+  -- even in the case without any tvs, there could be a non-empty+  -- context cxt (e.g., in the case of pattern synonyms, where there+  -- are multiple forall binders and contexts).+  | [] <- tvs = pprCxt cxt+  | otherwise = text "forall" <+> hsep (map ppr tvs)+                              <+> separator <+> pprCxt cxt+  where+    separator = case fvf of+                  ForallVis   -> text "->"+                  ForallInvis -> char '.'++pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc+pprRecFields vsts ty+    = braces (sep (punctuate comma $ map pprVarBangType vsts))+  <+> arrow <+> ppr ty++pprGadtRHS :: [(Strict, Type)] -> Type -> Doc+pprGadtRHS [] ty+    = ppr ty+pprGadtRHS sts ty+    = sep (punctuate (space <> arrow) (map pprBangType sts))+  <+> arrow <+> ppr ty++------------------------------+pprVarBangType :: VarBangType -> Doc+-- Slight infelicity: with print non-atomic type with parens+pprVarBangType (v, bang, t) = pprName' Applied v <+> dcolon <+> pprBangType (bang, t)++------------------------------+pprBangType :: BangType -> Doc+-- Make sure we print+--+-- Con {-# UNPACK #-} a+--+-- rather than+--+-- Con {-# UNPACK #-}a+--+-- when there's no strictness annotation. If there is a strictness annotation,+-- it's okay to not put a space between it and the type.+pprBangType (bt@(Bang _ NoSourceStrictness), t) = ppr bt <+> pprParendType t+pprBangType (bt, t) = ppr bt <> pprParendType t++------------------------------+instance Ppr Bang where+    ppr (Bang su ss) = ppr su <+> ppr ss++------------------------------+instance Ppr SourceUnpackedness where+    ppr NoSourceUnpackedness = empty+    ppr SourceNoUnpack       = text "{-# NOUNPACK #-}"+    ppr SourceUnpack         = text "{-# UNPACK #-}"++------------------------------+instance Ppr SourceStrictness where+    ppr NoSourceStrictness = empty+    ppr SourceLazy         = char '~'+    ppr SourceStrict       = char '!'++------------------------------+instance Ppr DecidedStrictness where+    ppr DecidedLazy   = empty+    ppr DecidedStrict = char '!'+    ppr DecidedUnpack = text "{-# UNPACK #-} !"++------------------------------+{-# DEPRECATED pprVarStrictType+               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'pprVarBangType' instead." #-}+pprVarStrictType :: (Name, Strict, Type) -> Doc+pprVarStrictType = pprVarBangType++------------------------------+{-# DEPRECATED pprStrictType+               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'pprBangType' instead." #-}+pprStrictType :: (Strict, Type) -> Doc+pprStrictType = pprBangType++------------------------------+pprType :: Precedence -> Type -> Doc+pprType _ (VarT v)               = pprName' Applied v+-- `Applied` is used here instead of `ppr` because of infix names (#13887)+pprType _ (ConT c)               = pprName' Applied c+pprType _ (TupleT 0)             = text "()"+pprType p (TupleT 1)             = pprType p (ConT (tupleTypeName 1))+pprType _ (TupleT n)             = parens (hcat (replicate (n-1) comma))+pprType _ (UnboxedTupleT n)      = hashParens $ hcat $ replicate (n-1) comma+pprType _ (UnboxedSumT arity)    = hashParens $ hsep $ replicate (arity-1) bar+pprType _ ArrowT                 = parens (text "->")+pprType _ MulArrowT              = text "FUN"+pprType _ ListT                  = text "[]"+pprType _ (LitT l)               = pprTyLit l+pprType _ (PromotedT c)          = text "'" <> pprName' Applied c+pprType _ (PromotedTupleT 0)     = text "'()"+pprType p (PromotedTupleT 1)     = pprType p (PromotedT (tupleDataName 1))+pprType _ (PromotedTupleT n)     = quoteParens (hcat (replicate (n-1) comma))+pprType _ PromotedNilT           = text "'[]"+pprType _ PromotedConsT          = text "'(:)"+pprType _ StarT                  = char '*'+pprType _ ConstraintT            = text "Constraint"+pprType _ (SigT ty k)            = parens (ppr ty <+> text "::" <+> ppr k)+pprType _ WildCardT              = char '_'+pprType p t@(InfixT {})          = pprInfixT p t+pprType p t@(UInfixT {})         = pprInfixT p t+pprType p t@(PromotedInfixT {})  = pprInfixT p t+pprType p t@(PromotedUInfixT {}) = pprInfixT p t+pprType _ (ParensT t)            = parens (pprType noPrec t)+pprType p (ImplicitParamT n ty) =+  parensIf (p >= sigPrec) $ text ('?':n) <+> text "::" <+> pprType sigPrec ty+pprType _ EqualityT              = text "(~)"+pprType p (ForallT tvars ctxt ty) =+  parensIf (p >= funPrec) $ sep [pprForall tvars ctxt, pprType qualPrec ty]+pprType p (ForallVisT tvars ty) =+  parensIf (p >= funPrec) $ sep [pprForallVis tvars [], pprType qualPrec ty]+pprType p t@AppT{}               = pprTyApp p (split t)+pprType p t@AppKindT{}           = pprTyApp p (split t)++------------------------------+pprParendType :: Type -> Doc+pprParendType = pprType appPrec++pprInfixT :: Precedence -> Type -> Doc+pprInfixT p = \case+  InfixT x n y          -> with x n y ""  opPrec+  UInfixT x n y         -> with x n y ""  unopPrec+  PromotedInfixT x n y  -> with x n y "'" opPrec+  PromotedUInfixT x n y -> with x n y "'" unopPrec+  t                     -> pprParendType t+  where+    with x n y prefix p' =+      parensIf+        (p >= p')+        (pprType opPrec x <+> text prefix <> pprName' Infix n <+> pprType opPrec y)++instance Ppr Type where+    ppr = pprType noPrec+instance Ppr TypeArg where+    ppr (TANormal ty) = ppr ty+    ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki)++pprParendTypeArg :: TypeArg -> Doc+pprParendTypeArg (TANormal ty) = pprParendType ty+pprParendTypeArg (TyArg ki) = char '@' <> parensIf (isStarT ki) (pprParendType ki)++isStarT :: Type -> Bool+isStarT StarT = True+isStarT _ = False++{- Note [Pretty-printing kind signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHC's parser only recognises a kind signature in a type when there are+parens around it.  E.g. the parens are required here:+   f :: (Int :: *)+   type instance F Int = (Bool :: *)+So we always print a SigT with parens (see #10050). -}++pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc+pprTyApp p app@(MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2])+  | p >= funPrec  = parens (pprTyApp noPrec app)+  | c == oneName  = sep [pprFunArgType arg1 <+> text "%1 ->", pprType qualPrec arg2]+  | c == manyName = sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2]+pprTyApp p (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) =+  parensIf (p >= funPrec) $+    sep [pprFunArgType arg1 <+> text "%" <> pprType appPrec argm <+> text "->",+         pprType qualPrec arg2]+pprTyApp p (ArrowT, [TANormal arg1, TANormal arg2]) =+  parensIf (p >= funPrec) $+    sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2]+pprTyApp p (EqualityT, [TANormal arg1, TANormal arg2]) =+  parensIf (p >= opPrec) $+    sep [pprType opPrec arg1 <+> text "~", pprType opPrec arg2]+pprTyApp _ (ListT, [TANormal arg]) = brackets (pprType noPrec arg)+pprTyApp p (TupleT 1, args) = pprTyApp p (ConT (tupleTypeName 1), args)+pprTyApp _ (TupleT n, args)+ | length args == n, Just args' <- traverse fromTANormal args+ = parens (commaSep args')+pprTyApp p (PromotedTupleT 1, args) = pprTyApp p (PromotedT (tupleDataName 1), args)+pprTyApp _ (PromotedTupleT n, args)+ | length args == n, Just args' <- traverse fromTANormal args+ = quoteParens (commaSep args')+pprTyApp _ (UnboxedTupleT n, args)+ | length args == n, Just args' <- traverse fromTANormal args+ = hashParens (commaSep args')+pprTyApp _ (UnboxedSumT n, args)+ | length args == n, Just args' <- traverse fromTANormal args+ = hashParens (sep $ intersperse bar $ map ppr args')+pprTyApp p (fun, args) =+  parensIf (p >= appPrec) $ pprParendType fun <+> sep (map pprParendTypeArg args)++fromTANormal :: TypeArg -> Maybe Type+fromTANormal (TANormal arg) = Just arg+fromTANormal (TyArg _) = Nothing++-- Print the type to the left of @->@. Everything except forall and (->) binds more tightly than (->).+pprFunArgType :: Type -> Doc+pprFunArgType = pprType funPrec++data ForallVisFlag = ForallVis   -- forall a -> {...}+                   | ForallInvis -- forall a.   {...}+  deriving Show++data TypeArg = TANormal Type+             | TyArg Kind++split :: Type -> (Type, [TypeArg])    -- Split into function and args+split t = go t []+    where go (AppT t1 t2) args = go t1 (TANormal t2:args)+          go (AppKindT ty ki) args = go ty (TyArg ki:args)+          go ty           args = (ty, args)++pprTyLit :: TyLit -> Doc+pprTyLit (NumTyLit n) = integer n+pprTyLit (StrTyLit s) = text (show s)+pprTyLit (CharTyLit c) = text (show c)++instance Ppr TyLit where+  ppr = pprTyLit++------------------------------+class PprFlag flag where+    pprTyVarBndr :: (TyVarBndr flag) -> Doc++instance PprFlag () where+    pprTyVarBndr (PlainTV nm ())    = ppr nm+    pprTyVarBndr (KindedTV nm () k) = parens (ppr nm <+> dcolon <+> ppr k)++instance PprFlag Specificity where+    pprTyVarBndr (PlainTV nm SpecifiedSpec)    = ppr nm+    pprTyVarBndr (PlainTV nm InferredSpec)     = braces (ppr nm)+    pprTyVarBndr (KindedTV nm SpecifiedSpec k) = parens (ppr nm <+> dcolon <+> ppr k)+    pprTyVarBndr (KindedTV nm InferredSpec  k) = braces (ppr nm <+> dcolon <+> ppr k)++instance PprFlag BndrVis where+    pprTyVarBndr (PlainTV nm vis)    = pprBndrVis vis (ppr nm)+    pprTyVarBndr (KindedTV nm vis k) = pprBndrVis vis (parens (ppr nm <+> dcolon <+> ppr k))++pprBndrVis :: BndrVis -> Doc -> Doc+pprBndrVis BndrReq   d = d+pprBndrVis BndrInvis d = char '@' <> d++instance PprFlag flag => Ppr (TyVarBndr flag) where+    ppr bndr = pprTyVarBndr bndr++instance Ppr Role where+    ppr NominalR          = text "nominal"+    ppr RepresentationalR = text "representational"+    ppr PhantomR          = text "phantom"+    ppr InferR            = text "_"++------------------------------+pprCtxWith :: Ppr a => (Precedence -> a -> Doc) -> [a] -> Doc+pprCtxWith _ [] = empty+pprCtxWith ppr_fun ts = ppr_ctx_preds_with ppr_fun funPrec ts <+> text "=>"++pprCxt :: Cxt -> Doc+pprCxt = pprCtxWith pprType++ppr_ctx_preds_with :: Ppr a => (Precedence -> a -> Doc) -> Precedence -> [a] -> Doc+ppr_ctx_preds_with _ _ [] = text "()"+ppr_ctx_preds_with f p [t] = f p t+ppr_ctx_preds_with _ _ ts = parens (commaSep ts)++ppr_cxt_preds :: Precedence -> Cxt -> Doc+ppr_cxt_preds = ppr_ctx_preds_with pprType++------------------------------+instance Ppr Range where+    ppr = brackets . pprRange+        where pprRange :: Range -> Doc+              pprRange (FromR e) = ppr e <+> text ".."+              pprRange (FromThenR e1 e2) = ppr e1 <> text ","+                                           <+> ppr e2 <+> text ".."+              pprRange (FromToR e1 e2) = ppr e1 <+> text ".." <+> ppr e2+              pprRange (FromThenToR e1 e2 e3) = ppr e1 <> text ","+                                             <+> ppr e2 <+> text ".."+                                             <+> ppr e3++------------------------------+where_clause :: [Dec] -> Doc+where_clause [] = empty+where_clause ds = nest nestDepth $ text "where" <+> braces (semiSepWith (ppr_dec False) ds)++showtextl :: Show a => a -> Doc+showtextl = text . map toLower . show++hashParens :: Doc -> Doc+hashParens d = text "(# " <> d <> text " #)"++quoteParens :: Doc -> Doc+quoteParens d = text "'(" <> d <> text ")"++-----------------------------+instance Ppr Loc where+  ppr (Loc { loc_module = md+           , loc_package = pkg+           , loc_start = (start_ln, start_col)+           , loc_end = (end_ln, end_col) })+    = hcat [ text pkg, colon, text md, colon+           , parens $ int start_ln <> comma <> int start_col+           , text "-"+           , parens $ int end_ln <> comma <> int end_col ]++-- Takes a separator and a pretty-printing function and prints a list of things+-- separated by the separator followed by space.+sepWith :: Doc -> (a -> Doc) -> [a] -> Doc+sepWith sepDoc pprFun = sep . punctuate sepDoc . map pprFun++-- Takes a list of printable things and prints them separated by commas followed+-- by space.+commaSep :: Ppr a => [a] -> Doc+commaSep = commaSepWith ppr++-- Takes a list of things and prints them with the given pretty-printing+-- function, separated by commas followed by space.+commaSepWith :: (a -> Doc) -> [a] -> Doc+commaSepWith pprFun = sepWith comma pprFun++-- Takes a list of printable things and prints them separated by semicolons+-- followed by space.+semiSep :: Ppr a => [a] -> Doc+semiSep = sep . punctuate semi . map ppr++-- Takes a list of things and prints them with the given pretty-printing+-- function, separated by semicolons followed by space.+semiSepWith :: (a -> Doc) -> [a] -> Doc+semiSepWith pprFun = sepWith semi pprFun++-- Prints out the series of vertical bars that wraps an expression or pattern+-- used in an unboxed sum.+unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc+unboxedSumBars d alt arity = hashParens $+    bars (alt-1) <> d <> bars (arity - alt)+  where+    bars i = hsep (replicate i bar)++-- Text containing the vertical bar character.+bar :: Doc+bar = char '|'
+ libraries/ghc-boot-th-internal/GHC/Internal/TH/PprLib.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE FlexibleInstances, Safe #-}++-- | Monadic front-end to Text.PrettyPrint++module GHC.Internal.TH.PprLib (++        -- * The document type+        Doc,            -- Abstract, instance of Show+        PprM,++        -- * Primitive Documents+        empty,+        semi, comma, colon, dcolon, space, equals, arrow,+        lparen, rparen, lbrack, rbrack, lbrace, rbrace,++        -- * Converting values into documents+        text, char, ptext,+        int, integer, float, double, rational,++        -- * Wrapping documents in delimiters+        parens, brackets, braces, quotes, doubleQuotes,++        -- * Combining documents+        (<>), (<+>), hcat, hsep,+        ($$), ($+$), vcat,+        sep, cat,+        fsep, fcat,+        nest,+        hang, punctuate,++        -- * Predicates on documents+        isEmpty,++    to_HPJ_Doc, pprName, pprName'+  ) where+++import GHC.Internal.TH.Syntax+    (Uniq, Name(..), showName', NameFlavour(..), NameIs(..))+import qualified Text.PrettyPrint as HPJ+import Control.Monad (liftM, liftM2, ap)+import GHC.Internal.TH.Lib.Map ( Map )+import qualified GHC.Internal.TH.Lib.Map as Map ( lookup, insert, empty )+import Prelude hiding ((<>))++infixl 6 <>+infixl 6 <+>+infixl 5 $$, $+$++-- ---------------------------------------------------------------------------+-- The interface++-- The primitive Doc values++instance Show Doc where+   show d = HPJ.render (to_HPJ_Doc d)++isEmpty :: Doc    -> PprM Bool;  -- ^ Returns 'True' if the document is empty++empty   :: Doc;                 -- ^ An empty document+semi    :: Doc;                 -- ^ A ';' character+comma   :: Doc;                 -- ^ A ',' character+colon   :: Doc;                 -- ^ A ':' character+dcolon  :: Doc;                 -- ^ A "::" string+space   :: Doc;                 -- ^ A space character+equals  :: Doc;                 -- ^ A '=' character+arrow   :: Doc;                 -- ^ A "->" string+lparen  :: Doc;                 -- ^ A '(' character+rparen  :: Doc;                 -- ^ A ')' character+lbrack  :: Doc;                 -- ^ A '[' character+rbrack  :: Doc;                 -- ^ A ']' character+lbrace  :: Doc;                 -- ^ A '{' character+rbrace  :: Doc;                 -- ^ A '}' character++text     :: String   -> Doc+ptext    :: String   -> Doc+char     :: Char     -> Doc+int      :: Int      -> Doc+integer  :: Integer  -> Doc+float    :: Float    -> Doc+double   :: Double   -> Doc+rational :: Rational -> Doc+++parens       :: Doc -> Doc;     -- ^ Wrap document in @(...)@+brackets     :: Doc -> Doc;     -- ^ Wrap document in @[...]@+braces       :: Doc -> Doc;     -- ^ Wrap document in @{...}@+quotes       :: Doc -> Doc;     -- ^ Wrap document in @\'...\'@+doubleQuotes :: Doc -> Doc;     -- ^ Wrap document in @\"...\"@++-- Combining @Doc@ values++(<>)   :: Doc -> Doc -> Doc;     -- ^Beside+hcat   :: [Doc] -> Doc;          -- ^List version of '<>'+(<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space+hsep   :: [Doc] -> Doc;          -- ^List version of '<+>'++($$)   :: Doc -> Doc -> Doc;     -- ^Above; if there is no+                                 -- overlap it \"dovetails\" the two+($+$)  :: Doc -> Doc -> Doc;     -- ^Above, without dovetailing.+vcat   :: [Doc] -> Doc;          -- ^List version of '$$'++cat    :: [Doc] -> Doc;          -- ^ Either hcat or vcat+sep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat+fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of cat+fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of sep++nest   :: Int -> Doc -> Doc;     -- ^ Nested+++-- GHC-specific ones.++hang :: Doc -> Int -> Doc -> Doc;      -- ^ @hang d1 n d2 = sep [d1, nest n d2]@+punctuate :: Doc -> [Doc] -> [Doc]+   -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@++-- ---------------------------------------------------------------------------+-- The "implementation"++type State = (Map Name Name, Uniq)+data PprM a = PprM { runPprM :: State -> (a, State) }++pprName :: Name -> Doc+pprName = pprName' Alone++pprName' :: NameIs -> Name -> Doc+pprName' ni n@(Name o (NameU _))+ = PprM $ \s@(fm, i)+        -> let (n', s') = case Map.lookup n fm of+                         Just d -> (d, s)+                         Nothing -> let n'' = Name o (NameU i)+                                    in (n'', (Map.insert n n'' fm, i + 1))+           in (HPJ.text $ showName' ni n', s')+pprName' ni n = text $ showName' ni n++{-+instance Show Name where+  show (Name occ (NameU u))    = occString occ ++ "_" ++ show (I# u)+  show (Name occ NameS)        = occString occ+  show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ++data Name = Name OccName NameFlavour++data NameFlavour+  | NameU Int#                  -- A unique local name+-}++to_HPJ_Doc :: Doc -> HPJ.Doc+to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)++instance Functor PprM where+      fmap = liftM++instance Applicative PprM where+      pure x = PprM $ \s -> (x, s)+      (<*>) = ap++instance Monad PprM where+    m >>= k  = PprM $ \s -> let (x, s') = runPprM m s+                            in runPprM (k x) s'++type Doc = PprM HPJ.Doc++-- The primitive Doc values++isEmpty = liftM HPJ.isEmpty++empty = return HPJ.empty+semi = return HPJ.semi+comma = return HPJ.comma+colon = return HPJ.colon+dcolon = return $ HPJ.text "::"+space = return HPJ.space+equals = return HPJ.equals+arrow = return $ HPJ.text "->"+lparen = return HPJ.lparen+rparen = return HPJ.rparen+lbrack = return HPJ.lbrack+rbrack = return HPJ.rbrack+lbrace = return HPJ.lbrace+rbrace = return HPJ.rbrace++text = return . HPJ.text+ptext = return . HPJ.ptext+char = return . HPJ.char+int = return . HPJ.int+integer = return . HPJ.integer+float = return . HPJ.float+double = return . HPJ.double+rational = return . HPJ.rational+++parens = liftM HPJ.parens+brackets = liftM HPJ.brackets+braces = liftM HPJ.braces+quotes = liftM HPJ.quotes+doubleQuotes = liftM HPJ.doubleQuotes++-- Combining @Doc@ values++(<>) = liftM2 (HPJ.<>)+hcat = liftM HPJ.hcat . sequence+(<+>) = liftM2 (HPJ.<+>)+hsep = liftM HPJ.hsep . sequence++($$) = liftM2 (HPJ.$$)+($+$) = liftM2 (HPJ.$+$)+vcat = liftM HPJ.vcat . sequence++cat  = liftM HPJ.cat . sequence+sep  = liftM HPJ.sep . sequence+fcat = liftM HPJ.fcat . sequence+fsep = liftM HPJ.fsep . sequence++nest n = liftM (HPJ.nest n)++hang d1 n d2 = do d1' <- d1+                  d2' <- d2+                  return (HPJ.hang d1' n d2')++-- punctuate uses the same definition as Text.PrettyPrint+punctuate _ []     = []+punctuate p (d:ds) = go d ds+                   where+                     go d' [] = [d']+                     go d' (e:es) = (d' <> p) : go e es
libraries/ghc-boot-th/GHC/ForeignSrcLang/Type.hs view
@@ -1,18 +1,5 @@-{-# LANGUAGE DeriveGeneric #-} module GHC.ForeignSrcLang.Type   ( ForeignSrcLang(..)   ) where -import Prelude -- See note [Why do we import Prelude here?]-import GHC.Generics (Generic)---- | Foreign formats supported by GHC via TH-data ForeignSrcLang-  = LangC      -- ^ C-  | LangCxx    -- ^ C++-  | LangObjc   -- ^ Objective C-  | LangObjcxx -- ^ Objective C++-  | LangAsm    -- ^ Assembly language (.s)-  | LangJs     -- ^ JavaScript-  | RawObject  -- ^ Object (.o)-  deriving (Eq, Show, Generic)+import GHC.Internal.ForeignSrcLang
libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs view
@@ -8,155 +8,7 @@ -- -- A data type defining the language extensions supported by GHC. ---{-# LANGUAGE DeriveGeneric, Safe #-}+{-# LANGUAGE Safe #-} module GHC.LanguageExtensions.Type ( Extension(..) ) where -import Prelude -- See note [Why do we import Prelude here?]-import GHC.Generics---- | The language extensions known to GHC.------ Note that there is an orphan 'Binary' instance for this type supplied by--- the "GHC.LanguageExtensions" module provided by @ghc-boot@. We can't provide--- here as this would require adding transitive dependencies to the--- @template-haskell@ package, which must have a minimal dependency set.-data Extension--- See Note [Updating flag description in the User's Guide] in--- GHC.Driver.Session-   = Cpp-   | OverlappingInstances-   | UndecidableInstances-   | IncoherentInstances-   | UndecidableSuperClasses-   | MonomorphismRestriction-   | MonoLocalBinds-   | DeepSubsumption-   | RelaxedPolyRec           -- Deprecated-   | ExtendedDefaultRules     -- Use GHC's extended rules for defaulting-   | ForeignFunctionInterface-   | UnliftedFFITypes-   | InterruptibleFFI-   | CApiFFI-   | GHCForeignImportPrim-   | JavaScriptFFI-   | ParallelArrays           -- Syntactic support for parallel arrays-   | Arrows                   -- Arrow-notation syntax-   | TemplateHaskell-   | TemplateHaskellQuotes    -- subset of TH supported by stage1, no splice-   | QualifiedDo-   | QuasiQuotes-   | ImplicitParams-   | ImplicitPrelude-   | ScopedTypeVariables-   | AllowAmbiguousTypes-   | UnboxedTuples-   | UnboxedSums-   | UnliftedNewtypes-   | UnliftedDatatypes-   | BangPatterns-   | TypeFamilies-   | TypeFamilyDependencies-   | TypeInType               -- Deprecated-   | OverloadedStrings-   | OverloadedLists-   | NumDecimals-   | DisambiguateRecordFields-   | RecordWildCards-   | NamedFieldPuns-   | ViewPatterns-   | GADTs-   | GADTSyntax-   | NPlusKPatterns-   | DoAndIfThenElse-   | BlockArguments-   | RebindableSyntax-   | ConstraintKinds-   | PolyKinds                -- Kind polymorphism-   | DataKinds                -- Datatype promotion-   | TypeData                 -- allow @type data@ definitions-   | InstanceSigs-   | ApplicativeDo-   | LinearTypes-   | RequiredTypeArguments    -- Visible forall (VDQ) in types of terms--   | StandaloneDeriving-   | DeriveDataTypeable-   | AutoDeriveTypeable       -- Automatic derivation of Typeable-   | DeriveFunctor-   | DeriveTraversable-   | DeriveFoldable-   | DeriveGeneric            -- Allow deriving Generic/1-   | DefaultSignatures        -- Allow extra signatures for defmeths-   | DeriveAnyClass           -- Allow deriving any class-   | DeriveLift               -- Allow deriving Lift-   | DerivingStrategies-   | DerivingVia              -- Derive through equal representation--   | TypeSynonymInstances-   | FlexibleContexts-   | FlexibleInstances-   | ConstrainedClassMethods-   | MultiParamTypeClasses-   | NullaryTypeClasses-   | FunctionalDependencies-   | UnicodeSyntax-   | ExistentialQuantification-   | MagicHash-   | EmptyDataDecls-   | KindSignatures-   | RoleAnnotations-   | ParallelListComp-   | TransformListComp-   | MonadComprehensions-   | GeneralizedNewtypeDeriving-   | RecursiveDo-   | PostfixOperators-   | TupleSections-   | PatternGuards-   | LiberalTypeSynonyms-   | RankNTypes-   | ImpredicativeTypes-   | TypeOperators-   | ExplicitNamespaces-   | PackageImports-   | ExplicitForAll-   | AlternativeLayoutRule-   | AlternativeLayoutRuleTransitional-   | DatatypeContexts-   | NondecreasingIndentation-   | RelaxedLayout-   | TraditionalRecordSyntax-   | LambdaCase-   | MultiWayIf-   | BinaryLiterals-   | NegativeLiterals-   | HexFloatLiterals-   | DuplicateRecordFields-   | OverloadedLabels-   | EmptyCase-   | PatternSynonyms-   | PartialTypeSignatures-   | NamedWildCards-   | StaticPointers-   | TypeApplications-   | Strict-   | StrictData-   | EmptyDataDeriving-   | NumericUnderscores-   | QuantifiedConstraints-   | StarIsType-   | ImportQualifiedPost-   | CUSKs-   | StandaloneKindSignatures-   | LexicalNegation-   | FieldSelectors-   | OverloadedRecordDot-   | OverloadedRecordUpdate-   | TypeAbstractions-   | ExtendedLiterals-   | ListTuplePuns-   deriving (Eq, Enum, Show, Generic, Bounded)--- 'Ord' and 'Bounded' are provided for GHC API users (see discussions--- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and--- https://gitlab.haskell.org/ghc/ghc/merge_requests/826).-instance Ord Extension where compare a b = compare (fromEnum a) (fromEnum b)+import GHC.Internal.LanguageExtensions
libraries/ghc-boot-th/GHC/Lexeme.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Lexeme@@ -14,37 +15,4 @@         startsVarSymASCII, isVarSymChar, okSymChar   ) where -import Prelude -- See note [Why do we import Prelude here?]-import Data.Char---- | Is this character acceptable in a symbol (after the first char)?--- See alexGetByte in GHC.Parser.Lexer-okSymChar :: Char -> Bool-okSymChar c-  | c `elem` "(),;[]`{}_\"'"-  = False-  | otherwise-  = case generalCategory c of-      ConnectorPunctuation -> True-      DashPunctuation      -> True-      OtherPunctuation     -> True-      MathSymbol           -> True-      CurrencySymbol       -> True-      ModifierSymbol       -> True-      OtherSymbol          -> True-      _                    -> False--startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool-startsVarSym c = okSymChar c && c /= ':' -- Infix Ids-startsConSym c = c == ':'                -- Infix data constructors-startsVarId c  = c == '_' || case generalCategory c of  -- Ordinary Ids-  LowercaseLetter -> True-  OtherLetter     -> True   -- See #1103-  _               -> False-startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors--startsVarSymASCII :: Char -> Bool-startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"--isVarSymChar :: Char -> Bool-isVarSymChar c = c == ':' || startsVarSym c+import GHC.Internal.Lexeme
libraries/ghc-boot-th/ghc-boot-th.cabal view
@@ -3,7 +3,7 @@ -- ghc-boot-th.cabal.in, not ghc-boot-th.cabal.  name:           ghc-boot-th-version:        9.10.3+version:        9.12.1 license:        BSD3 license-file:   LICENSE category:       GHC@@ -26,14 +26,49 @@     location: https://gitlab.haskell.org/ghc/ghc.git     subdir:   libraries/ghc-boot-th +Flag bootstrap+        Description:+          Enabled when building the stage1 compiler in order to vendor the in-tree+          `ghc-boot-th` library, and through that the in-tree TH AST defintions from+          `ghc-internal`.+          See Note [Bootstrapping Template Haskell]+        Default: False+        Manual: True+ Library     default-language: Haskell2010     other-extensions: DeriveGeneric     default-extensions: NoImplicitPrelude      exposed-modules:-            GHC.LanguageExtensions.Type             GHC.ForeignSrcLang.Type+            GHC.Internal.TH.Lib.Map+            GHC.Internal.TH.Ppr+            GHC.Internal.TH.PprLib+            GHC.LanguageExtensions.Type             GHC.Lexeme -    build-depends: base       >= 4.7 && < 4.21+    build-depends:+        base       >= 4.7 && < 4.22,+        ghc-prim,+        pretty      == 1.1.*++    if flag(bootstrap)+        cpp-options: -DBOOTSTRAP_TH+        hs-source-dirs: . ../ghc-internal/src+        exposed-modules:+            GHC.Internal.TH.Lib+            GHC.Internal.TH.Syntax+        other-modules:+            GHC.Internal.ForeignSrcLang+            GHC.Internal.LanguageExtensions+            GHC.Internal.Lexeme+    else+        hs-source-dirs: .+        build-depends:+            ghc-internal+        reexported-modules:+            GHC.Internal.TH.Lib,+            GHC.Internal.TH.Lift,+            GHC.Internal.TH.Quote,+            GHC.Internal.TH.Syntax
libraries/ghc-boot/GHC/Data/ShortText.hs view
@@ -24,6 +24,10 @@  -- Very similar to FastString, but not hash-consed and with some extra instances and -- functions for serialisation and I/O. Should be imported qualified.+--+-- /Note:/ This string is stored in Modified UTF8 format,+-- thus it's not byte-compatible with @ShortText@ type in @text-short@+-- package.  module GHC.Data.ShortText (         -- * ShortText
libraries/ghc-boot/GHC/Data/SizedSeq.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE StandaloneDeriving, DeriveGeneric, CPP #-}+{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-} module GHC.Data.SizedSeq   ( SizedSeq(..)   , emptySS@@ -11,12 +11,9 @@ import Prelude -- See note [Why do we import Prelude here?] import Control.DeepSeq import Data.Binary+import Data.List (genericLength) import GHC.Generics -#if ! MIN_VERSION_base(4,20,0)-import Data.List (foldl')-#endif- data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a]   deriving (Generic, Show) @@ -40,9 +37,9 @@ addToSS :: SizedSeq a -> a -> SizedSeq a addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs) --- NB, important this is eta-expand so that foldl' is inlined. addListToSS :: SizedSeq a -> [a] -> SizedSeq a-addListToSS s xs = foldl' addToSS s xs+addListToSS (SizedSeq n r_xs) xs+  = SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)  ssElts :: SizedSeq a -> [a] ssElts (SizedSeq _ r_xs) = reverse r_xs
libraries/ghc-boot/GHC/Settings/Utils.hs view
@@ -8,6 +8,7 @@  import GHC.BaseDir import GHC.Platform.ArchOS+import System.FilePath  maybeRead :: Read a => String -> Maybe a maybeRead str = case reads str of@@ -41,6 +42,12 @@ getTargetArchOS settingsFile settings =   ArchOS <$> readRawSetting settingsFile settings "target arch"          <*> readRawSetting settingsFile settings "target os"++getGlobalPackageDb :: FilePath -> RawSettings -> Either String FilePath+getGlobalPackageDb settingsFile settings = do+  rel_db <- getRawSetting settingsFile settings "Relative Global Package DB"+  return (dropFileName settingsFile </> rel_db)+   getRawSetting
libraries/ghc-boot/GHC/Utils/Encoding.hs view
@@ -79,7 +79,7 @@         :+              ZCzp         ()              Z0T     0-tuple         (,,,,)          Z5T     5-tuple-        (# #)           Z1H     unboxed 1-tuple (note the space)+        (##)            Z0H     unboxed 0-tuple         (#,,,,#)        Z5H     unboxed 5-tuple -} @@ -212,7 +212,6 @@     go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest     go 0 ('T':rest)     = "()" ++ zDecodeString rest     go n ('T':rest)     = '(' : replicate (n-1) ',' ++ ")" ++ zDecodeString rest-    go 1 ('H':rest)     = "(# #)" ++ zDecodeString rest     go n ('H':rest)     = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ zDecodeString rest     go n other = error ("decode_tuple: " ++ show n ++ ' ':other) @@ -223,15 +222,13 @@         Z<digit>  * "(##)" is the tycon for an unboxed 0-tuple-* "(# #)" is the tycon for an unboxed 1-tuple -* "()" is the tycon for a boxed 0-tuple.+* "()" is the tycon for a boxed 0-tuple -}  maybe_tuple :: UserString -> Maybe EncodedString  maybe_tuple "(##)" = Just("Z0H")-maybe_tuple "(# #)" = Just("Z1H") maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of                                  (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")                                  _                  -> Nothing
libraries/ghc-boot/GHC/Utils/Encoding/UTF8.hs view
@@ -7,7 +7,7 @@ -- of the package database (needed in both ghc and in ghc-pkg) lives in -- `ghc-boot` and uses ShortText, which in turn depends on this module. --- | Simple, non-streaming UTF-8 codecs.+-- | Simple, non-streaming Modified UTF-8 codecs. -- -- This is one of several UTF-8 implementations provided by GHC; see Note -- [GHC's many UTF-8 implementations] in "GHC.Encoding.UTF8" for an
libraries/ghc-boot/ghc-boot.cabal view
@@ -5,7 +5,7 @@ -- ghc-boot.cabal.  name:           ghc-boot-version:        9.10.3+version:        9.12.1 license:        BSD-3-Clause license-file:   LICENSE category:       GHC@@ -28,13 +28,22 @@ extra-source-files: changelog.md  custom-setup-    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, filepath+    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, filepath  source-repository head     type:     git     location: https://gitlab.haskell.org/ghc/ghc.git     subdir:   libraries/ghc-boot +Flag bootstrap+        Description:+          Enabled when building the stage1 compiler in order to vendor the in-tree+          `template-haskell` library (including its dependency `ghc-boot-th`), while+          allowing dependencies to depend on the boot `template-haskell` library.+          See Note [Bootstrapping Template Haskell]+        Default: False+        Manual: True+ Library     default-language: Haskell2010     other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables@@ -56,13 +65,6 @@             GHC.UniqueSubdir             GHC.Version -    -- reexport modules from ghc-boot-th so that packages don't have to import-    -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to-    -- understand and to refactor.-    reexported-modules:-              GHC.LanguageExtensions.Type-            , GHC.ForeignSrcLang.Type-            , GHC.Lexeme      -- reexport platform modules from ghc-platform     reexported-modules:@@ -73,7 +75,7 @@             GHC.Version             GHC.Platform.Host -    build-depends: base       >= 4.7 && < 4.21,+    build-depends: base       >= 4.7 && < 4.22,                    binary     == 0.8.*,                    bytestring >= 0.10 && < 0.13,                    containers >= 0.5 && < 0.8,@@ -81,7 +83,22 @@                    filepath   >= 1.3 && < 1.6,                    deepseq    >= 1.4 && < 1.6,                    ghc-platform >= 0.1,-                   ghc-boot-th == 9.10.3++    -- reexport modules from ghc-boot-th so that packages+    -- don't have to import all of ghc-boot and ghc-boot-th.+    -- It makes the dependency graph easier to understand.+    reexported-modules:+            GHC.LanguageExtensions.Type+          , GHC.ForeignSrcLang.Type+          , GHC.Lexeme++    if flag(bootstrap)+      build-depends:+              ghc-boot-th-next    == 9.12.1+    else+      build-depends:+              ghc-boot-th         == 9.12.1+     if !os(windows)         build-depends:                    unix       >= 2.7 && < 2.9
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs view
@@ -6,6 +6,9 @@ {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-}+-- Late cost centres introduce a thunk in the asBox function, which leads to+-- an additional wrapper being added to any value placed inside a box.+{-# OPTIONS_GHC -fno-prof-late  #-}  module GHC.Exts.Heap.Closures (     -- * Closures
libraries/ghc-heap/ghc-heap.cabal view
@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           ghc-heap-version:        9.10.3+version:        9.12.1 license:        BSD-3-Clause license-file:   LICENSE maintainer:     libraries@haskell.org@@ -23,12 +23,12 @@   default-language: Haskell2010    build-depends:    base             >= 4.9.0 && < 5.0-                  , ghc-prim         > 0.2 && < 0.13+                  , ghc-prim         > 0.2 && < 0.14                   , rts              == 1.0.*                   , containers       >= 0.6.2.1 && < 0.8    if impl(ghc >= 9.9)-    build-depends:  ghc-internal     >= 9.900 && < 9.1003.99999+    build-depends:  ghc-internal     >= 9.900 && < 9.1201.99999    ghc-options:      -Wall   if !os(ghcjs)
+ libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+module GHC.Internal.ForeignSrcLang+  ( ForeignSrcLang(..)+  ) where++#ifdef BOOTSTRAP_TH+import Prelude -- See note [Why do we import Prelude here?]+import GHC.Generics (Generic)+#else+import GHC.Internal.Base+import GHC.Internal.Show+import GHC.Internal.Generics+#endif++-- | Foreign formats supported by GHC via TH+data ForeignSrcLang+  = LangC      -- ^ C+  | LangCxx    -- ^ C+++  | LangObjc   -- ^ Objective C+  | LangObjcxx -- ^ Objective C+++  | LangAsm    -- ^ Assembly language (.s)+  | LangJs     -- ^ JavaScript+  | RawObject  -- ^ Object (.o)+  deriving (Eq, Show, Generic)
+ libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs view
@@ -0,0 +1,172 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Internal.LanguageExtensions+-- Copyright   :  (c) The GHC Team+--+-- Maintainer  :  ghc-devs@haskell.org+-- Portability :  portable+--+-- A data type defining the language extensions supported by GHC.+--+{-# LANGUAGE DeriveGeneric, CPP, Trustworthy #-}+module GHC.Internal.LanguageExtensions ( Extension(..) ) where++#ifdef BOOTSTRAP_TH+import Prelude -- See note [Why do we import Prelude here?]+import GHC.Generics (Generic)+#else+import GHC.Internal.Base+import GHC.Internal.Show+import GHC.Internal.Generics+import GHC.Internal.Enum+#endif++-- | The language extensions known to GHC.+--+-- Note that there is an orphan 'Binary' instance for this type supplied by+-- the "GHC.LanguageExtensions" module provided by @ghc-boot@. We can't provide+-- here as this would require adding transitive dependencies to the+-- @template-haskell@ package, which must have a minimal dependency set.+data Extension+-- See Note [Updating flag description in the User's Guide] in+-- GHC.Driver.Session+   = Cpp+   | OverlappingInstances+   | UndecidableInstances+   | IncoherentInstances+   | UndecidableSuperClasses+   | MonomorphismRestriction+   | MonoLocalBinds+   | DeepSubsumption+   | RelaxedPolyRec           -- Deprecated+   | ExtendedDefaultRules     -- Use GHC's extended rules for defaulting+   | NamedDefaults+   | ForeignFunctionInterface+   | UnliftedFFITypes+   | InterruptibleFFI+   | CApiFFI+   | GHCForeignImportPrim+   | JavaScriptFFI+   | ParallelArrays           -- Syntactic support for parallel arrays+   | Arrows                   -- Arrow-notation syntax+   | TemplateHaskell+   | TemplateHaskellQuotes    -- subset of TH supported by stage1, no splice+   | QualifiedDo+   | QuasiQuotes+   | ImplicitParams+   | ImplicitPrelude+   | ScopedTypeVariables+   | AllowAmbiguousTypes+   | UnboxedTuples+   | UnboxedSums+   | UnliftedNewtypes+   | UnliftedDatatypes+   | BangPatterns+   | TypeFamilies+   | TypeFamilyDependencies+   | TypeInType               -- Deprecated+   | OverloadedStrings+   | OverloadedLists+   | NumDecimals+   | DisambiguateRecordFields+   | RecordWildCards+   | NamedFieldPuns+   | ViewPatterns+   | OrPatterns+   | GADTs+   | GADTSyntax+   | NPlusKPatterns+   | DoAndIfThenElse+   | BlockArguments+   | RebindableSyntax+   | ConstraintKinds+   | PolyKinds                -- Kind polymorphism+   | DataKinds                -- Datatype promotion+   | TypeData                 -- allow @type data@ definitions+   | InstanceSigs+   | ApplicativeDo+   | LinearTypes+   | RequiredTypeArguments    -- Visible forall (VDQ) in types of terms++   | StandaloneDeriving+   | DeriveDataTypeable+   | AutoDeriveTypeable       -- Automatic derivation of Typeable+   | DeriveFunctor+   | DeriveTraversable+   | DeriveFoldable+   | DeriveGeneric            -- Allow deriving Generic/1+   | DefaultSignatures        -- Allow extra signatures for defmeths+   | DeriveAnyClass           -- Allow deriving any class+   | DeriveLift               -- Allow deriving Lift+   | DerivingStrategies+   | DerivingVia              -- Derive through equal representation++   | TypeSynonymInstances+   | FlexibleContexts+   | FlexibleInstances+   | ConstrainedClassMethods+   | MultiParamTypeClasses+   | NullaryTypeClasses+   | FunctionalDependencies+   | UnicodeSyntax+   | ExistentialQuantification+   | MagicHash+   | EmptyDataDecls+   | KindSignatures+   | RoleAnnotations+   | ParallelListComp+   | TransformListComp+   | MonadComprehensions+   | GeneralizedNewtypeDeriving+   | RecursiveDo+   | PostfixOperators+   | TupleSections+   | PatternGuards+   | LiberalTypeSynonyms+   | RankNTypes+   | ImpredicativeTypes+   | TypeOperators+   | ExplicitNamespaces+   | PackageImports+   | ExplicitForAll+   | AlternativeLayoutRule+   | AlternativeLayoutRuleTransitional+   | DatatypeContexts+   | NondecreasingIndentation+   | RelaxedLayout+   | TraditionalRecordSyntax+   | LambdaCase+   | MultiWayIf+   | BinaryLiterals+   | NegativeLiterals+   | HexFloatLiterals+   | DuplicateRecordFields+   | OverloadedLabels+   | EmptyCase+   | PatternSynonyms+   | PartialTypeSignatures+   | NamedWildCards+   | StaticPointers+   | TypeApplications+   | Strict+   | StrictData+   | EmptyDataDeriving+   | NumericUnderscores+   | QuantifiedConstraints+   | StarIsType+   | ImportQualifiedPost+   | CUSKs+   | StandaloneKindSignatures+   | LexicalNegation+   | FieldSelectors+   | OverloadedRecordDot+   | OverloadedRecordUpdate+   | TypeAbstractions+   | ExtendedLiterals+   | ListTuplePuns+   | MultilineStrings+   deriving (Eq, Enum, Show, Generic, Bounded)+-- 'Ord' and 'Bounded' are provided for GHC API users (see discussions+-- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and+-- https://gitlab.haskell.org/ghc/ghc/merge_requests/826).+instance Ord Extension where compare a b = compare (fromEnum a) (fromEnum b)
+ libraries/ghc-internal/src/GHC/Internal/Lexeme.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Internal.Lexeme+-- Copyright   :  (c) The GHC Team+--+-- Maintainer  :  ghc-devs@haskell.org+-- Portability :  portable+--+-- Functions to evaluate whether or not a string is a valid identifier.+--+module GHC.Internal.Lexeme (+          -- * Lexical characteristics of Haskell names+        startsVarSym, startsVarId, startsConSym, startsConId,+        startsVarSymASCII, isVarSymChar, okSymChar+  ) where++#ifdef BOOTSTRAP_TH+import Prelude -- See note [Why do we import Prelude here?]+import Data.Char+#else+import GHC.Internal.Base+import GHC.Internal.Unicode+import GHC.Internal.List (elem)+#endif++-- | Is this character acceptable in a symbol (after the first char)?+-- See alexGetByte in GHC.Parser.Lexer+okSymChar :: Char -> Bool+okSymChar c+  | c `elem` "(),;[]`{}_\"'"+  = False+  | otherwise+  = case generalCategory c of+      ConnectorPunctuation -> True+      DashPunctuation      -> True+      OtherPunctuation     -> True+      MathSymbol           -> True+      CurrencySymbol       -> True+      ModifierSymbol       -> True+      OtherSymbol          -> True+      _                    -> False++startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool+startsVarSym c = okSymChar c && c /= ':' -- Infix Ids+startsConSym c = c == ':'                -- Infix data constructors+startsVarId c  = c == '_' || case generalCategory c of  -- Ordinary Ids+  LowercaseLetter -> True+  OtherLetter     -> True   -- See #1103+  _               -> False+startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors++startsVarSymASCII :: Char -> Bool+startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"++isVarSymChar :: Char -> Bool+isVarSymChar c = c == ':' || startsVarSym c
+ libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs view
@@ -0,0 +1,2555 @@+{-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead+{-# LANGUAGE CPP, DeriveDataTypeable,+             DeriveGeneric, FlexibleInstances, DefaultSignatures,+             RankNTypes, RoleAnnotations, ScopedTypeVariables,+             MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,+             GADTs, UnboxedTuples, UnboxedSums, TypeOperators,+             Trustworthy, DeriveFunctor, DeriveTraversable,+             BangPatterns, RecordWildCards, ImplicitParams #-}++{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE StandaloneKindSignatures #-}++-- | This module is used internally in GHC's integration with Template Haskell+-- and defines the abstract syntax of Template Haskell.+--+-- This is not a part of the public API, and as such, there are no API+-- guarantees for this module from version to version.+--+-- Import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!+module GHC.Internal.TH.Syntax+    ( module GHC.Internal.TH.Syntax+      -- * Language extensions+    , module GHC.Internal.LanguageExtensions+    , ForeignSrcLang(..)+    -- * Notes+    -- ** Unresolved Infix+    -- $infix+    ) where++#ifdef BOOTSTRAP_TH+import Prelude+import Data.Data hiding (Fixity(..))+import Data.IORef+import System.IO.Unsafe ( unsafePerformIO )+import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Fix (MonadFix (..))+import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)+import Control.Exception.Base (FixIOException (..))+import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)+import System.IO        ( hPutStrLn, stderr )+import Data.Char        ( isAlpha, isAlphaNum, isUpper )+import Data.List.NonEmpty ( NonEmpty(..) )+import Data.Word+import GHC.Generics     ( Generic )+import qualified Data.Kind as Kind (Type)+import GHC.Ptr          ( Ptr, plusPtr )+import Foreign.ForeignPtr+import Foreign.C.String+import Foreign.C.Types+import GHC.Types        (TYPE, RuntimeRep(..))+#else+import GHC.Internal.Base hiding (Type, Module, sequence)+import GHC.Internal.Data.Data hiding (Fixity(..))+import GHC.Internal.Data.Traversable+import GHC.Internal.Word+import GHC.Internal.Generics (Generic)+import GHC.Internal.IORef+import GHC.Internal.System.IO+import GHC.Internal.Show+import GHC.Internal.Integer+import GHC.Internal.Real+import GHC.Internal.Data.Foldable+import GHC.Internal.Foreign.Ptr+import GHC.Internal.ForeignPtr+import GHC.Internal.Data.Typeable+import GHC.Internal.Control.Monad.IO.Class+import GHC.Internal.Foreign.C.Types+import GHC.Internal.Foreign.C.String+import GHC.Internal.Control.Monad.Fail+import GHC.Internal.Control.Monad.Fix+import GHC.Internal.Control.Exception+import GHC.Internal.Num+import GHC.Internal.IO.Unsafe+import GHC.Internal.List (dropWhile, break, replicate, reverse, last)+import GHC.Internal.MVar+import GHC.Internal.IO.Exception+import GHC.Internal.Unicode+import qualified GHC.Types as Kind (Type)+#endif+import GHC.Internal.ForeignSrcLang+import GHC.Internal.LanguageExtensions++-----------------------------------------------------+--+--              The Quasi class+--+-----------------------------------------------------++class (MonadIO m, MonadFail m) => Quasi m where+  -- | Fresh names. See 'newName'.+  qNewName :: String -> m Name++  ------- Error reporting and recovery -------+  -- | Report an error (True) or warning (False)+  -- ...but carry on; use 'fail' to stop. See 'report'.+  qReport  :: Bool -> String -> m ()++  -- | See 'recover'.+  qRecover :: m a -- ^ the error handler+           -> m a -- ^ action which may fail+           -> m a -- ^ Recover from the monadic 'fail'++  ------- Inspect the type-checker's environment -------+  -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.+  qLookupName :: Bool -> String -> m (Maybe Name)+  -- | See 'reify'.+  qReify          :: Name -> m Info+  -- | See 'reifyFixity'.+  qReifyFixity    :: Name -> m (Maybe Fixity)+  -- | See 'reifyType'.+  qReifyType      :: Name -> m Type+  -- | Is (n tys) an instance? Returns list of matching instance Decs (with+  -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.+  qReifyInstances :: Name -> [Type] -> m [Dec]+  -- | See 'reifyRoles'.+  qReifyRoles         :: Name -> m [Role]+  -- | See 'reifyAnnotations'.+  qReifyAnnotations   :: Data a => AnnLookup -> m [a]+  -- | See 'reifyModule'.+  qReifyModule        :: Module -> m ModuleInfo+  -- | See 'reifyConStrictness'.+  qReifyConStrictness :: Name -> m [DecidedStrictness]++  -- | See 'location'.+  qLocation :: m Loc++  -- | Input/output (dangerous). See 'runIO'.+  qRunIO :: IO a -> m a+  qRunIO = liftIO+  -- | See 'getPackageRoot'.+  qGetPackageRoot :: m FilePath++  -- | See 'addDependentFile'.+  qAddDependentFile :: FilePath -> m ()++  -- | See 'addTempFile'.+  qAddTempFile :: String -> m FilePath++  -- | See 'addTopDecls'.+  qAddTopDecls :: [Dec] -> m ()++  -- | See 'addForeignFilePath'.+  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()++  -- | See 'addModFinalizer'.+  qAddModFinalizer :: Q () -> m ()++  -- | See 'addCorePlugin'.+  qAddCorePlugin :: String -> m ()++  -- | See 'getQ'.+  qGetQ :: Typeable a => m (Maybe a)++  -- | See 'putQ'.+  qPutQ :: Typeable a => a -> m ()++  -- | See 'isExtEnabled'.+  qIsExtEnabled :: Extension -> m Bool+  -- | See 'extsEnabled'.+  qExtsEnabled :: m [Extension]++  -- | See 'putDoc'.+  qPutDoc :: DocLoc -> String -> m ()+  -- | See 'getDoc'.+  qGetDoc :: DocLoc -> m (Maybe String)++-----------------------------------------------------+--      The IO instance of Quasi+-----------------------------------------------------++--  | This instance is used only when running a Q+--  computation in the IO monad, usually just to+--  print the result.  There is no interesting+--  type environment, so reification isn't going to+--  work.+instance Quasi IO where+  qNewName = newNameIO++  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)+  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)++  qLookupName _ _       = badIO "lookupName"+  qReify _              = badIO "reify"+  qReifyFixity _        = badIO "reifyFixity"+  qReifyType _          = badIO "reifyFixity"+  qReifyInstances _ _   = badIO "reifyInstances"+  qReifyRoles _         = badIO "reifyRoles"+  qReifyAnnotations _   = badIO "reifyAnnotations"+  qReifyModule _        = badIO "reifyModule"+  qReifyConStrictness _ = badIO "reifyConStrictness"+  qLocation             = badIO "currentLocation"+  qRecover _ _          = badIO "recover" -- Maybe we could fix this?+  qGetPackageRoot       = badIO "getProjectRoot"+  qAddDependentFile _   = badIO "addDependentFile"+  qAddTempFile _        = badIO "addTempFile"+  qAddTopDecls _        = badIO "addTopDecls"+  qAddForeignFilePath _ _ = badIO "addForeignFilePath"+  qAddModFinalizer _    = badIO "addModFinalizer"+  qAddCorePlugin _      = badIO "addCorePlugin"+  qGetQ                 = badIO "getQ"+  qPutQ _               = badIO "putQ"+  qIsExtEnabled _       = badIO "isExtEnabled"+  qExtsEnabled          = badIO "extsEnabled"+  qPutDoc _ _           = badIO "putDoc"+  qGetDoc _             = badIO "getDoc"++instance Quote IO where+  newName = newNameIO++newNameIO :: String -> IO Name+newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))+                 ; pure (mkNameU s n) }++badIO :: String -> IO a+badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")+                ; fail "Template Haskell failure" }++-- Global variable to generate unique symbols+counter :: IORef Uniq+{-# NOINLINE counter #-}+counter = unsafePerformIO (newIORef 0)+++-----------------------------------------------------+--+--              The Q monad+--+-----------------------------------------------------++-- | In short, 'Q' provides the 'Quasi' operations in one neat monad for the+-- user.+--+-- The longer story, is that 'Q' wraps an arbitrary 'Quasi'-able monad.+-- The perceptive reader notices that 'Quasi' has only two instances, 'Q'+-- itself and 'IO', neither of which have concrete implementations.'Q' plays+-- the trick of [dependency+-- inversion](https://en.wikipedia.org/wiki/Dependency_inversion_principle),+-- providing an abstract interface for the user which is later concretely+-- fufilled by an concrete 'Quasi' instance, internal to GHC.+newtype Q a = Q { unQ :: forall m. Quasi m => m a }++-- | \"Runs\" the 'Q' monad. Normal users of Template Haskell+-- should not need this function, as the splice brackets @$( ... )@+-- are the usual way of running a 'Q' computation.+--+-- This function is primarily used in GHC internals, and for debugging+-- splices by running them in 'IO'.+--+-- Note that many functions in 'Q', such as 'reify' and other compiler+-- queries, are not supported when running 'Q' in 'IO'; these operations+-- simply fail at runtime. Indeed, the only operations guaranteed to succeed+-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.+runQ :: Quasi m => Q a -> m a+runQ (Q m) = m++instance Monad Q where+  Q m >>= k  = Q (m >>= \x -> unQ (k x))+  (>>) = (*>)++instance MonadFail Q where+  fail s     = report True s >> Q (fail "Q monad failure")++instance Functor Q where+  fmap f (Q x) = Q (fmap f x)++instance Applicative Q where+  pure x = Q (pure x)+  Q f <*> Q x = Q (f <*> x)+  Q m *> Q n = Q (m *> n)++-- | @since 2.17.0.0+instance Semigroup a => Semigroup (Q a) where+  (<>) = liftA2 (<>)++-- | @since 2.17.0.0+instance Monoid a => Monoid (Q a) where+  mempty = pure mempty++-- | If the function passed to 'mfix' inspects its argument,+-- the resulting action will throw a 'FixIOException'.+--+-- @since 2.17.0.0+instance MonadFix Q where+  -- We use the same blackholing approach as in fixIO.+  -- See Note [Blackholing in fixIO] in System.IO in base.+  mfix k = do+    m <- runIO newEmptyMVar+    ans <- runIO (unsafeDupableInterleaveIO+             (readMVar m `catch` \BlockedIndefinitelyOnMVar ->+                                    throwIO FixIOException))+    result <- k ans+    runIO (putMVar m result)+    return result+++-----------------------------------------------------+--+--              The Quote class+--+-----------------------------------------------------++++-- | The 'Quote' class implements the minimal interface which is necessary for+-- desugaring quotations.+--+-- * The @Monad m@ superclass is needed to stitch together the different+-- AST fragments.+-- * 'newName' is used when desugaring binding structures such as lambdas+-- to generate fresh names.+--+-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`+--+-- For many years the type of a quotation was fixed to be `Q Exp` but by+-- more precisely specifying the minimal interface it enables the `Exp` to+-- be extracted purely from the quotation without interacting with `Q`.+class Monad m => Quote m where+  {- |+  Generate a fresh name, which cannot be captured.++  For example, this:++  @f = $(do+    nm1 <- newName \"x\"+    let nm2 = 'mkName' \"x\"+    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))+   )@++  will produce the splice++  >f = \x0 -> \x -> x0++  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,+  and is not captured by the binding @VarP nm2@.++  Although names generated by @newName@ cannot /be captured/, they can+  /capture/ other names. For example, this:++  >g = $(do+  >  nm1 <- newName "x"+  >  let nm2 = mkName "x"+  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))+  > )++  will produce the splice++  >g = \x -> \x0 -> x0++  since the occurrence @VarE nm2@ is captured by the innermost binding+  of @x@, namely @VarP nm1@.+  -}+  newName :: String -> m Name++instance Quote Q where+  newName s = Q (qNewName s)++-----------------------------------------------------+--+--              The TExp type+--+-----------------------------------------------------++type TExp :: TYPE r -> Kind.Type+type role TExp nominal   -- See Note [Role of TExp]+newtype TExp a = TExp+  { unType :: Exp -- ^ Underlying untyped Template Haskell expression+  }+-- ^ Typed wrapper around an 'Exp'.+--+-- This is the typed representation of terms produced by typed quotes.+--+-- Representation-polymorphic since /template-haskell-2.16.0.0/.++-- | Discard the type annotation and produce a plain Template Haskell+-- expression+--+-- Representation-polymorphic since /template-haskell-2.16.0.0/.+unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp+unTypeQ m = do { TExp e <- m+               ; return e }++-- | Annotate the Template Haskell expression with a type+--+-- This is unsafe because GHC cannot check for you that the expression+-- really does have the type you claim it has.+--+-- Representation-polymorphic since /template-haskell-2.16.0.0/.+unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .+                      Quote m => m Exp -> m (TExp a)+unsafeTExpCoerce m = do { e <- m+                        ; return (TExp e) }++{- Note [Role of TExp]+~~~~~~~~~~~~~~~~~~~~~~+TExp's argument must have a nominal role, not phantom as would+be inferred (#8459).  Consider++  e :: Code Q Age+  e = [|| MkAge 3 ||]++  foo = $(coerce e) + 4::Int++The splice will evaluate to (MkAge 3) and you can't add that to+4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}++-- Code constructor+#if __GLASGOW_HASKELL__ >= 909+type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type+  -- See Note [Foralls to the right in Code]+#else+type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type+#endif+type role Code representational nominal   -- See Note [Role of TExp]+newtype Code m a = Code+  { examineCode :: m (TExp a) -- ^ Underlying monadic value+  }+-- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed+-- expressions allow for type-safe splicing via:+--+--   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if+--     that expression has type @a@, then the quotation has type+--     @Quote m => Code m a@+--+--   - typed splices inside of typed quotes, written as @$$(...)@ where @...@+--     is an arbitrary expression of type @Quote m => Code m a@+--+-- Traditional expression quotes and splices let us construct ill-typed+-- expressions:+--+-- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])+-- GHC.Types.True GHC.Classes.== "foo"+-- >>> GHC.Types.True GHC.Classes.== "foo"+-- <interactive> error:+--     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’+--     • In the second argument of ‘(==)’, namely ‘"foo"’+--       In the expression: True == "foo"+--       In an equation for ‘it’: it = True == "foo"+--+-- With typed expressions, the type error occurs when /constructing/ the+-- Template Haskell expression:+--+-- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])+-- <interactive> error:+--     • Couldn't match type ‘[Char]’ with ‘Bool’+--       Expected type: Code Q Bool+--         Actual type: Code Q [Char]+--     • In the Template Haskell quotation [|| "foo" ||]+--       In the expression: [|| "foo" ||]+--       In the Template Haskell splice $$([|| "foo" ||])+++{- Note [Foralls to the right in Code]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Code has the following type signature:+   type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type++This allows us to write+   data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)++   tcodeq :: T (Code Q)+   tcodeq = MkT [||5||] [||5#||]++If we used the slightly more straightforward signature+   type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type++then the example above would become ill-typed.  (See #23592 for some discussion.)+-}++-- | Unsafely convert an untyped code representation into a typed code+-- representation.+unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .+                      Quote m => m Exp -> Code m a+unsafeCodeCoerce m = Code (unsafeTExpCoerce m)++-- | Lift a monadic action producing code into the typed 'Code'+-- representation+liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a+liftCode = Code++-- | Extract the untyped representation from the typed representation+unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m+           => Code m a -> m Exp+unTypeCode = unTypeQ . examineCode++-- | Modify the ambient monad used during code generation. For example, you+-- can use `hoistCode` to handle a state effect:+-- @+--  handleState :: Code (StateT Int Q) a -> Code Q a+--  handleState = hoistCode (flip runState 0)+-- @+hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m+          => (forall x . m x -> n x) -> Code m a -> Code n a+hoistCode f (Code a) = Code (f a)+++-- | Variant of '(>>=)' which allows effectful computations to be injected+-- into code generation.+bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m+         => m a -> (a -> Code m b) -> Code m b+bindCode q k = liftCode (q >>= examineCode . k)++-- | Variant of '(>>)' which allows effectful computations to be injected+-- into code generation.+bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m+          => m a -> Code m b -> Code m b+bindCode_ q c = liftCode ( q >> examineCode c)++-- | A useful combinator for embedding monadic actions into 'Code'+-- @+-- myCode :: ... => Code m a+-- myCode = joinCode $ do+--   x <- someSideEffect+--   return (makeCodeWith x)+-- @+joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m+         => m (Code m a) -> Code m a+joinCode = flip bindCode id++----------------------------------------------------+-- Packaged versions for the programmer, hiding the Quasi-ness+++-- | Report an error (True) or warning (False),+-- but carry on; use 'fail' to stop.+report  :: Bool -> String -> Q ()+report b s = Q (qReport b s)+{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6++-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.+reportError :: String -> Q ()+reportError = report True++-- | Report a warning to the user, and carry on.+reportWarning :: String -> Q ()+reportWarning = report False++-- | Recover from errors raised by 'reportError' or 'fail'.+recover :: Q a -- ^ handler to invoke on failure+        -> Q a -- ^ computation to run+        -> Q a+recover (Q r) (Q m) = Q (qRecover r m)++-- We don't export lookupName; the Bool isn't a great API+-- Instead we export lookupTypeName, lookupValueName+lookupName :: Bool -> String -> Q (Maybe Name)+lookupName ns s = Q (qLookupName ns s)++-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.+lookupTypeName :: String -> Q (Maybe Name)+lookupTypeName  s = Q (qLookupName True s)++-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.+lookupValueName :: String -> Q (Maybe Name)+lookupValueName s = Q (qLookupName False s)++{-+Note [Name lookup]+~~~~~~~~~~~~~~~~~~+-}+{- $namelookup #namelookup#+The functions 'lookupTypeName' and 'lookupValueName' provide+a way to query the current splice's context for what names+are in scope. The function 'lookupTypeName' queries the type+namespace, whereas 'lookupValueName' queries the value namespace,+but the functions are otherwise identical.++A call @lookupValueName s@ will check if there is a value+with name @s@ in scope at the current splice's location. If+there is, the @Name@ of this value is returned;+if not, then @Nothing@ is returned.++The returned name cannot be \"captured\".+For example:++> f = "global"+> g = $( do+>          Just nm <- lookupValueName "f"+>          [| let f = "local" in $( varE nm ) |]++In this case, @g = \"global\"@; the call to @lookupValueName@+returned the global @f@, and this name was /not/ captured by+the local definition of @f@.++The lookup is performed in the context of the /top-level/ splice+being run. For example:++> f = "global"+> g = $( [| let f = "local" in+>            $(do+>                Just nm <- lookupValueName "f"+>                varE nm+>             ) |] )++Again in this example, @g = \"global\"@, because the call to+@lookupValueName@ queries the context of the outer-most @$(...)@.++Operators should be queried without any surrounding parentheses, like so:++> lookupValueName "+"++Qualified names are also supported, like so:++> lookupValueName "Prelude.+"+> lookupValueName "Prelude.map"++-}+++{- | 'reify' looks up information about the 'Name'. It will fail with+a compile error if the 'Name' is not visible. A 'Name' is visible if it is+imported or defined in a prior top-level declaration group. See the+documentation for 'newDeclarationGroup' for more details.++It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'+to ensure that we are reifying from the right namespace. For instance, in this context:++> data D = D++which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)+To ensure we get information about @D@-the-value, use 'lookupValueName':++> do+>   Just nm <- lookupValueName "D"+>   reify nm++and to get information about @D@-the-type, use 'lookupTypeName'.+-}+reify :: Name -> Q Info+reify v = Q (qReify v)++{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For+example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then+@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function+@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns+'Nothing', so you may assume @bar@ has 'defaultFixity'.+-}+reifyFixity :: Name -> Q (Maybe Fixity)+reifyFixity nm = Q (qReifyFixity nm)++{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,+@reifyType 'not@   returns @Bool -> Bool@, and+@reifyType ''Bool@ returns @Type@.+This works even if there's no explicit signature and the type or kind is inferred.+-}+reifyType :: Name -> Q Type+reifyType nm = Q (qReifyType nm)++{- | Template Haskell is capable of reifying information about types and+terms defined in previous declaration groups. Top-level declaration splices break up+declaration groups.++For an example, consider this  code block. We define a datatype @X@ and+then try to call 'reify' on the datatype.++@+module Check where++data X = X+    deriving Eq++$(do+    info <- reify ''X+    runIO $ print info+ )+@++This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:++@+data X = X+    deriving Eq++$(pure [])++$(do+    info <- reify ''X+    runIO $ print info+ )+@++We provide 'newDeclarationGroup' as a means of documenting this behavior+and providing a name for the pattern.++Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:++@+data X = X+    deriving Eq++newDeclarationGroup++$(do+    info <- reify ''X+    runIO $ print info+ )+@++-}+newDeclarationGroup :: Q [Dec]+newDeclarationGroup = pure []++{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")+of @nm tys@. That is,+if @nm@ is the name of a type class, then all instances of this class at the types @tys@+are returned. Alternatively, if @nm@ is the name of a data family or type family,+all instances of this family at the types @tys@ are returned.++Note that this is a \"shallow\" test; the declarations returned merely have+instance heads which unify with @nm tys@, they need not actually be satisfiable.++  - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains+    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and+    @B@ themselves implement 'Eq'++  - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available+    instance of 'Show'++There is one edge case: @reifyInstances ''Typeable tys@ currently always+produces an empty list (no matter what @tys@ are given).++In principle, the *visible* instances are+* all instances defined in a prior top-level declaration group+  (see docs on @newDeclarationGroup@), or+* all instances defined in any module transitively imported by the+  module being compiled++However, actually searching all modules transitively below the one being+compiled is unreasonably expensive, so @reifyInstances@ will report only the+instance for modules that GHC has had some cause to visit during this+compilation.  This is a shortcoming: @reifyInstances@ might fail to report+instances for a type that is otherwise unusued, or instances defined in a+different component.  You can work around this shortcoming by explicitly importing the modules+whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>+has some discussion around this.++-}+reifyInstances :: Name -> [Type] -> Q [InstanceDec]+reifyInstances cls tys = Q (qReifyInstances cls tys)++{- | @reifyRoles nm@ returns the list of roles associated with the parameters+(both visible and invisible) of+the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.+The returned list should never contain 'InferR'.++An invisible parameter to a tycon is often a kind parameter. For example, if+we have++@+type Proxy :: forall k. k -> Type+data Proxy a = MkProxy+@++and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is+the role of the invisible @k@ parameter. Kind parameters are always nominal.+-}+reifyRoles :: Name -> Q [Role]+reifyRoles nm = Q (qReifyRoles nm)++-- | @reifyAnnotations target@ returns the list of annotations+-- associated with @target@.  Only the annotations that are+-- appropriately typed is returned.  So if you have @Int@ and @String@+-- annotations for the same target, you have to call this function twice.+reifyAnnotations :: Data a => AnnLookup -> Q [a]+reifyAnnotations an = Q (qReifyAnnotations an)++-- | @reifyModule mod@ looks up information about module @mod@.  To+-- look up the current module, call this function with the return+-- value of 'Language.Haskell.TH.Lib.thisModule'.+reifyModule :: Module -> Q ModuleInfo+reifyModule m = Q (qReifyModule m)++-- | @reifyConStrictness nm@ looks up the strictness information for the fields+-- of the constructor with the name @nm@. Note that the strictness information+-- that 'reifyConStrictness' returns may not correspond to what is written in+-- the source code. For example, in the following data declaration:+--+-- @+-- data Pair a = Pair a a+-- @+--+-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most+-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the+-- @-XStrictData@ language extension was enabled.+reifyConStrictness :: Name -> Q [DecidedStrictness]+reifyConStrictness n = Q (qReifyConStrictness n)++-- | Is the list of instances returned by 'reifyInstances' nonempty?+--+-- If you're confused by an instance not being visible despite being+-- defined in the same module and above the splice in question, see the+-- docs for 'newDeclarationGroup' for a possible explanation.+isInstance :: Name -> [Type] -> Q Bool+isInstance nm tys = do { decs <- reifyInstances nm tys+                       ; return (not (null decs)) }++-- | The location at which this computation is spliced.+location :: Q Loc+location = Q qLocation++-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.+-- Take care: you are guaranteed the ordering of calls to 'runIO' within+-- a single 'Q' computation, but not about the order in which splices are run.+--+-- Note: for various murky reasons, stdout and stderr handles are not+-- necessarily flushed when the compiler finishes running, so you should+-- flush them yourself.+runIO :: IO a -> Q a+runIO m = Q (qRunIO m)++-- | Get the package root for the current package which is being compiled.+-- This can be set explicitly with the -package-root flag but is normally+-- just the current working directory.+--+-- The motivation for this flag is to provide a principled means to remove the+-- assumption from splices that they will be executed in the directory where the+-- cabal file resides. Projects such as haskell-language-server can't and don't+-- change directory when compiling files but instead set the -package-root flag+-- appropriately.+getPackageRoot :: Q FilePath+getPackageRoot = Q qGetPackageRoot++++-- | Record external files that runIO is using (dependent upon).+-- The compiler can then recognize that it should re-compile the Haskell file+-- when an external file changes.+--+-- Expects an absolute file path.+--+-- Notes:+--+--   * ghc -M does not know about these dependencies - it does not execute TH.+--+--   * The dependency is based on file content, not a modification time+addDependentFile :: FilePath -> Q ()+addDependentFile fp = Q (qAddDependentFile fp)++-- | Obtain a temporary file path with the given suffix. The compiler will+-- delete this file after compilation.+addTempFile :: String -> Q FilePath+addTempFile suffix = Q (qAddTempFile suffix)++-- | Add additional top-level declarations. The added declarations will be type+-- checked along with the current declaration group.+addTopDecls :: [Dec] -> Q ()+addTopDecls ds = Q (qAddTopDecls ds)++-- |+addForeignFile :: ForeignSrcLang -> String -> Q ()+addForeignFile = addForeignSource+{-# DEPRECATED addForeignFile+               "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"+  #-} -- deprecated in 8.6++-- | Emit a foreign file which will be compiled and linked to the object for+-- the current module. Currently only languages that can be compiled with+-- the C compiler are supported, and the flags passed as part of -optc will+-- be also applied to the C compiler invocation that will compile them.+--+-- Note that for non-C languages (for example C++) @extern "C"@ directives+-- must be used to get symbols that we can access from Haskell.+--+-- To get better errors, it is recommended to use #line pragmas when+-- emitting C files, e.g.+--+-- > {-# LANGUAGE CPP #-}+-- > ...+-- > addForeignSource LangC $ unlines+-- >   [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__+-- >   , ...+-- >   ]+addForeignSource :: ForeignSrcLang -> String -> Q ()+addForeignSource lang src = do+  let suffix = case lang of+                 LangC      -> "c"+                 LangCxx    -> "cpp"+                 LangObjc   -> "m"+                 LangObjcxx -> "mm"+                 LangAsm    -> "s"+                 LangJs     -> "js"+                 RawObject  -> "a"+  path <- addTempFile suffix+  runIO $ writeFile path src+  addForeignFilePath lang path++-- | Same as 'addForeignSource', but expects to receive a path pointing to the+-- foreign file instead of a 'String' of its contents. Consider using this in+-- conjunction with 'addTempFile'.+--+-- This is a good alternative to 'addForeignSource' when you are trying to+-- directly link in an object file.+addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()+addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)++-- | Add a finalizer that will run in the Q monad after the current module has+-- been type checked. This only makes sense when run within a top-level splice.+--+-- The finalizer is given the local type environment at the splice point. Thus+-- 'reify' is able to find the local definitions when executed inside the+-- finalizer.+addModFinalizer :: Q () -> Q ()+addModFinalizer act = Q (qAddModFinalizer (unQ act))++-- | Adds a core plugin to the compilation pipeline.+--+-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc+-- in the command line. The major difference is that the plugin module @m@+-- must not belong to the current package. When TH executes, it is too late+-- to tell the compiler that we needed to compile first a plugin module in the+-- current package.+addCorePlugin :: String -> Q ()+addCorePlugin plugin = Q (qAddCorePlugin plugin)++-- | Get state from the 'Q' monad. Note that the state is local to the+-- Haskell module in which the Template Haskell expression is executed.+getQ :: Typeable a => Q (Maybe a)+getQ = Q qGetQ++-- | Replace the state in the 'Q' monad. Note that the state is local to the+-- Haskell module in which the Template Haskell expression is executed.+putQ :: Typeable a => a -> Q ()+putQ x = Q (qPutQ x)++-- | Determine whether the given language extension is enabled in the 'Q' monad.+isExtEnabled :: Extension -> Q Bool+isExtEnabled ext = Q (qIsExtEnabled ext)++-- | List all enabled language extensions.+extsEnabled :: Q [Extension]+extsEnabled = Q qExtsEnabled++-- | Add Haddock documentation to the specified location. This will overwrite+-- any documentation at the location if it already exists. This will reify the+-- specified name, so it must be in scope when you call it. If you want to add+-- documentation to something that you are currently splicing, you can use+-- 'addModFinalizer' e.g.+--+-- > do+-- >   let nm = mkName "x"+-- >   addModFinalizer $ putDoc (DeclDoc nm) "Hello"+-- >   [d| $(varP nm) = 42 |]+--+-- The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as+-- will the 'funD_doc' and other @_doc@ combinators.+-- You most likely want to have the @-haddock@ flag turned on when using this.+-- Adding documentation to anything outside of the current module will cause an+-- error.+putDoc :: DocLoc -> String -> Q ()+putDoc t s = Q (qPutDoc t s)++-- | Retrieves the Haddock documentation at the specified location, if one+-- exists.+-- It can be used to read documentation on things defined outside of the current+-- module, provided that those modules were compiled with the @-haddock@ flag.+getDoc :: DocLoc -> Q (Maybe String)+getDoc n = Q (qGetDoc n)++instance MonadIO Q where+  liftIO = runIO++instance Quasi Q where+  qNewName            = newName+  qReport             = report+  qRecover            = recover+  qReify              = reify+  qReifyFixity        = reifyFixity+  qReifyType          = reifyType+  qReifyInstances     = reifyInstances+  qReifyRoles         = reifyRoles+  qReifyAnnotations   = reifyAnnotations+  qReifyModule        = reifyModule+  qReifyConStrictness = reifyConStrictness+  qLookupName         = lookupName+  qLocation           = location+  qGetPackageRoot     = getPackageRoot+  qAddDependentFile   = addDependentFile+  qAddTempFile        = addTempFile+  qAddTopDecls        = addTopDecls+  qAddForeignFilePath = addForeignFilePath+  qAddModFinalizer    = addModFinalizer+  qAddCorePlugin      = addCorePlugin+  qGetQ               = getQ+  qPutQ               = putQ+  qIsExtEnabled       = isExtEnabled+  qExtsEnabled        = extsEnabled+  qPutDoc             = putDoc+  qGetDoc             = getDoc+++----------------------------------------------------+-- The following operations are used solely in GHC.HsToCore.Quote when+-- desugaring brackets. They are not necessary for the user, who can use+-- ordinary return and (>>=) etc++-- | This function is only used in 'GHC.HsToCore.Quote' when desugaring+-- brackets. This is not necessary for the user, who can use the ordinary+-- 'return' and '(>>=)' operations.+sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]+sequenceQ = sequence++oneName, manyName :: Name+-- | Synonym for @''GHC.Types.One'@, from @ghc-prim@.+oneName  = mkNameG DataName "ghc-prim" "GHC.Types" "One"+-- | Synonym for @''GHC.Types.Many'@, from @ghc-prim@.+manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"+++-----------------------------------------------------+--              Names and uniques+-----------------------------------------------------++-- | The name of a module.+newtype ModName = ModName String        -- Module name+ deriving (Show,Eq,Ord,Data,Generic)++-- | The name of a package.+newtype PkgName = PkgName String        -- package name+ deriving (Show,Eq,Ord,Data,Generic)++-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.+data Module = Module PkgName ModName -- package qualified module name+ deriving (Show,Eq,Ord,Data,Generic)++-- | An "Occurence Name".+newtype OccName = OccName String+ deriving (Show,Eq,Ord,Data,Generic)++-- | Smart constructor for 'ModName'+mkModName :: String -> ModName+mkModName s = ModName s++-- | Accessor for 'ModName'+modString :: ModName -> String+modString (ModName m) = m++-- | Smart constructor for 'PkgName'+mkPkgName :: String -> PkgName+mkPkgName s = PkgName s++-- | Accessor for 'PkgName'+pkgString :: PkgName -> String+pkgString (PkgName m) = m+++-----------------------------------------------------+--              OccName+-----------------------------------------------------++-- | Smart constructor for 'OccName'+mkOccName :: String -> OccName+mkOccName s = OccName s++-- | Accessor for 'OccName'+occString :: OccName -> String+occString (OccName occ) = occ+++-----------------------------------------------------+--               Names+-----------------------------------------------------+--+-- For "global" names ('NameG') we need a totally unique name,+-- so we must include the name-space of the thing+--+-- For unique-numbered things ('NameU'), we've got a unique reference+-- anyway, so no need for name space+--+-- For dynamically bound thing ('NameS') we probably want them to+-- in a context-dependent way, so again we don't want the name+-- space.  For example:+--+-- > let v = mkName "T" in [| data $v = $v |]+--+-- Here we use the same Name for both type constructor and data constructor+--+--+-- NameL and NameG are bound *outside* the TH syntax tree+-- either globally (NameG) or locally (NameL). Ex:+--+-- > f x = $(h [| (map, x) |])+--+-- The 'map' will be a NameG, and 'x' wil be a NameL+--+-- These Names should never appear in a binding position in a TH syntax tree++{- $namecapture #namecapture#+Much of 'Name' API is concerned with the problem of /name capture/, which+can be seen in the following example.++> f expr = [| let x = 0 in $expr |]+> ...+> g x = $( f [| x |] )+> h y = $( f [| y |] )++A naive desugaring of this would yield:++> g x = let x = 0 in x+> h y = let x = 0 in y++All of a sudden, @g@ and @h@ have different meanings! In this case,+we say that the @x@ in the RHS of @g@ has been /captured/+by the binding of @x@ in @f@.++What we actually want is for the @x@ in @f@ to be distinct from the+@x@ in @g@, so we get the following desugaring:++> g x = let x' = 0 in x+> h y = let x' = 0 in y++which avoids name capture as desired.++In the general case, we say that a @Name@ can be captured if+the thing it refers to can be changed by adding new declarations.+-}++{- |+An abstract type representing names in the syntax tree.++'Name's can be constructed in several ways, which come with different+name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for+an explanation of name capture):++  * the built-in syntax @'f@ and @''T@ can be used to construct names,+    The expression @'f@ gives a @Name@ which refers to the value @f@+    currently in scope, and @''T@ gives a @Name@ which refers to the+    type @T@ currently in scope. These names can never be captured.++  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and+     @''T@ respectively, but the @Name@s are looked up at the point+     where the current splice is being run. These names can never be+     captured.++  * 'newName' monadically generates a new name, which can never+     be captured.++  * 'mkName' generates a capturable name.++Names constructed using @newName@ and @mkName@ may be used in bindings+(such as @let x = ...@ or @\x -> ...@), but names constructed using+@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.+-}+data Name = Name OccName NameFlavour deriving (Data, Eq, Generic)++instance Ord Name where+    -- check if unique is different before looking at strings+  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`+                                        (o1 `compare` o2)++data NameFlavour+  = NameS           -- ^ An unqualified name; dynamically bound+  | NameQ ModName   -- ^ A qualified name; dynamically bound+  | NameU !Uniq     -- ^ A unique local name+  | NameL !Uniq     -- ^ Local name bound outside of the TH AST+  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:+                -- An original name (occurrences only, not binders)+                -- Need the namespace too to be sure which+                -- thing we are naming+  deriving ( Data, Eq, Ord, Show, Generic )++data NameSpace = VarName        -- ^ Variables+               | DataName       -- ^ Data constructors+               | TcClsName      -- ^ Type constructors and classes; Haskell has them+                                -- in the same name space for now.+               | FldName+                 { fldParent :: !String+                   -- ^ The textual name of the parent of the field.+                   --+                   --   - For a field of a datatype, this is the name of the first constructor+                   --     of the datatype (regardless of whether this constructor has this field).+                   --   - For a field of a pattern synonym, this is the name of the pattern synonym.+                 }+               deriving( Eq, Ord, Show, Data, Generic )++-- | @Uniq@ is used by GHC to distinguish names from each other.+type Uniq = Integer++-- | The name without its module prefix.+--+-- ==== __Examples__+--+-- >>> nameBase ''Data.Either.Either+-- "Either"+-- >>> nameBase (mkName "foo")+-- "foo"+-- >>> nameBase (mkName "Module.foo")+-- "foo"+nameBase :: Name -> String+nameBase (Name occ _) = occString occ++-- | Module prefix of a name, if it exists.+--+-- ==== __Examples__+--+-- >>> nameModule ''Data.Either.Either+-- Just "Data.Either"+-- >>> nameModule (mkName "foo")+-- Nothing+-- >>> nameModule (mkName "Module.foo")+-- Just "Module"+nameModule :: Name -> Maybe String+nameModule (Name _ (NameQ m))     = Just (modString m)+nameModule (Name _ (NameG _ _ m)) = Just (modString m)+nameModule _                      = Nothing++-- | A name's package, if it exists.+--+-- ==== __Examples__+--+-- >>> namePackage ''Data.Either.Either+-- Just "base"+-- >>> namePackage (mkName "foo")+-- Nothing+-- >>> namePackage (mkName "Module.foo")+-- Nothing+namePackage :: Name -> Maybe String+namePackage (Name _ (NameG _ p _)) = Just (pkgString p)+namePackage _                      = Nothing++-- | Returns whether a name represents an occurrence of a top-level variable+-- ('VarName'), data constructor ('DataName'), type constructor, or type class+-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.+--+-- ==== __Examples__+--+-- >>> nameSpace 'Prelude.id+-- Just VarName+-- >>> nameSpace (mkName "id")+-- Nothing -- only works for top-level variable names+-- >>> nameSpace 'Data.Maybe.Just+-- Just DataName+-- >>> nameSpace ''Data.Maybe.Maybe+-- Just TcClsName+-- >>> nameSpace ''Data.Ord.Ord+-- Just TcClsName+nameSpace :: Name -> Maybe NameSpace+nameSpace (Name _ (NameG ns _ _)) = Just ns+nameSpace _                       = Nothing++{- |+Generate a capturable name. Occurrences of such names will be+resolved according to the Haskell scoping rules at the occurrence+site.++For example:++> f = [| pi + $(varE (mkName "pi")) |]+> ...+> g = let pi = 3 in $f++In this case, @g@ is desugared to++> g = Prelude.pi + 3++Note that @mkName@ may be used with qualified names:++> mkName "Prelude.pi"++See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could+be rewritten using 'Language.Haskell.TH.Lib.dyn' as++> f = [| pi + $(dyn "pi") |]+-}+mkName :: String -> Name+-- The string can have a '.', thus "Foo.baz",+-- giving a dynamically-bound qualified name,+-- in which case we want to generate a NameQ+--+-- Parse the string to see if it has a "." in it+-- so we know whether to generate a qualified or unqualified name+-- It's a bit tricky because we need to parse+--+-- > Foo.Baz.x   as    Qual Foo.Baz x+--+-- So we parse it from back to front+mkName str+  = split [] (reverse str)+  where+    split occ []        = Name (mkOccName occ) NameS+    split occ ('.':rev) | not (null occ)+                        , is_rev_mod_name rev+                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))+        -- The 'not (null occ)' guard ensures that+        --      mkName "&." = Name "&." NameS+        -- The 'is_rev_mod' guards ensure that+        --      mkName ".&" = Name ".&" NameS+        --      mkName "^.." = Name "^.." NameS      -- #8633+        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")+        -- This rather bizarre case actually happened; (.&.) is in Data.Bits+    split occ (c:rev)   = split (c:occ) rev++    -- Recognises a reversed module name xA.yB.C,+    -- with at least one component,+    -- and each component looks like a module name+    --   (i.e. non-empty, starts with capital, all alpha)+    is_rev_mod_name rev_mod_str+      | (compt, rest) <- break (== '.') rev_mod_str+      , not (null compt), isUpper (last compt), all is_mod_char compt+      = case rest of+          []             -> True+          (_dot : rest') -> is_rev_mod_name rest'+      | otherwise+      = False++    is_mod_char c = isAlphaNum c || c == '_' || c == '\''++-- | Only used internally+mkNameU :: String -> Uniq -> Name+mkNameU s u = Name (mkOccName s) (NameU u)++-- | Only used internally+mkNameL :: String -> Uniq -> Name+mkNameL s u = Name (mkOccName s) (NameL u)++-- | Only used internally+mkNameQ :: String -> String -> Name+mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))++-- | Used for 'x etc, but not available to the programmer+mkNameG :: NameSpace -> String -> String -> String -> Name+mkNameG ns pkg modu occ+  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))++mkNameS :: String -> Name+mkNameS n = Name (mkOccName n) NameS++mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name+mkNameG_v  = mkNameG VarName+mkNameG_tc = mkNameG TcClsName+mkNameG_d  = mkNameG DataName++mkNameG_fld :: String -- ^ package+            -> String -- ^ module+            -> String -- ^ parent (first constructor of parent type)+            -> String -- ^ field name+            -> Name+mkNameG_fld pkg modu con occ = mkNameG (FldName con) pkg modu occ++data NameIs = Alone    -- ^ @name@+            | Applied  -- ^ @(name)@+            | Infix    -- ^ @\`name\`@++showName :: Name -> String+showName = showName' Alone++showName' :: NameIs -> Name -> String+showName' ni nm+ = case ni of+       Alone        -> nms+       Applied+        | pnam      -> nms+        | otherwise -> "(" ++ nms ++ ")"+       Infix+        | pnam      -> "`" ++ nms ++ "`"+        | otherwise -> nms+    where+        -- For now, we make the NameQ and NameG print the same, even though+        -- NameQ is a qualified name (so what it means depends on what the+        -- current scope is), and NameG is an original name (so its meaning+        -- should be independent of what's in scope.+        -- We may well want to distinguish them in the end.+        -- Ditto NameU and NameL+        nms = case nm of+          Name occ NameS          -> occString occ+          Name occ (NameQ m)      -> modString m ++ "." ++ occString occ+          Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ+          Name occ (NameU u)      -> occString occ ++ "_" ++ show u+          Name occ (NameL u)      -> occString occ ++ "_" ++ show u++        pnam = classify nms++        -- True if we are function style, e.g. f, [], (,)+        -- False if we are operator style, e.g. +, :++        classify "" = False -- shouldn't happen; . operator is handled below+        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =+                            case dropWhile (/='.') xs of+                                  (_:xs') -> classify xs'+                                  []      -> True+                        | otherwise = False++instance Show Name where+  show = showName++-- Tuple data and type constructors+-- | Tuple data constructor+tupleDataName :: Int -> Name+-- | Tuple type constructor+tupleTypeName :: Int -> Name++tupleDataName n = mk_tup_name n DataName  True+tupleTypeName n = mk_tup_name n TcClsName True++-- Unboxed tuple data and type constructors+-- | Unboxed tuple data constructor+unboxedTupleDataName :: Int -> Name+-- | Unboxed tuple type constructor+unboxedTupleTypeName :: Int -> Name++unboxedTupleDataName n = mk_tup_name n DataName  False+unboxedTupleTypeName n = mk_tup_name n TcClsName False++mk_tup_name :: Int -> NameSpace -> Bool -> Name+mk_tup_name n space boxed+  = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod)+  where+    withParens thing+      | boxed     = "("  ++ thing ++ ")"+      | otherwise = "(#" ++ thing ++ "#)"+    tup_occ | n == 0, space == TcClsName = if boxed then "Unit" else "Unit#"+            | n == 1 = if boxed then solo else unboxed_solo+            | space == TcClsName = "Tuple" ++ show n ++ if boxed then "" else "#"+            | otherwise = withParens (replicate n_commas ',')+    n_commas = n - 1+    tup_mod  = mkModName (if boxed then "GHC.Tuple" else "GHC.Types")+    solo+      | space == DataName = "MkSolo"+      | otherwise = "Solo"++    unboxed_solo = solo ++ "#"++-- Unboxed sum data and type constructors+-- | Unboxed sum data constructor+unboxedSumDataName :: SumAlt -> SumArity -> Name+-- | Unboxed sum type constructor+unboxedSumTypeName :: SumArity -> Name++unboxedSumDataName alt arity+  | alt > arity+  = error $ prefix ++ "Index out of bounds." ++ debug_info++  | alt <= 0+  = error $ prefix ++ "Alt must be > 0." ++ debug_info++  | arity < 2+  = error $ prefix ++ "Arity must be >= 2." ++ debug_info++  | otherwise+  = Name (mkOccName sum_occ)+         (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))++  where+    prefix     = "unboxedSumDataName: "+    debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"++    -- Synced with the definition of mkSumDataConOcc in GHC.Builtin.Types+    sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)"+    bars i = replicate i '|'+    nbars_before = alt - 1+    nbars_after  = arity - alt++unboxedSumTypeName arity+  | arity < 2+  = error $ "unboxedSumTypeName: Arity must be >= 2."+         ++ " (arity: " ++ show arity ++ ")"++  | otherwise+  = Name (mkOccName sum_occ)+         (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))++  where+    -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types+    sum_occ = "Sum" ++ show arity ++ "#"++-----------------------------------------------------+--              Locations+-----------------------------------------------------++-- | A location within a source file.+data Loc+  = Loc { loc_filename :: String+        , loc_package  :: String+        , loc_module   :: String+        , loc_start    :: CharPos+        , loc_end      :: CharPos }+   deriving( Show, Eq, Ord, Data, Generic )++type CharPos = (Int, Int)       -- ^ Line and character position+++-----------------------------------------------------+--+--      The Info returned by reification+--+-----------------------------------------------------++-- | Obtained from 'reify' in the 'Q' Monad.+data Info+  =+  -- | A class, with a list of its visible instances+  ClassI+      Dec+      [InstanceDec]++  -- | A class method+  | ClassOpI+       Name+       Type+       ParentName++  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned+  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified+  -- declaration will never have derived instances attached to it (if you wish+  -- to check for an instance, see 'reifyInstances').+  | TyConI+        Dec++  -- | A type or data family, with a list of its visible instances. A closed+  -- type family is returned with 0 instances.+  | FamilyI+        Dec+        [InstanceDec]++  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.+  -- Examples: @(->)@, @Int#@.+  | PrimTyConI+       Name+       Arity+       Unlifted++  -- | A data constructor+  | DataConI+       Name+       Type+       ParentName++  -- | A pattern synonym+  | PatSynI+       Name+       PatSynType++  {- |+  A \"value\" variable (as opposed to a type variable, see 'TyVarI').++  The @Maybe Dec@ field contains @Just@ the declaration which+  defined the variable - including the RHS of the declaration -+  or else @Nothing@, in the case where the RHS is unavailable to+  the compiler.++  At present, this value is /always/ @Nothing@:+  returning the RHS has not yet been implemented and is tracked by+  [GHC #14474](https://gitlab.haskell.org/ghc/ghc/-/issues/14474).+  -}+  | VarI+       Name+       Type+       (Maybe Dec)++  {- |+  A type variable.++  The @Type@ field contains the type which underlies the variable.+  At present, this is always @'VarT' theName@, but future changes+  may permit refinement of this.+  -}+  | TyVarI      -- Scoped type variable+        Name+        Type    -- What it is bound to+  deriving( Show, Eq, Ord, Data, Generic )++-- | Obtained from 'reifyModule' in the 'Q' Monad.+data ModuleInfo =+  -- | Contains the import list of the module.+  ModuleInfo [Module]+  deriving( Show, Eq, Ord, Data, Generic )++{- |+In 'ClassOpI' and 'DataConI', name of the parent class or type+-}+type ParentName = Name++-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a+-- particular data constructor. 'SumAlt's are one-indexed and should never+-- exceed the value of its corresponding 'SumArity'. For example:+--+-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)+--+-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)+type SumAlt = Int++-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of+-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.+type SumArity = Int++-- | In 'PrimTyConI', arity of the type constructor+type Arity = Int++-- | In 'PrimTyConI', is the type constructor unlifted?+type Unlifted = Bool++-- | 'InstanceDec' describes a single instance of a class or type function.+-- It is just a 'Dec', but guaranteed to be one of the following:+--+--   * 'InstanceD' (with empty @['Dec']@)+--+--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)+--+--   * 'TySynInstD'+type InstanceDec = Dec++-- | Fixity, as specified in a @infix[lr] n@ declaration.+data Fixity          = Fixity Int FixityDirection+    deriving( Eq, Ord, Show, Data, Generic )++-- | The associativity of an operator, as in an @infix@ declaration.+data FixityDirection = InfixL | InfixR | InfixN+    deriving( Eq, Ord, Show, Data, Generic )++-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)+maxPrecedence :: Int+maxPrecedence = (9::Int)++-- | Default fixity: @infixl 9@+defaultFixity :: Fixity+defaultFixity = Fixity maxPrecedence InfixL+++{-+Note [Unresolved infix]+~~~~~~~~~~~~~~~~~~~~~~~+-}+{- $infix #infix#++When implementing antiquotation for quasiquoters, one often wants+to parse strings into expressions:++> parse :: String -> Maybe Exp++But how should we parse @a + b * c@? If we don't know the fixities of+@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a++ b) * c@.++In cases like this, use 'UInfixE', 'UInfixP', 'UInfixT', or 'PromotedUInfixT',+which stand for \"unresolved infix expression / pattern / type / promoted+constructor\", respectively. When the compiler is given a splice containing a+tree of @UInfixE@ applications such as++> UInfixE+>   (UInfixE e1 op1 e2)+>   op2+>   (UInfixE e3 op3 e4)++it will look up and the fixities of the relevant operators and+reassociate the tree as necessary.++  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',+    which are of use for parsing expressions like++    > (a + b * c) + d * e++  * 'InfixE', 'InfixP', 'InfixT', and 'PromotedInfixT' expressions are never+    reassociated.++  * The 'UInfixE' constructor doesn't support sections. Sections+    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer+    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the+    outer-most section, and use 'UInfixE' constructors for all+    other operators:++    > InfixE+    >   Just (UInfixE ...a + b * c...)+    >   op+    >   Nothing++    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered+    into 'Exp's differently:++    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)+    >                    -- will result in a fixity error if (+) is left-infix+    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)+    >                    -- no fixity errors++  * Quoted expressions such as++    > [| a * b + c |] :: Q Exp+    > [p| a : b : c |] :: Q Pat+    > [t| T + T |] :: Q Type++    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'PromotedUInfixT',+    'InfixT', 'PromotedInfixT, 'ParensE', 'ParensP', or 'ParensT' constructors.++-}++-----------------------------------------------------+--+--      The main syntax data types+--+-----------------------------------------------------++-- | A Haskell literal. Note that the numeric types are all in terms of either+-- 'Integer' or 'Rational', regardless of the type they represent. The extra+-- precision reflects the textual representation in source code.+data Lit = CharL Char           -- ^ @\'c\'@+         | StringL String       -- ^ @"string"@+         | IntegerL Integer     -- ^ @123@. Used for overloaded and non-overloaded+                                -- literals. We don't have a good way to+                                -- represent non-overloaded literals at+                                -- the moment. Maybe that doesn't matter?+         | RationalL Rational   -- ^ @1.23@. See above comment on 'IntegerL'.+         | IntPrimL Integer     -- ^ @123#@+         | WordPrimL Integer    -- ^ @123##@+         | FloatPrimL Rational  -- ^ @1.23#@+         | DoublePrimL Rational -- ^ @1.23##@+         | StringPrimL [Word8]  -- ^ @"string"#@. A primitive C-style string, type 'Addr#'+         | BytesPrimL Bytes     -- ^ Some raw bytes, type 'Addr#':+         | CharPrimL Char       -- ^ @\'c\'#@+    deriving( Show, Eq, Ord, Data, Generic )++    -- We could add Int, Float, Double etc, as we do in HsLit,+    -- but that could complicate the+    -- supposedly-simple TH.Syntax literal type++-- | Raw bytes embedded into the binary.+--+-- Avoid using Bytes constructor directly as it is likely to change in the+-- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead.+data Bytes = Bytes+   { bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data+   , bytesOffset :: Word             -- ^ Offset from the pointer+   , bytesSize   :: Word             -- ^ Number of bytes++   -- Maybe someday:+   -- , bytesAlignement  :: Word -- ^ Alignement constraint+   -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only+   --                            --   section or not+   -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate+   --                            --   an uninitialized region+   }+   deriving (Data,Generic)++-- We can't derive Show instance for Bytes because we don't want to show the+-- pointer value but the actual bytes (similarly to what ByteString does). See+-- #16457.+instance Show Bytes where+   show b = unsafePerformIO $ withForeignPtr (bytesPtr b) $ \ptr ->+               peekCStringLen ( ptr `plusPtr` fromIntegral (bytesOffset b)+                              , fromIntegral (bytesSize b)+                              )++-- We can't derive Eq and Ord instances for Bytes because we don't want to+-- compare pointer values but the actual bytes (similarly to what ByteString+-- does).  See #16457+instance Eq Bytes where+   (==) = eqBytes++instance Ord Bytes where+   compare = compareBytes++eqBytes :: Bytes -> Bytes -> Bool+eqBytes a@(Bytes fp off len) b@(Bytes fp' off' len')+  | len /= len'              = False    -- short cut on length+  | fp == fp' && off == off' = True     -- short cut for the same bytes+  | otherwise                = compareBytes a b == EQ++compareBytes :: Bytes -> Bytes -> Ordering+compareBytes (Bytes _   _    0)    (Bytes _   _    0)    = EQ  -- short cut for empty Bytes+compareBytes (Bytes fp1 off1 len1) (Bytes fp2 off2 len2) =+    unsafePerformIO $+      withForeignPtr fp1 $ \p1 ->+      withForeignPtr fp2 $ \p2 -> do+        i <- memcmp (p1 `plusPtr` fromIntegral off1)+                    (p2 `plusPtr` fromIntegral off2)+                    (fromIntegral (min len1 len2))+        return $! (i `compare` 0) <> (len1 `compare` len2)++foreign import ccall unsafe "memcmp"+  memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt+++-- | Pattern in Haskell given in @{}@+data Pat+  = LitP Lit                        -- ^ @{ 5 or \'c\' }@+  | VarP Name                       -- ^ @{ x }@+  | TupP [Pat]                      -- ^ @{ (p1,p2) }@+  | UnboxedTupP [Pat]               -- ^ @{ (\# p1,p2 \#) }@+  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@+  | ConP Name [Type] [Pat]          -- ^ @data T1 = C1 t1 t2; {C1 \@ty1 p1 p2} = e@+  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@+  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@+                                    --+                                    -- See "Language.Haskell.TH.Syntax#infix"+  | ParensP Pat                     -- ^ @{(p)}@+                                    --+                                    -- See "Language.Haskell.TH.Syntax#infix"+  | TildeP Pat                      -- ^ @{ ~p }@+  | BangP Pat                       -- ^ @{ !p }@+  | AsP Name Pat                    -- ^ @{ x \@ p }@+  | WildP                           -- ^ @{ _ }@+  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@+  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@+  | SigP Pat Type                   -- ^ @{ p :: t }@+  | ViewP Exp Pat                   -- ^ @{ e -> p }@+  | TypeP Type                      -- ^ @{ type p }@+  | InvisP Type                     -- ^ @{ @p }@+  | OrP (NonEmpty Pat)              -- ^ @{ p1; p2 }@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A (field name, pattern) pair. See 'RecP'.+type FieldPat = (Name,Pat)++-- | A @case@-alternative+data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@+    deriving( Show, Eq, Ord, Data, Generic )++-- | A clause consists of patterns, guards, a body expression, and a list of+-- declarations under a @where@. Clauses are seen in equations for function+-- definitions, @case@-experssions, explicitly-bidirectional pattern synonyms,+-- etc.+data Clause = Clause [Pat] Body [Dec]+                                  -- ^ @f { p1 p2 = body where decs }@+    deriving( Show, Eq, Ord, Data, Generic )++-- | A Haskell expression.+data Exp+  = VarE Name                          -- ^ @{ x }@+  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @+  | LitE Lit                           -- ^ @{ 5 or \'c\'}@+  | AppE Exp Exp                       -- ^ @{ f x }@+  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@++  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@++    -- It's a bit gruesome to use an Exp as the operator when a Name+    -- would suffice. Historically, Exp was used to make it easier to+    -- distinguish between infix constructors and non-constructors.+    -- This is a bit overkill, since one could just as well call+    -- `startsConId` or `startsConSym` (from `GHC.Lexeme`) on a Name.+    -- Unfortunately, changing this design now would involve lots of+    -- code churn for consumers of the TH API, so we continue to use+    -- an Exp as the operator and perform an extra check during conversion+    -- to ensure that the Exp is a constructor or a variable (#16895).++  | UInfixE Exp Exp Exp                -- ^ @{x + y}@+                                       --+                                       -- See "Language.Haskell.TH.Syntax#infix"+  | ParensE Exp                        -- ^ @{ (e) }@+                                       --+                                       -- See "Language.Haskell.TH.Syntax#infix"+  | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@+  | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@+  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@+  | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @+                                       --+                                       -- The 'Maybe' is necessary for handling+                                       -- tuple sections.+                                       --+                                       -- > (1,)+                                       --+                                       -- translates to+                                       --+                                       -- > TupE [Just (LitE (IntegerL 1)),Nothing]++  | UnboxedTupE [Maybe Exp]            -- ^ @{ (\# e1,e2 \#) }  @+                                       --+                                       -- The 'Maybe' is necessary for handling+                                       -- tuple sections.+                                       --+                                       -- > (# 'c', #)+                                       --+                                       -- translates to+                                       --+                                       -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing]++  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\#|e|\#) }@+  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@+  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@+  | LetE [Dec] Exp                     -- ^ @{ let { x=e1; y=e2 } in e3 }@+  | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@+  | DoE (Maybe ModName) [Stmt]         -- ^ @{ do { p <- e1; e2 }  }@ or a qualified do if+                                       -- the module name is present+  | MDoE (Maybe ModName) [Stmt]        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@ or a qualified+                                       -- mdo if the module name is present+  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@+      --+      -- The result expression of the comprehension is+      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.+      --+      -- E.g. translation:+      --+      -- > [ f x | x <- xs ]+      --+      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]++  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@+  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@+  | SigE Exp Type                      -- ^ @{ e :: t }@+  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@+  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@+  | StaticE Exp                        -- ^ @{ static e }@+  | UnboundVarE Name                   -- ^ @{ _x }@+                                       --+                                       -- This is used for holes or unresolved+                                       -- identifiers in AST quotes. Note that+                                       -- it could either have a variable name+                                       -- or constructor name.+  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )+  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )+  | GetFieldE Exp String               -- ^ @{ exp.field }@ ( Overloaded Record Dot )+  | ProjectionE (NonEmpty String)      -- ^ @(.x)@ or @(.x.y)@ (Record projections)+  | TypedBracketE Exp                  -- ^ @[|| e ||]@+  | TypedSpliceE Exp                   -- ^ @$$e@+  | TypeE Type                         -- ^ @{ type t }@+  | ForallE [TyVarBndr Specificity] Exp -- ^ @forall \<vars\>. \<expr\>@+  | ForallVisE [TyVarBndr ()] Exp      -- ^ @forall \<vars\> -> \<expr\>@+  | ConstrainedE [Exp] Exp             -- ^ @\<ctxt\> => \<expr\>@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A (field name, expression) pair. See 'RecConE' and 'RecUpdE'.+type FieldExp = (Name,Exp)++-- Omitted: implicit parameters++-- | A potentially guarded expression, as in function definitions or case+-- alternatives.+data Body+  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2+                                 --      | e3 = e4 }+                                 -- where ds@+  | NormalB Exp              -- ^ @f p { = e } where ds@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A single guard.+data Guard+  = NormalG Exp -- ^ @f x { | odd x } = x@+  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A single statement, as in @do@-notation.+data Stmt+  = BindS Pat Exp -- ^ @p <- e@+  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@+  | NoBindS Exp   -- ^ @e@+  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')+  | RecS [Stmt]   -- ^ @rec { s1; s2 }@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A list/enum range expression.+data Range = FromR Exp               -- ^ @[n ..]@+           | FromThenR Exp Exp       -- ^ @[n, m ..]@+           | FromToR Exp Exp         -- ^ @[n .. m]@+           | FromThenToR Exp Exp Exp -- ^ @[n, m .. k]@+           deriving( Show, Eq, Ord, Data, Generic )++-- | A single declaration.+data Dec+  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@+  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@+  | DataD Cxt Name [TyVarBndr BndrVis]+          (Maybe Kind)            -- Kind signature (allowed only for GADTs)+          [Con] [DerivClause]+                                  -- ^ @{ data Cxt x => T x = A x | B (T x)+                                  --       deriving (Z,W)+                                  --       deriving stock Eq }@+  | NewtypeD Cxt Name [TyVarBndr BndrVis]+             (Maybe Kind)         -- Kind signature+             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)+                                  --       deriving (Z,W Q)+                                  --       deriving stock Eq }@+  | TypeDataD Name [TyVarBndr BndrVis]+          (Maybe Kind)            -- Kind signature (allowed only for GADTs)+          [Con]                   -- ^ @{ type data T x = A x | B (T x) }@+  | TySynD Name [TyVarBndr BndrVis] Type -- ^ @{ type T x = (x,x) }@+  | ClassD Cxt Name [TyVarBndr BndrVis]+         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@+  | InstanceD (Maybe Overlap) Cxt Type [Dec]+                                  -- ^ @{ instance {\-\# OVERLAPS \#-\}+                                  --        Show w => Show [w] where ds }@+  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@+  | KiSigD Name Kind              -- ^ @{ type TypeRep :: k -> Type }@+  | ForeignD Foreign              -- ^ @{ foreign import ... }+                                  --{ foreign export ... }@++  | InfixD Fixity NamespaceSpecifier Name+                                  -- ^ @{ infix 3 data foo }@+  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@++  -- | pragmas+  | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@++  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')+  | DataFamilyD Name [TyVarBndr BndrVis]+               (Maybe Kind)+         -- ^ @{ data family T a b c :: * }@++  | DataInstD Cxt (Maybe [TyVarBndr ()]) Type+             (Maybe Kind)         -- Kind signature+             [Con] [DerivClause]  -- ^ @{ data instance Cxt x => T [x]+                                  --       = A x | B (T x)+                                  --       deriving (Z,W)+                                  --       deriving stock Eq }@++  | NewtypeInstD Cxt (Maybe [TyVarBndr ()]) Type -- Quantified type vars+                 (Maybe Kind)      -- Kind signature+                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]+                                   --        = A (B x)+                                   --        deriving (Z,W)+                                   --        deriving stock Eq }@+  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@++  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')+  | OpenTypeFamilyD TypeFamilyHead+         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@++  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]+       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@++  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@+  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type+       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@+  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@++  -- | Pattern Synonyms+  | PatSynD Name PatSynArgs PatSynDir Pat+      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or+      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or+      --   @{ pattern P v1 v2 .. vn <- p+      --        where P v1 v2 .. vn = e  }@  explicit bidirectional+      --+      -- also, besides prefix pattern synonyms, both infix and record+      -- pattern synonyms are supported. See 'PatSynArgs' for details++  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.++  | ImplicitParamBindD String Exp+      -- ^ @{ ?x = expr }@+      --+      -- Implicit parameter binding declaration. Can only be used in let+      -- and where clauses which consist entirely of implicit bindings.+  deriving( Show, Eq, Ord, Data, Generic )++-- | A way to specify a namespace to look in when GHC needs to find+--   a name's source+data NamespaceSpecifier+  = NoNamespaceSpecifier   -- ^ Name may be everything; If there are two+                           --   names in different namespaces, then consider both+  | TypeNamespaceSpecifier -- ^ Name should be a type-level entity, such as a+                           --   data type, type alias, type family, type class,+                           --   or type variable+  | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a+                           --   function, data constructor, or pattern synonym+  deriving( Show, Eq, Ord, Data, Generic )++-- | Varieties of allowed instance overlap.+data Overlap = Overlappable   -- ^ May be overlapped by more specific instances+             | Overlapping    -- ^ May overlap a more general instance+             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'+             | Incoherent     -- ^ Both 'Overlapping' and 'Overlappable', and+                              -- pick an arbitrary one if multiple choices are+                              -- available.+  deriving( Show, Eq, Ord, Data, Generic )++-- | A single @deriving@ clause at the end of a datatype declaration.+data DerivClause = DerivClause (Maybe DerivStrategy) Cxt+    -- ^ @{ deriving stock (Eq, Ord) }@+  deriving( Show, Eq, Ord, Data, Generic )++-- | What the user explicitly requests when deriving an instance with+-- @-XDerivingStrategies@.+data DerivStrategy = StockStrategy    -- ^ @deriving {stock} C@+                   | AnyclassStrategy -- ^ @deriving {anyclass} C@, @-XDeriveAnyClass@+                   | NewtypeStrategy  -- ^ @deriving {newtype} C@, @-XGeneralizedNewtypeDeriving@+                   | ViaStrategy Type -- ^ @deriving C {via T}@, @-XDerivingVia@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A pattern synonym's type. Note that a pattern synonym's /fully/+-- specified type has a peculiar shape coming with two forall+-- quantifiers and two constraint contexts. For example, consider the+-- pattern synonym+--+-- > pattern P x1 x2 ... xn = <some-pattern>+--+-- P's complete type is of the following form+--+-- > pattern P :: forall universals.   required constraints+-- >           => forall existentials. provided constraints+-- >           => t1 -> t2 -> ... -> tn -> t+--+-- consisting of four parts:+--+--   1. the (possibly empty lists of) universally quantified type+--      variables and required constraints on them.+--   2. the (possibly empty lists of) existentially quantified+--      type variables and the provided constraints on them.+--   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively+--   4. the type @t@ of @\<some-pattern\>@, mentioning only universals.+--+-- Pattern synonym types interact with TH when (a) reifying a pattern+-- synonym, (b) pretty printing, or (c) specifying a pattern synonym's+-- type signature explicitly:+--+--   * Reification always returns a pattern synonym's /fully/ specified+--     type in abstract syntax.+--+--   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates+--     a pattern synonym's type unambiguously in concrete syntax: The rule of+--     thumb is to print initial empty universals and the required+--     context as @() =>@, if existentials and a provided context+--     follow. If only universals and their required context, but no+--     existentials are specified, only the universals and their+--     required context are printed. If both or none are specified, so+--     both (or none) are printed.+--+--   * When specifying a pattern synonym's type explicitly with+--     'PatSynSigD' either one of the universals, the existentials, or+--     their contexts may be left empty.+--+-- See the GHC user's guide for more information on pattern synonyms+-- and their types:+-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.+type PatSynType = Type++-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By+-- analogy with "head" for type classes and type class instances as+-- defined in /Type classes: an exploration of the design space/, the+-- @TypeFamilyHead@ is defined to be the elements of the declaration+-- between @type family@ and @where@.+data TypeFamilyHead =+  TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn)+  deriving( Show, Eq, Ord, Data, Generic )++-- | One equation of a type family instance or closed type family. The+-- arguments are the left-hand-side type and the right-hand-side result.+--+-- For instance, if you had the following type family:+--+-- @+-- type family Foo (a :: k) :: k where+--   forall k (a :: k). Foo \@k a = a+-- @+--+-- The @Foo \@k a = a@ equation would be represented as follows:+--+-- @+-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])+--            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))+--            ('VarT' a)+-- @+data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type+  deriving( Show, Eq, Ord, Data, Generic )++-- | [Functional dependency](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/functional_dependencies.html)+-- syntax, as in a class declaration.+data FunDep = FunDep [Name] [Name] -- ^ @class C a b {| a -> b}@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A @foreign@ declaration.+data Foreign = ImportF Callconv Safety String Name Type+             -- ^ @foreign import callconv safety "foreign_name" haskellName :: type@+             | ExportF Callconv        String Name Type+             -- ^ @foreign export callconv "foreign_name" haskellName :: type@+         deriving( Show, Eq, Ord, Data, Generic )++-- keep Callconv in sync with module ForeignCall in ghc/compiler/GHC/Types/ForeignCall.hs+-- | A calling convention identifier, as in a 'Foreign' declaration.+data Callconv = CCall | StdCall | CApi | Prim | JavaScript+          deriving( Show, Eq, Ord, Data, Generic )++-- | A safety level, as in a 'Foreign' declaration.+data Safety = Unsafe | Safe | Interruptible+        deriving( Show, Eq, Ord, Data, Generic )++data Pragma = InlineP         Name Inline RuleMatch Phases+            -- ^ @{ {\-\# [inline] [rule match] [phases] [phases] name #-} }@. See+            -- 'Inline' and 'RuleMatch'.+            | OpaqueP         Name+            -- ^ @{ {\-\# OPAQUE T #-} }@+            | SpecialiseP     Name Type (Maybe Inline) Phases+            -- ^ @{ {\-\# SPECIALISE [INLINE] [phases] T #-} }@+            | SpecialiseInstP Type+            -- ^ @{ {\-\# SPECIALISE instance I #-} }@+            | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases+            -- ^ @{ {\-\# RULES "name" [phases] [forall t_1 ... t_i]. [forall b_1 ... b_j] rules... e_1 = e_2 #-} }@+            | AnnP            AnnTarget Exp+            -- ^ @{ {\-\# ANN target exp #-} }@+            | LineP           Int String+            -- ^ @{ {\-\# LINE n "file name" #-} }@+            | CompleteP       [Name] (Maybe Name)+                -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@+            | SCCP            Name (Maybe String)+                -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@+        deriving( Show, Eq, Ord, Data, Generic )++-- | An inline pragma.+data Inline = NoInline+            -- ^ @{ {\-\# NOINLINE ... #-} }@+            | Inline+            -- ^ @{ {\-\# INLINE ... #-} }@+            | Inlinable+            -- ^ @{ {\-\# INLINABLE ... #-} }@+            deriving (Show, Eq, Ord, Data, Generic)++-- | A @CONLIKE@ modifier, as in one of the various inline pragmas, or lack+-- thereof ('FunLike').+data RuleMatch = ConLike+               -- ^ @{ {\-\# CONLIKE [inline] ... #-} }@+               | FunLike+               -- ^ @{ {\-\# [inline] ... #-} }@+               deriving (Show, Eq, Ord, Data, Generic)++-- | Phase control syntax.+data Phases = AllPhases+            -- ^ The default when unspecified+            | FromPhase Int+            -- ^ @[n]@+            | BeforePhase Int+            -- ^ @[~n]@+            deriving (Show, Eq, Ord, Data, Generic)++-- | A binder found in the @forall@ of a @RULES@ pragma.+data RuleBndr = RuleVar Name+              -- ^ @forall {a} ... .@+              | TypedRuleVar Name Type+              -- ^ @forall {(a :: t)} ... .@+              deriving (Show, Eq, Ord, Data, Generic)++-- | The target of an @ANN@ pragma+data AnnTarget = ModuleAnnotation+               -- ^ @{\-\# ANN {module} ... #-}@+               | TypeAnnotation Name+               -- ^ @{\-\# ANN type {name} ... #-}@+               | ValueAnnotation Name+               -- ^ @{\-\# ANN {name} ... #-}@+              deriving (Show, Eq, Ord, Data, Generic)++-- | A context, as found on the left side of a @=>@ in a type.+type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@++-- | Since the advent of @ConstraintKinds@, constraints are really just types.+-- Equality constraints use the 'EqualityT' constructor. Constraints may also+-- be tuples of other constraints.+type Pred = Type++-- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code.+--+-- This may not agree with the annotations returned by 'reifyConStrictness'.+-- See 'reifyConStrictness' for more information.+data SourceUnpackedness+  = NoSourceUnpackedness -- ^ @C a@+  | SourceNoUnpack       -- ^ @C { {\-\# NOUNPACK \#-\} } a@+  | SourceUnpack         -- ^ @C { {\-\# UNPACK \#-\} } a@+        deriving (Show, Eq, Ord, Data, Generic)++-- | 'SourceStrictness' corresponds to strictness annotations found in the source code.+--+-- This may not agree with the annotations returned by 'reifyConStrictness'.+-- See 'reifyConStrictness' for more information.+data SourceStrictness = NoSourceStrictness    -- ^ @C a@+                      | SourceLazy            -- ^ @C {~}a@+                      | SourceStrict          -- ^ @C {!}a@+        deriving (Show, Eq, Ord, Data, Generic)++-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'+-- refers to the strictness annotations that the compiler chooses for a data constructor+-- field, which may be different from what is written in source code.+--+-- Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate,+-- such as the field of a newtype constructor and fields that have an unlifted type.+--+-- See 'reifyConStrictness' for more information.+data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.+                       | DecidedStrict -- ^ Field inferred to have a bang.+                       | DecidedUnpack -- ^ Field inferred to be unpacked.+        deriving (Show, Eq, Ord, Data, Generic)++-- | A data constructor.+--+-- The constructors for 'Con' can roughly be divided up into two categories:+-- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and+-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and+-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type+-- variables and class contexts, can surround either variety of constructor.+-- However, the type variables that it quantifies are different depending+-- on what constructor syntax is used:+--+-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the+--   'ForallC' will only quantify /existential/ type variables. For example:+--+--   @+--   data Foo a = forall b. MkFoo a b+--   @+--+--   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.+--+-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the+--   'ForallC' will quantify /all/ type variables used in the constructor.+--   For example:+--+--   @+--   data Bar a b where+--     MkBar :: (a ~ b) => c -> MkBar a b+--   @+--+--   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.+--+-- Multiplicity annotations for data types are currently not supported+-- in Template Haskell (i.e. all fields represented by Template Haskell+-- will be linear).+data Con =+  -- | @C Int a@+    NormalC Name [BangType]++  -- | @C { v :: Int, w :: a }@+  | RecC Name [VarBangType]++  -- | @Int :+ a@+  | InfixC BangType Name BangType++  -- | @forall a. Eq a => C [a]@+  | ForallC [TyVarBndr Specificity] Cxt Con++  -- @C :: a -> b -> T b Int@+  | GadtC [Name]+            -- ^ The list of constructors, corresponding to the GADT constructor+            -- syntax @C1, C2 :: a -> T b@.+            --+            -- Invariant: the list must be non-empty.+          [BangType] -- ^ The constructor arguments+          Type -- ^ See Note [GADT return type]++  -- | @C :: { v :: Int } -> T b Int@+  | RecGadtC [Name]+             -- ^ The list of constructors, corresponding to the GADT record+             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.+             --+             -- Invariant: the list must be non-empty.+             [VarBangType] -- ^ The constructor arguments+             Type -- ^ See Note [GADT return type]+        deriving (Show, Eq, Ord, Data, Generic)++-- Note [GADT return type]+-- ~~~~~~~~~~~~~~~~~~~~~~~+-- The return type of a GADT constructor does not necessarily match the name of+-- the data type:+--+-- type S = T+--+-- data T a where+--     MkT :: S Int+--+--+-- type S a = T+--+-- data T a where+--     MkT :: S Char Int+--+--+-- type Id a = a+-- type S a = T+--+-- data T a where+--     MkT :: Id (S Char Int)+--+--+-- That is why we allow the return type stored by a constructor to be an+-- arbitrary type. See also #11341++-- | Strictness information in a data constructor's argument.+data Bang = Bang SourceUnpackedness SourceStrictness+         -- ^ @C { {\-\# UNPACK \#-\} !}a@+        deriving (Show, Eq, Ord, Data, Generic)++-- | A type with a strictness annotation, as in data constructors. See 'Con'.+type BangType    = (Bang, Type)++-- | 'BangType', but for record fields. See 'Con'.+type VarBangType = (Name, Bang, Type)++-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.+type Strict      = Bang++-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by+-- 'BangType'.+type StrictType    = BangType++-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by+-- 'VarBangType'.+type VarStrictType = VarBangType++-- | A pattern synonym's directionality.+data PatSynDir+  = Unidir             -- ^ @pattern P x {<-} p@+  | ImplBidir          -- ^ @pattern P x {=} p@+  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A pattern synonym's argument type.+data PatSynArgs+  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@+  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@+  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A Haskell type.+data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@+          | ForallVisT [TyVarBndr ()] Type -- ^ @forall \<vars\> -> \<type\>@+          | AppT Type Type                 -- ^ @T a b@+          | AppKindT Type Kind             -- ^ @T \@k t@+          | SigT Type Kind                 -- ^ @t :: k@+          | VarT Name                      -- ^ @a@+          | ConT Name                      -- ^ @T@+          | PromotedT Name                 -- ^ @'T@+          | InfixT Type Name Type          -- ^ @T + T@+          | UInfixT Type Name Type         -- ^ @T + T@+                                           --+                                           -- See "Language.Haskell.TH.Syntax#infix"+          | PromotedInfixT Type Name Type  -- ^ @T :+: T@+          | PromotedUInfixT Type Name Type -- ^ @T :+: T@+                                           --+                                           -- See "Language.Haskell.TH.Syntax#infix"+          | ParensT Type                   -- ^ @(T)@++          -- See Note [Representing concrete syntax in types]+          | TupleT Int                     -- ^ @(,)@, @(,,)@, etc.+          | UnboxedTupleT Int              -- ^ @(\#,\#)@, @(\#,,\#)@, etc.+          | UnboxedSumT SumArity           -- ^ @(\#|\#)@, @(\#||\#)@, etc.+          | ArrowT                         -- ^ @->@+          | MulArrowT                      -- ^ @%n ->@+                                           --+                                           -- Generalised arrow type with multiplicity argument+          | EqualityT                      -- ^ @~@+          | ListT                          -- ^ @[]@+          | PromotedTupleT Int             -- ^ @'()@, @'(,)@, @'(,,)@, etc.+          | PromotedNilT                   -- ^ @'[]@+          | PromotedConsT                  -- ^ @'(:)@+          | StarT                          -- ^ @*@+          | ConstraintT                    -- ^ @Constraint@+          | LitT TyLit                     -- ^ @0@, @1@, @2@, etc.+          | WildCardT                      -- ^ @_@+          | ImplicitParamT String Type     -- ^ @?x :: t@+      deriving( Show, Eq, Ord, Data, Generic )++-- | The specificity of a type variable in a @forall ...@.+data Specificity = SpecifiedSpec          -- ^ @a@+                 | InferredSpec           -- ^ @{a}@+      deriving( Show, Eq, Ord, Data, Generic )++-- | The @flag@ type parameter is instantiated to one of the following types:+--+--   * 'Specificity' (examples: 'ForallC', 'ForallT')+--   * 'BndrVis' (examples: 'DataD', 'ClassD', etc.)+--   * '()', a catch-all type for other forms of binders, including 'ForallVisT', 'DataInstD', 'RuleP', and 'TyVarSig'+--+data TyVarBndr flag = PlainTV  Name flag      -- ^ @a@+                    | KindedTV Name flag Kind -- ^ @(a :: k)@+      deriving( Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable )++-- | Visibility of a type variable. See [Inferred vs. specified type variables](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html#inferred-vs-specified-type-variables).+data BndrVis = BndrReq                    -- ^ @a@+             | BndrInvis                  -- ^ @\@a@+      deriving( Show, Eq, Ord, Data, Generic )++-- | Type family result signature+data FamilyResultSig = NoSig              -- ^ no signature+                     | KindSig  Kind      -- ^ @k@+                     | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@+      deriving( Show, Eq, Ord, Data, Generic )++-- | Injectivity annotation as in an [injective type family](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_families.html)+data InjectivityAnn = InjectivityAnn Name [Name]+  deriving ( Show, Eq, Ord, Data, Generic )++-- | Type-level literals.+data TyLit = NumTyLit Integer             -- ^ @2@+           | StrTyLit String              -- ^ @\"Hello\"@+           | CharTyLit Char               -- ^ @\'C\'@, @since 4.16.0.0+  deriving ( Show, Eq, Ord, Data, Generic )++-- | Role annotations+data Role = NominalR            -- ^ @nominal@+          | RepresentationalR   -- ^ @representational@+          | PhantomR            -- ^ @phantom@+          | InferR              -- ^ @_@+  deriving( Show, Eq, Ord, Data, Generic )++-- | Annotation target for reifyAnnotations+data AnnLookup = AnnLookupModule Module+               | AnnLookupName Name+               deriving( Show, Eq, Ord, Data, Generic )++-- | To avoid duplication between kinds and types, they+-- are defined to be the same. Naturally, you would never+-- have a type be 'StarT' and you would never have a kind+-- be 'SigT', but many of the other constructors are shared.+-- Note that the kind @Bool@ is denoted with 'ConT', not+-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',+-- not 'PromotedTupleT'.++type Kind = Type++{- Note [Representing concrete syntax in types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Haskell has a rich concrete syntax for types, including+  t1 -> t2, (t1,t2), [t], and so on+In TH we represent all of this using AppT, with a distinguished+type constructor at the head.  So,+  Type              TH representation+  -----------------------------------------------+  t1 -> t2          ArrowT `AppT` t2 `AppT` t2+  [t]               ListT `AppT` t+  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2+  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2++But if the original HsSyn used prefix application, we won't use+these special TH constructors.  For example+  [] t              ConT "[]" `AppT` t+  (->) t            ConT "->" `AppT` t+In this way we can faithfully represent in TH whether the original+HsType used concrete syntax or not.++The one case that doesn't fit this pattern is that of promoted lists+  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2+but it's very smelly because there really is no type constructor+corresponding to PromotedListT. So we encode HsExplicitListTy with+PromotedConsT and PromotedNilT (which *do* have underlying type+constructors):+  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`+                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)+-}++-- | A location at which to attach Haddock documentation.+-- Note that adding documentation to a 'Name' defined oustide of the current+-- module will cause an error.+data DocLoc+  = ModuleDoc         -- ^ At the current module's header.+  | DeclDoc Name      -- ^ At a declaration, not necessarily top level.+  | ArgDoc Name Int   -- ^ At a specific argument of a function, indexed by its+                      -- position.+  | InstDoc Type      -- ^ At a class or family instance.+  deriving ( Show, Eq, Ord, Data, Generic )++-----------------------------------------------------+--              Internal helper functions+-----------------------------------------------------++-- | Internal helper function.+cmpEq :: Ordering -> Bool+cmpEq EQ = True+cmpEq _  = False++-- | Internal helper function.+thenCmp :: Ordering -> Ordering -> Ordering+thenCmp EQ o2 = o2+thenCmp o1 _  = o1++-- | Internal helper function.+get_cons_names :: Con -> [Name]+get_cons_names (NormalC n _)     = [n]+get_cons_names (RecC n _)        = [n]+get_cons_names (InfixC _ n _)    = [n]+get_cons_names (ForallC _ _ con) = get_cons_names con+-- GadtC can have multiple names, e.g+-- > data Bar a where+-- >   MkBar1, MkBar2 :: a -> Bar a+-- Will have one GadtC with [MkBar1, MkBar2] as names+get_cons_names (GadtC ns _ _)    = ns+get_cons_names (RecGadtC ns _ _) = ns
libraries/ghc-platform/src/GHC/Platform/ArchOS.hs view
@@ -10,7 +10,7 @@    , ArmISAExt(..)    , ArmABI(..)    , PPC_64ABI(..)-   , isARM+   , isARM, isPPC    , stringEncodeArch       -- * Operating systems@@ -126,8 +126,7 @@   ArchX86           -> "i386"   ArchX86_64        -> "x86_64"   ArchPPC           -> "powerpc"-  ArchPPC_64 ELF_V1 -> "powerpc64"-  ArchPPC_64 ELF_V2 -> "powerpc64le"+  ArchPPC_64 _      -> "powerpc64"   ArchS390X         -> "s390x"   ArchARM ARMv5 _ _ -> "armv5"   ArchARM ARMv6 _ _ -> "armv6"@@ -188,6 +187,11 @@ isARM (ArchARM {}) = True isARM ArchAArch64  = True isARM _ = False++isPPC :: Arch -> Bool+isPPC (ArchPPC_64 _) = True+isPPC ArchPPC        = True+isPPC _              = False  -- | This predicate tells us whether the OS support Mach-O shared libraries. osMachOTarget :: OS -> Bool
libraries/ghci/GHCi/FFI.hsc view
@@ -36,7 +36,6 @@ {-# LANGUAGE CPP, DeriveGeneric, DeriveAnyClass #-} module GHCi.FFI   ( FFIType(..)-  , FFIConv(..)   , C_ffi_cif   , prepForeignCall   , freeForeignCallInfo@@ -66,36 +65,27 @@   | FFIUInt64   deriving (Show, Generic, Binary) -data FFIConv-  = FFICCall-  | FFIStdCall-  deriving (Show, Generic, Binary)-- prepForeignCall-    :: FFIConv-    -> [FFIType]          -- arg types+    :: [FFIType]          -- arg types     -> FFIType            -- result type     -> IO (Ptr C_ffi_cif) -- token for making calls (must be freed by caller)  #if !defined(javascript_HOST_ARCH)-prepForeignCall cconv arg_types result_type = do+prepForeignCall arg_types result_type = do   let n_args = length arg_types   arg_arr <- mallocArray n_args   pokeArray arg_arr (map ffiType arg_types)   cif <- mallocBytes (#const sizeof(ffi_cif))-  let abi = convToABI cconv-  r <- ffi_prep_cif cif abi (fromIntegral n_args) (ffiType result_type) arg_arr+  r <- ffi_prep_cif cif fFI_DEFAULT_ABI (fromIntegral n_args) (ffiType result_type) arg_arr   if r /= fFI_OK then     throwIO $ ErrorCall $ concat       [ "prepForeignCallFailed: ", strError r,-        "(cconv: ", show cconv,-        " arg tys: ", show arg_types,+        "(arg tys: ", show arg_types,         " res ty: ", show result_type, ")" ]   else     return (castPtr cif) #else-prepForeignCall _ _ _ =+prepForeignCall _ _ =   error "GHCi.FFI.prepForeignCall: Called with JS_HOST_ARCH! Perhaps you need to run configure?" #endif @@ -124,14 +114,6 @@   | otherwise   = "unknown error: " ++ show r -convToABI :: FFIConv -> C_ffi_abi-convToABI FFICCall  = fFI_DEFAULT_ABI-#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)-convToABI FFIStdCall = fFI_STDCALL-#endif--- unknown conventions are mapped to the default, (#3336)-convToABI _           = fFI_DEFAULT_ABI- ffiType :: FFIType -> Ptr C_ffi_type ffiType FFIVoid     = ffi_type_void ffiType FFIPointer  = ffi_type_pointer@@ -169,10 +151,6 @@  fFI_DEFAULT_ABI :: C_ffi_abi fFI_DEFAULT_ABI = (#const FFI_DEFAULT_ABI)-#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)-fFI_STDCALL     :: C_ffi_abi-fFI_STDCALL     = (#const FFI_STDCALL)-#endif  -- ffi_status ffi_prep_cif(ffi_cif *cif, --                         ffi_abi abi,
libraries/ghci/GHCi/Message.hs view
@@ -40,6 +40,9 @@ import GHC.Conc (pseq, par) import Control.Concurrent import Control.Exception+#if MIN_VERSION_base(4,20,0)+import Control.Exception.Context+#endif import Data.Binary import Data.Binary.Get import Data.Binary.Put@@ -53,8 +56,7 @@ import Foreign import GHC.Generics import GHC.Stack.CCS-import qualified Language.Haskell.TH        as TH-import qualified Language.Haskell.TH.Syntax as TH+import qualified GHC.Internal.TH.Syntax        as TH import System.Exit import System.IO import System.IO.Error@@ -104,7 +106,7 @@   MallocStrings :: [ByteString] -> Message [RemotePtr ()]    -- | Calls 'GHCi.FFI.prepareForeignCall'-  PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)+  PrepFFI :: [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)    -- | Free data previously created by 'PrepFFI'   FreeFFI :: RemotePtr C_ffi_cif -> Message ()@@ -443,7 +445,15 @@ toSerializableException ex   | Just UserInterrupt <- fromException ex  = EUserInterrupt   | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)-  | otherwise = EOtherException (show (ex :: SomeException))+  | otherwise = EOtherException $+#if MIN_VERSION_base(4,20,0)+      -- Exception plus backtrace as seen in `displayExceptionWithInfo`+      case displayExceptionContext (someExceptionContext ex) of+        "" -> displayException (ex :: SomeException)+        cx -> displayException (ex :: SomeException) ++ "\n\n" ++ cx+#else+      show (ex :: SomeException)+#endif  fromSerializableException :: SerializableException -> SomeException fromSerializableException EUserInterrupt = toException UserInterrupt@@ -492,8 +502,8 @@ #ifndef MIN_VERSION_ghc_heap #define MIN_VERSION_ghc_heap(major1,major2,minor) (\   (major1) <  9 || \-  (major1) == 9 && (major2) <  10 || \-  (major1) == 9 && (major2) == 10 && (minor) <= 3)+  (major1) == 9 && (major2) <  12 || \+  (major1) == 9 && (major2) == 12 && (minor) <= 1) #endif /* MIN_VERSION_ghc_heap */ #if MIN_VERSION_ghc_heap(8,11,0) instance Binary Heap.StgTSOProfInfo@@ -533,7 +543,7 @@       13 -> Msg <$> FreeHValueRefs <$> get       14 -> Msg <$> MallocData <$> get       15 -> Msg <$> MallocStrings <$> get-      16 -> Msg <$> (PrepFFI <$> get <*> get <*> get)+      16 -> Msg <$> (PrepFFI <$> get <*> get)       17 -> Msg <$> FreeFFI <$> get       18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get <*> get)       19 -> Msg <$> (EvalStmt <$> get <*> get)@@ -579,7 +589,7 @@   FreeHValueRefs val          -> putWord8 13 >> put val   MallocData bs               -> putWord8 14 >> put bs   MallocStrings bss           -> putWord8 15 >> put bss-  PrepFFI conv args res       -> putWord8 16 >> put conv >> put args >> put res+  PrepFFI args res            -> putWord8 16 >> put args >> put res   FreeFFI p                   -> putWord8 17 >> put p   MkConInfoTable tc p n t pt d -> putWord8 18 >> put tc >> put p >> put n >> put t >> put pt >> put d   EvalStmt opts val           -> putWord8 19 >> put opts >> put val
libraries/ghci/GHCi/ResolvedBCO.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving,     BangPatterns, CPP, MagicHash, FlexibleInstances, FlexibleContexts,-    TypeApplications, ScopedTypeVariables, UnboxedTuples #-}+    TypeApplications, ScopedTypeVariables, UnboxedTuples, UndecidableInstances #-} module GHCi.ResolvedBCO   ( ResolvedBCO(..)   , ResolvedBCOPtr(..)@@ -15,18 +15,12 @@ import GHCi.BreakArray  import Data.Binary-import Data.Binary.Put (putBuilder) import GHC.Generics -import Foreign.Ptr-import Data.Array.Byte-import qualified Data.Binary.Get.Internal as Binary-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Builder.Internal as BB+import Foreign.Storable import GHC.Exts-import Data.Array.Base (UArray(..))+import Data.Array.Base (IArray, UArray(..)) -import GHC.IO  #include "MachDeps.h" @@ -63,6 +57,12 @@         getBCOByteArray :: !ByteArray#   } +fromBCOByteArray :: forall a . Storable a => BCOByteArray a -> UArray Int a+fromBCOByteArray (BCOByteArray ba#) = UArray 0 (n - 1) n ba#+  where+    len# = sizeofByteArray# ba#+    n = (I# len#) `div` sizeOf (undefined :: a)+ mkBCOByteArray :: UArray Int a -> BCOByteArray a mkBCOByteArray (UArray _ _ _ arr) = BCOByteArray arr @@ -87,9 +87,10 @@     put resolvedBCOPtrs   get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get -instance Binary (BCOByteArray a) where-  put = putBCOByteArray-  get = decodeBCOByteArray+-- See Note [BCOByteArray serialization]+instance (Binary a, Storable a, IArray UArray a) => Binary (BCOByteArray a) where+  put = put . fromBCOByteArray+  get = mkBCOByteArray <$> get   data ResolvedBCOPtr@@ -107,64 +108,29 @@  instance Binary ResolvedBCOPtr --- ----------------------------------------------------------- Serialisers for 'BCOByteArray'--- ----------------------------------------------------------putBCOByteArray :: BCOByteArray a -> Put-putBCOByteArray (BCOByteArray bar) = do-  put (I# (sizeofByteArray# bar))-  putBuilder $ byteArrayBuilder bar--decodeBCOByteArray :: Get (BCOByteArray a)-decodeBCOByteArray = do-  n <- get-  getByteArray n--byteArrayBuilder :: ByteArray# -> BB.Builder-byteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#))-  where-    go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a-    go !inStart !inEnd k (BB.BufferRange outStart outEnd)-      -- There is enough room in this output buffer to write all remaining array-      -- contents-      | inRemaining <= outRemaining = do-          copyByteArrayToAddr arr# inStart outStart inRemaining-          k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd)-      -- There is only enough space for a fraction of the remaining contents-      | otherwise = do-          copyByteArrayToAddr arr# inStart outStart outRemaining-          let !inStart' = inStart + outRemaining-          return $! BB.bufferFull 1 outEnd (go inStart' inEnd k)-      where-        inRemaining  = inEnd - inStart-        outRemaining = outEnd `minusPtr` outStart--    copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()-    copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) =-        IO $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of-                     s' -> (# s', () #)--getByteArray :: Int -> Get (BCOByteArray a)-getByteArray nbytes@(I# nbytes#) = do-    let !(MutableByteArray arr#) = unsafeDupablePerformIO $-          IO $ \s -> case newByteArray# nbytes# s of-                (# s', mbar #) -> (# s', MutableByteArray mbar #)-    let go 0 _ = return ()-        go !remaining !off = do-            Binary.readNWith n $ \ptr ->-              copyAddrToByteArray ptr arr# off n-            go (remaining - n) (off + n)-          where n = min chunkSize remaining-    go nbytes 0-    return $! unsafeDupablePerformIO $-      IO $ \s -> case unsafeFreezeByteArray# arr# s of-          (# s', bar #) -> (# s', BCOByteArray bar #)-  where-    chunkSize = 10*1024--    copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld-                        -> Int -> Int -> IO ()-    copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) =-        IO $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of-                     s' -> (# s', () #)+-- Note [BCOByteArray serialization]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- !12142 changed some BCO blob types from UArray to+-- BCOByteArray(ByteArray#) to save a little space. Unfortunately, a+-- nasty serialization bug has surfaced since then. It happens when we+-- need to pass BCOByteArray between host/target with mismatching word+-- sizes. When 32-bit iserv receives a `BCOByteArray Word` from 64-bit+-- host GHC, it would parse the buffer assuming each Word=Word32, even+-- if host GHC assumes each Word=Word64, and of course it's horribly+-- wrong!+--+-- The root issue here is the usage of platform sized integer types in+-- BCO (and any messages we pass between ghc/iserv really), we should+-- do what we already do for RemotePtr: always use Word64 instead of+-- Word. But that takes much more work, and there's an easier+-- mitigation: keep BCOByteArray as ByteArray#, but serialize it as+-- UArray, given the Binary instances are independent of platform word+-- size and endianness, so each Word/Int is always serialized as+-- 64-bit big-endian Word64/Int64, and the entire UArray is serialized+-- as a list (length+elements).+--+-- Since we erase the metadata in UArray, we need to find a way to+-- calculate the item count by dividing the ByteArray# length with+-- element size. The element size comes from Storable's sizeOf method,+-- thus the addition of Storable constraint.
libraries/ghci/GHCi/TH/Binary.hs view
@@ -12,8 +12,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import GHC.Serialized-import qualified Language.Haskell.TH        as TH-import qualified Language.Haskell.TH.Syntax as TH+import qualified GHC.Internal.TH.Syntax as TH -- Put these in a separate module because they take ages to compile  instance Binary TH.Loc
libraries/ghci/ghci.cabal view
@@ -2,7 +2,7 @@ -- ../../configure.  Make sure you are editing ghci.cabal.in, not ghci.cabal.  name:           ghci-version:        9.10.3+version:        9.12.1 license:        BSD3 license-file:   LICENSE category:       GHC@@ -22,6 +22,15 @@     Default: False     Manual: True +Flag bootstrap+        Description:+          Enabled when building the stage1 compiler in order to vendor the in-tree+          `ghc-boot-th` library, and through that the in-tree TH AST defintions from+          `ghc-internal`.+          See Note [Bootstrapping Template Haskell]+        Default: False+        Manual: True+ source-repository head     type:     git     location: https://gitlab.haskell.org/ghc/ghc.git@@ -75,17 +84,31 @@     Build-Depends:         rts,         array            == 0.5.*,-        base             >= 4.8 && < 4.21,-        ghc-prim         >= 0.5.0 && < 0.13,+        base             >= 4.8 && < 4.22,+        -- ghc-internal     == 9.1201.*+        -- TODO: Use GHC.Internal.Desugar and GHC.Internal.Base from+        -- ghc-internal instead of ignoring the deprecation warning in GHCi.TH+        -- and GHCi.CreateBCO when we require ghc-internal of the bootstrap+        -- compiler+        ghc-prim         >= 0.5.0 && < 0.14,         binary           == 0.8.*,         bytestring       >= 0.10 && < 0.13,         containers       >= 0.5 && < 0.8,         deepseq          >= 1.4 && < 1.6,         filepath         >= 1.4 && < 1.6,-        ghc-boot         == 9.10.3,-        ghc-heap         == 9.10.3,-        template-haskell == 2.22.*,+        ghc-boot         == 9.12.1,+        ghc-heap         == 9.12.1,         transformers     >= 0.5 && < 0.7 +    if flag(bootstrap)+      build-depends:+            ghc-boot-th-next  == 9.12.1+    else+      build-depends:+            ghc-boot-th       == 9.12.1+     if !os(windows)         Build-Depends: unix >= 2.7 && < 2.9++    if arch(wasm32)+        build-depends: ghc-experimental == 9.1201.0
− libraries/template-haskell/Language/Haskell/TH.hs 
@@ -1,109 +0,0 @@-{- | The public face of Template Haskell--For other documentation, refer to:-<https://wiki.haskell.org/Template_Haskell>---}-{-# LANGUAGE Safe #-}-module Language.Haskell.TH(-        -- * The monad and its operations-        Q,-        runQ,-        Quote(..),-        -- ** Administration: errors, locations and IO-        reportError,              -- :: String -> Q ()-        reportWarning,            -- :: String -> Q ()-        report,                   -- :: Bool -> String -> Q ()-        recover,          -- :: Q a -> Q a -> Q a-        location,         -- :: Q Loc-        Loc(..),-        runIO,            -- :: IO a -> Q a-        -- ** Querying the compiler-        -- *** Reify-        reify,            -- :: Name -> Q Info-        reifyModule,-        newDeclarationGroup,-        Info(..), ModuleInfo(..),-        InstanceDec,-        ParentName,-        SumAlt, SumArity,-        Arity,-        Unlifted,-        -- *** Language extension lookup-        Extension(..),-        extsEnabled, isExtEnabled,-        -- *** Name lookup-        lookupTypeName,  -- :: String -> Q (Maybe Name)-        lookupValueName, -- :: String -> Q (Maybe Name)-        -- *** Fixity lookup-        reifyFixity,-        -- *** Type lookup-        reifyType,-        -- *** Instance lookup-        reifyInstances,-        isInstance,-        -- *** Roles lookup-        reifyRoles,-        -- *** Annotation lookup-        reifyAnnotations, AnnLookup(..),-        -- *** Constructor strictness lookup-        reifyConStrictness,--        -- * Typed expressions-        TExp, unType,-        Code(..), unTypeCode, unsafeCodeCoerce, hoistCode, bindCode,-        bindCode_, joinCode, liftCode,--        -- * Names-        Name, NameSpace,        -- Abstract-        -- ** Constructing names-        mkName,         -- :: String -> Name-        -- ** Deconstructing names-        nameBase,       -- :: Name -> String-        nameModule,     -- :: Name -> Maybe String-        namePackage,    -- :: Name -> Maybe String-        nameSpace,      -- :: Name -> Maybe NameSpace-        -- ** Built-in names-        tupleTypeName, tupleDataName,   -- Int -> Name-        unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name-        unboxedSumTypeName, -- :: SumArity -> Name-        unboxedSumDataName, -- :: SumAlt -> SumArity -> Name--    -- * The algebraic data types-    -- | The lowercase versions (/syntax operators/) of these constructors are-    -- preferred to these constructors, since they compose better with-    -- quotations (@[| |]@) and splices (@$( ... )@)--    -- ** Declarations-        Dec(..), Con(..), Clause(..),-        SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..),-        Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..),-        Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),-        FunDep(..), TySynEqn(..), TypeFamilyHead(..),-        Fixity(..), FixityDirection(..), NamespaceSpecifier(..), defaultFixity,-        maxPrecedence,-        PatSynDir(..), PatSynArgs(..),-    -- ** Expressions-        Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),-    -- ** Patterns-        Pat(..), FieldExp, FieldPat,-    -- ** Types-        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),-        Syntax.Specificity(..),-        Syntax.BndrVis(..),-        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType, BangType, VarBangType,--    -- ** Documentation-        putDoc, getDoc, DocLoc(..),--    -- * Library functions-    module Language.Haskell.TH.Lib,--    -- * Pretty-printer-    Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType--   ) where--import Language.Haskell.TH.Syntax as Syntax-import Language.Haskell.TH.Lib-import Language.Haskell.TH.Ppr
− libraries/template-haskell/Language/Haskell/TH/LanguageExtensions.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE Safe #-}--------------------------------------------------------------------------------- |--- Module      :  Language.Haskell.TH.LanguageExtensions--- Copyright   :  (c) The University of Glasgow 2015--- License     :  BSD-style (see the file libraries/base/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ Language extensions known to GHC-----------------------------------------------------------------------------------module Language.Haskell.TH.LanguageExtensions-   ( Extension(..)-   ) where---- This module exists primarily to avoid inserting a massive list of language--- extensions into the already quite large Haddocks for Language.Haskell.TH--import GHC.LanguageExtensions.Type (Extension(..))
− libraries/template-haskell/Language/Haskell/TH/Lib.hs 
@@ -1,393 +0,0 @@-{-# LANGUAGE Safe #-}---- |--- Language.Haskell.TH.Lib contains lots of useful helper functions for--- generating and manipulating Template Haskell terms---- Note: this module mostly re-exports functions from--- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template--- Haskell which requires breaking the API offered in this module, we opt to--- copy the old definition here, and make the changes in--- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards--- compatibility while still allowing GHC to make changes as it needs.--module Language.Haskell.TH.Lib (-    -- All of the exports from this module should-    -- be "public" functions.  The main module TH-    -- re-exports them all.--    -- * Library functions-    -- ** Abbreviations-        InfoQ, ExpQ, TExpQ, CodeQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,-        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,-        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,-        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,-        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,-        FamilyResultSigQ, DerivStrategyQ,-        TyVarBndrUnit, TyVarBndrSpec, TyVarBndrVis,--    -- ** Constructors lifted to 'Q'-    -- *** Literals-        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,-        charL, stringL, stringPrimL, charPrimL, bytesPrimL, mkBytes,-    -- *** Patterns-        litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP,-        infixP, tildeP, bangP, asP, wildP, recP,-        listP, sigP, viewP, typeP, invisP,-        fieldPat,--    -- *** Pattern Guards-        normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,--    -- *** Expressions-        dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,-        appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,-        lamE, lam1E, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE,-        multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE,-        fieldExp, getFieldE, projectionE, typedSpliceE, typedBracketE, typeE,-    -- **** Ranges-    fromE, fromThenE, fromToE, fromThenToE,--    -- ***** Ranges with more indirection-    arithSeqE,-    fromR, fromThenR, fromToR, fromThenToR,-    -- **** Statements-    doE, mdoE, compE,-    bindS, letS, noBindS, parS, recS,--    -- *** Types-        forallT, forallVisT, varT, conT, appT, appKindT, arrowT, mulArrowT,-        infixT, uInfixT, promotedInfixT, promotedUInfixT,-        parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,-        sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,-        promotedConsT, implicitParamT,-    -- **** Type literals-    numTyLit, strTyLit, charTyLit,-    -- **** Strictness-    noSourceUnpackedness, sourceNoUnpack, sourceUnpack,-    noSourceStrictness, sourceLazy, sourceStrict,-    isStrict, notStrict, unpacked,-    bang, bangType, varBangType, strictType, varStrictType,-    -- **** Class Contexts-    cxt, classP, equalP,-    -- **** Constructors-    normalC, recC, infixC, forallC, gadtC, recGadtC,--    -- *** Kinds-    varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,--    -- *** Type variable binders-    DefaultBndrFlag(defaultBndrFlag),-    plainTV, kindedTV,-    plainInvisTV, kindedInvisTV,-    plainBndrTV, kindedBndrTV,-    specifiedSpec, inferredSpec,-    bndrReq, bndrInvis,--    -- *** Roles-    nominalR, representationalR, phantomR, inferR,--    -- *** Top Level Declarations-    -- **** Data-    valD, funD, tySynD, dataD, newtypeD, typeDataD,-    derivClause, DerivClause(..),-    stockStrategy, anyclassStrategy, newtypeStrategy,-    viaStrategy, DerivStrategy(..),-    -- **** Class-    classD, instanceD, instanceWithOverlapD, Overlap(..),-    sigD, kiSigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,--    -- **** Role annotations-    roleAnnotD,-    -- **** Type Family / Data Family-    dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,-    newtypeInstD, tySynInstD,-    tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,--    -- **** Fixity-    infixLD, infixRD, infixND,--    -- **** Default declaration-    defaultD,--    -- **** Foreign Function Interface (FFI)-    cCall, stdCall, cApi, prim, javaScript,-    unsafe, safe, interruptible, forImpD,--    -- **** Functional dependencies-    funDep,--    -- **** Pragmas-    ruleVar, typedRuleVar,-    valueAnnotation, typeAnnotation, moduleAnnotation,-    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,-    pragLineD, pragCompleteD,--    -- **** Pattern Synonyms-    patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,-    infixPatSyn, recordPatSyn,--    -- **** Implicit Parameters-    implicitParamBindD,--    -- ** Reify-    thisModule,--    -- ** Documentation-    withDecDoc, withDecsDoc, funD_doc, dataD_doc, newtypeD_doc,-    typeDataD_doc, dataInstD_doc, newtypeInstD_doc, patSynD_doc--   ) where--import Language.Haskell.TH.Lib.Internal hiding-  ( tySynD-  , dataD-  , newtypeD-  , typeDataD-  , classD-  , pragRuleD-  , dataInstD-  , newtypeInstD-  , dataFamilyD-  , openTypeFamilyD-  , closedTypeFamilyD-  , tySynEqn-  , forallC--  , forallT-  , sigT--  , plainTV-  , kindedTV-  , starK-  , constraintK--  , noSig-  , kindSig-  , tyVarSig--  , derivClause-  , standaloneDerivWithStrategyD--  , doE-  , mdoE-  , tupE-  , unboxedTupE--  , conP--  , Role-  , InjectivityAnn-  )-import qualified Language.Haskell.TH.Lib.Internal as Internal-import Language.Haskell.TH.Syntax--import Control.Applicative (Applicative(..))-import Foreign.ForeignPtr-import Data.Word-import Prelude hiding (Applicative(..))---- All definitions below represent the "old" API, since their definitions are--- different in Language.Haskell.TH.Lib.Internal. Please think carefully before--- deciding to change the APIs of the functions below, as they represent the--- public API (as opposed to the Internal module, which has no API promises.)------------------------------------------------------------------------------------ *   Dec--tySynD :: Quote m => Name -> [TyVarBndr BndrVis] -> m Type -> m Dec-tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }--dataD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con] -> [m DerivClause]-      -> m Dec-dataD ctxt tc tvs ksig cons derivs =-  do-    ctxt1 <- ctxt-    cons1 <- sequenceA cons-    derivs1 <- sequenceA derivs-    return (DataD ctxt1 tc tvs ksig cons1 derivs1)--newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Con -> [m DerivClause]-         -> m Dec-newtypeD ctxt tc tvs ksig con derivs =-  do-    ctxt1 <- ctxt-    con1 <- con-    derivs1 <- sequenceA derivs-    return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)--typeDataD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con]-      -> m Dec-typeDataD tc tvs ksig cons =-  do-    cons1 <- sequenceA cons-    return (TypeDataD tc tvs ksig cons1)--classD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [m Dec] -> m Dec-classD ctxt cls tvs fds decs =-  do-    decs1 <- sequenceA decs-    ctxt1 <- ctxt-    return $ ClassD ctxt1 cls tvs fds decs1--pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec-pragRuleD n bndrs lhs rhs phases-  = do-      bndrs1 <- sequenceA bndrs-      lhs1   <- lhs-      rhs1   <- rhs-      return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases--dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause]-          -> m Dec-dataInstD ctxt tc tys ksig cons derivs =-  do-    ctxt1 <- ctxt-    ty1 <- foldl appT (conT tc) tys-    cons1 <- sequenceA cons-    derivs1 <- sequenceA derivs-    return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)--newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause]-             -> m Dec-newtypeInstD ctxt tc tys ksig con derivs =-  do-    ctxt1 <- ctxt-    ty1 <- foldl appT (conT tc) tys-    con1  <- con-    derivs1 <- sequenceA derivs-    return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)--dataFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Dec-dataFamilyD tc tvs kind-    = pure $ DataFamilyD tc tvs kind--openTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig-                -> Maybe InjectivityAnn -> m Dec-openTypeFamilyD tc tvs res inj-    = pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)--closedTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig-                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec-closedTypeFamilyD tc tvs result injectivity eqns =-  do eqns1 <- sequenceA eqns-     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)--tySynEqn :: Quote m => (Maybe [TyVarBndr ()]) -> m Type -> m Type -> m TySynEqn-tySynEqn tvs lhs rhs =-  do-    lhs1 <- lhs-    rhs1 <- rhs-    return (TySynEqn tvs lhs1 rhs1)--forallC :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Con -> m Con-forallC ns ctxt con = liftA2 (ForallC ns) ctxt con------------------------------------------------------------------------------------ *   Type--forallT :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Type -> m Type-forallT tvars ctxt ty = do-    ctxt1 <- ctxt-    ty1   <- ty-    return $ ForallT tvars ctxt1 ty1--sigT :: Quote m => m Type -> Kind -> m Type-sigT t k-  = do-      t' <- t-      return $ SigT t' k------------------------------------------------------------------------------------ *   Type variable binders--class DefaultBndrFlag flag where-  defaultBndrFlag :: flag--instance DefaultBndrFlag () where-  defaultBndrFlag = ()--instance DefaultBndrFlag Specificity where-  defaultBndrFlag = SpecifiedSpec--instance DefaultBndrFlag BndrVis where-  defaultBndrFlag = BndrReq--plainTV :: DefaultBndrFlag flag => Name -> TyVarBndr flag-plainTV n = PlainTV n defaultBndrFlag--kindedTV :: DefaultBndrFlag flag => Name -> Kind -> TyVarBndr flag-kindedTV n k = KindedTV n defaultBndrFlag k------------------------------------------------------------------------------------ *   Kind--starK :: Kind-starK = StarT--constraintK :: Kind-constraintK = ConstraintT------------------------------------------------------------------------------------ *   Type family result--noSig :: FamilyResultSig-noSig = NoSig--kindSig :: Kind -> FamilyResultSig-kindSig = KindSig--tyVarSig :: TyVarBndr () -> FamilyResultSig-tyVarSig = TyVarSig------------------------------------------------------------------------------------ * Top Level Declarations--derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause-derivClause mds p = do-  p' <- cxt p-  return $ DerivClause mds p'--standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec-standaloneDerivWithStrategyD mds ctxt ty = do-  ctxt' <- ctxt-  ty'   <- ty-  return $ StandaloneDerivD mds ctxt' ty'------------------------------------------------------------------------------------ * Bytes literals---- | Create a Bytes datatype representing raw bytes to be embedded into the--- program/library binary.------ @since 2.16.0.0-mkBytes-   :: ForeignPtr Word8 -- ^ Pointer to the data-   -> Word             -- ^ Offset from the pointer-   -> Word             -- ^ Number of bytes-   -> Bytes-mkBytes = Bytes------------------------------------------------------------------------------------ * Tuple expressions--tupE :: Quote m => [m Exp] -> m Exp-tupE es = do { es1 <- sequenceA es; return (TupE $ map Just es1)}--unboxedTupE :: Quote m => [m Exp] -> m Exp-unboxedTupE es = do { es1 <- sequenceA es; return (UnboxedTupE $ map Just es1)}------------------------------------------------------------------------------------ * Do expressions--doE :: Quote m => [m Stmt] -> m Exp-doE = Internal.doE Nothing--mdoE :: Quote m => [m Stmt] -> m Exp-mdoE = Internal.mdoE Nothing------------------------------------------------------------------------------------ * Patterns--conP :: Quote m => Name -> [m Pat] -> m Pat-conP n xs = Internal.conP n [] xs
− libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs 
@@ -1,1236 +0,0 @@-{-# OPTIONS_HADDOCK not-home #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE StandaloneKindSignatures #-}-{-# LANGUAGE Trustworthy #-}---- |--- Language.Haskell.TH.Lib.Internal exposes some additional functionality that--- is used internally in GHC's integration with Template Haskell. This is not a--- part of the public API, and as such, there are no API guarantees for this--- module from version to version.---- Why do we have both Language.Haskell.TH.Lib.Internal and--- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the--- former (which are tailored for GHC's use) need different type signatures--- than the ones in the latter. Syncing up the Internal type signatures would--- involve a massive amount of breaking changes, so for the time being, we--- relegate as many changes as we can to just the Internal module, where it--- is safe to break things.--module Language.Haskell.TH.Lib.Internal where--import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)-import qualified Language.Haskell.TH.Syntax as TH-import Control.Applicative(liftA, Applicative(..))-import qualified Data.Kind as Kind (Type)-import Data.Word( Word8 )-import Data.List.NonEmpty ( NonEmpty(..) )-import GHC.Exts (TYPE)-import Prelude hiding (Applicative(..))--------------------------------------------------------------- * Type synonyms--------------------------------------------------------------- | Representation-polymorphic since /template-haskell-2.17.0.0/.-type TExpQ :: TYPE r -> Kind.Type-type TExpQ a = Q (TExp a)--type CodeQ :: TYPE r -> Kind.Type-type CodeQ = Code Q--type InfoQ               = Q Info-type PatQ                = Q Pat-type FieldPatQ           = Q FieldPat-type ExpQ                = Q Exp-type DecQ                = Q Dec-type DecsQ               = Q [Dec]-type Decs                = [Dec] -- Defined as it is more convenient to wire-in-type ConQ                = Q Con-type TypeQ               = Q Type-type KindQ               = Q Kind-type TyLitQ              = Q TyLit-type CxtQ                = Q Cxt-type PredQ               = Q Pred-type DerivClauseQ        = Q DerivClause-type MatchQ              = Q Match-type ClauseQ             = Q Clause-type BodyQ               = Q Body-type GuardQ              = Q Guard-type StmtQ               = Q Stmt-type RangeQ              = Q Range-type SourceStrictnessQ   = Q SourceStrictness-type SourceUnpackednessQ = Q SourceUnpackedness-type BangQ               = Q Bang-type BangTypeQ           = Q BangType-type VarBangTypeQ        = Q VarBangType-type StrictTypeQ         = Q StrictType-type VarStrictTypeQ      = Q VarStrictType-type FieldExpQ           = Q FieldExp-type RuleBndrQ           = Q RuleBndr-type TySynEqnQ           = Q TySynEqn-type PatSynDirQ          = Q PatSynDir-type PatSynArgsQ         = Q PatSynArgs-type FamilyResultSigQ    = Q FamilyResultSig-type DerivStrategyQ      = Q DerivStrategy---- must be defined here for DsMeta to find it-type Role                = TH.Role-type InjectivityAnn      = TH.InjectivityAnn--type TyVarBndrUnit       = TyVarBndr ()-type TyVarBndrSpec       = TyVarBndr Specificity-type TyVarBndrVis        = TyVarBndr BndrVis--------------------------------------------------------------- * Lowercase pattern syntax functions-------------------------------------------------------------intPrimL    :: Integer -> Lit-intPrimL    = IntPrimL-wordPrimL    :: Integer -> Lit-wordPrimL    = WordPrimL-floatPrimL  :: Rational -> Lit-floatPrimL  = FloatPrimL-doublePrimL :: Rational -> Lit-doublePrimL = DoublePrimL-integerL    :: Integer -> Lit-integerL    = IntegerL-charL       :: Char -> Lit-charL       = CharL-charPrimL   :: Char -> Lit-charPrimL   = CharPrimL-stringL     :: String -> Lit-stringL     = StringL-stringPrimL :: [Word8] -> Lit-stringPrimL = StringPrimL-bytesPrimL :: Bytes -> Lit-bytesPrimL = BytesPrimL-rationalL   :: Rational -> Lit-rationalL   = RationalL--litP :: Quote m => Lit -> m Pat-litP l = pure (LitP l)--varP :: Quote m => Name -> m Pat-varP v = pure (VarP v)--tupP :: Quote m => [m Pat] -> m Pat-tupP ps = do { ps1 <- sequenceA ps; pure (TupP ps1)}--unboxedTupP :: Quote m => [m Pat] -> m Pat-unboxedTupP ps = do { ps1 <- sequenceA ps; pure (UnboxedTupP ps1)}--unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat-unboxedSumP p alt arity = do { p1 <- p; pure (UnboxedSumP p1 alt arity) }--conP :: Quote m => Name -> [m Type] -> [m Pat] -> m Pat-conP n ts ps = do ps' <- sequenceA ps-                  ts' <- sequenceA ts-                  pure (ConP n ts' ps')-infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat-infixP p1 n p2 = do p1' <- p1-                    p2' <- p2-                    pure (InfixP p1' n p2')-uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat-uInfixP p1 n p2 = do p1' <- p1-                     p2' <- p2-                     pure (UInfixP p1' n p2')-parensP :: Quote m => m Pat -> m Pat-parensP p = do p' <- p-               pure (ParensP p')--tildeP :: Quote m => m Pat -> m Pat-tildeP p = do p' <- p-              pure (TildeP p')-bangP :: Quote m => m Pat -> m Pat-bangP p = do p' <- p-             pure (BangP p')-asP :: Quote m => Name -> m Pat -> m Pat-asP n p = do p' <- p-             pure (AsP n p')-wildP :: Quote m => m Pat-wildP = pure WildP-recP :: Quote m => Name -> [m FieldPat] -> m Pat-recP n fps = do fps' <- sequenceA fps-                pure (RecP n fps')-listP :: Quote m => [m Pat] -> m Pat-listP ps = do ps' <- sequenceA ps-              pure (ListP ps')-sigP :: Quote m => m Pat -> m Type -> m Pat-sigP p t = do p' <- p-              t' <- t-              pure (SigP p' t')-typeP :: Quote m => m Type -> m Pat-typeP t = do t' <- t-             pure (TypeP t')-invisP :: Quote m => m Type -> m Pat-invisP t = do t' <- t-              pure (InvisP t')-viewP :: Quote m => m Exp -> m Pat -> m Pat-viewP e p = do e' <- e-               p' <- p-               pure (ViewP e' p')---fieldPat :: Quote m => Name -> m Pat -> m FieldPat-fieldPat n p = do p' <- p-                  pure (n, p')------------------------------------------------------------------------------------- *   Stmt--bindS :: Quote m => m Pat -> m Exp -> m Stmt-bindS p e = liftA2 BindS p e--letS :: Quote m => [m Dec] -> m Stmt-letS ds = do { ds1 <- sequenceA ds; pure (LetS ds1) }--noBindS :: Quote m => m Exp -> m Stmt-noBindS e = do { e1 <- e; pure (NoBindS e1) }--parS :: Quote m => [[m Stmt]] -> m Stmt-parS sss = do { sss1 <- traverse sequenceA sss; pure (ParS sss1) }--recS :: Quote m => [m Stmt] -> m Stmt-recS ss = do { ss1 <- sequenceA ss; pure (RecS ss1) }------------------------------------------------------------------------------------ *   Range--fromR :: Quote m => m Exp -> m Range-fromR x = do { a <- x; pure (FromR a) }--fromThenR :: Quote m => m Exp -> m Exp -> m Range-fromThenR x y = do { a <- x; b <- y; pure (FromThenR a b) }--fromToR :: Quote m => m Exp -> m Exp -> m Range-fromToR x y = do { a <- x; b <- y; pure (FromToR a b) }--fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range-fromThenToR x y z = do { a <- x; b <- y; c <- z;-                         pure (FromThenToR a b c) }----------------------------------------------------------------------------------- *   Body--normalB :: Quote m => m Exp -> m Body-normalB e = do { e1 <- e; pure (NormalB e1) }--guardedB :: Quote m => [m (Guard,Exp)] -> m Body-guardedB ges = do { ges' <- sequenceA ges; pure (GuardedB ges') }------------------------------------------------------------------------------------ *   Guard--normalG :: Quote m => m Exp -> m Guard-normalG e = do { e1 <- e; pure (NormalG e1) }--normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)-normalGE g e = do { g1 <- g; e1 <- e; pure (NormalG g1, e1) }--patG :: Quote m => [m Stmt] -> m Guard-patG ss = do { ss' <- sequenceA ss; pure (PatG ss') }--patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)-patGE ss e = do { ss' <- sequenceA ss;-                  e'  <- e;-                  pure (PatG ss', e') }------------------------------------------------------------------------------------ *   Match and Clause---- | Use with 'caseE'-match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match-match p rhs ds = do { p' <- p;-                      r' <- rhs;-                      ds' <- sequenceA ds;-                      pure (Match p' r' ds') }---- | Use with 'funD'-clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause-clause ps r ds = do { ps' <- sequenceA ps;-                      r' <- r;-                      ds' <- sequenceA ds;-                      pure (Clause ps' r' ds') }-------------------------------------------------------------------------------- *   Exp---- | Dynamically binding a variable (unhygienic)-dyn :: Quote m => String -> m Exp-dyn s = pure (VarE (mkName s))--varE :: Quote m => Name -> m Exp-varE s = pure (VarE s)--conE :: Quote m => Name -> m Exp-conE s =  pure (ConE s)--litE :: Quote m => Lit -> m Exp-litE c = pure (LitE c)--appE :: Quote m => m Exp -> m Exp -> m Exp-appE x y = do { a <- x; b <- y; pure (AppE a b)}--appTypeE :: Quote m => m Exp -> m Type -> m Exp-appTypeE x t = do { a <- x; s <- t; pure (AppTypeE a s) }--parensE :: Quote m => m Exp -> m Exp-parensE x = do { x' <- x; pure (ParensE x') }--uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp-uInfixE x s y = do { x' <- x; s' <- s; y' <- y;-                     pure (UInfixE x' s' y') }--infixE :: Quote m => Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp-infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;-                                  pure (InfixE (Just a) s' (Just b))}-infixE Nothing  s (Just y) = do { s' <- s; b <- y;-                                  pure (InfixE Nothing s' (Just b))}-infixE (Just x) s Nothing  = do { a <- x; s' <- s;-                                  pure (InfixE (Just a) s' Nothing)}-infixE Nothing  s Nothing  = do { s' <- s; pure (InfixE Nothing s' Nothing) }--infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp-infixApp x y z = infixE (Just x) y (Just z)-sectionL :: Quote m => m Exp -> m Exp -> m Exp-sectionL x y = infixE (Just x) y Nothing-sectionR :: Quote m => m Exp -> m Exp -> m Exp-sectionR x y = infixE Nothing x (Just y)--lamE :: Quote m => [m Pat] -> m Exp -> m Exp-lamE ps e = do ps' <- sequenceA ps-               e' <- e-               pure (LamE ps' e')---- | Single-arg lambda-lam1E :: Quote m => m Pat -> m Exp -> m Exp-lam1E p e = lamE [p] e---- | Lambda-case (@\case@)-lamCaseE :: Quote m => [m Match] -> m Exp-lamCaseE ms = LamCaseE <$> sequenceA ms---- | Lambda-cases (@\cases@)-lamCasesE :: Quote m => [m Clause] -> m Exp-lamCasesE ms = LamCasesE <$> sequenceA ms--tupE :: Quote m => [Maybe (m Exp)] -> m Exp-tupE es = do { es1 <- traverse sequenceA es; pure (TupE es1)}--unboxedTupE :: Quote m => [Maybe (m Exp)] -> m Exp-unboxedTupE es = do { es1 <- traverse sequenceA es; pure (UnboxedTupE es1)}--unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp-unboxedSumE e alt arity = do { e1 <- e; pure (UnboxedSumE e1 alt arity) }--condE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp-condE x y z =  do { a <- x; b <- y; c <- z; pure (CondE a b c)}--multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp-multiIfE alts = MultiIfE <$> sequenceA alts--letE :: Quote m => [m Dec] -> m Exp -> m Exp-letE ds e = do { ds2 <- sequenceA ds; e2 <- e; pure (LetE ds2 e2) }--caseE :: Quote m => m Exp -> [m Match] -> m Exp-caseE e ms = do { e1 <- e; ms1 <- sequenceA ms; pure (CaseE e1 ms1) }--doE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp-doE m ss = do { ss1 <- sequenceA ss; pure (DoE m ss1) }--mdoE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp-mdoE m ss = do { ss1 <- sequenceA ss; pure (MDoE m ss1) }--compE :: Quote m => [m Stmt] -> m Exp-compE ss = do { ss1 <- sequenceA ss; pure (CompE ss1) }--arithSeqE :: Quote m => m Range -> m Exp-arithSeqE r = do { r' <- r; pure (ArithSeqE r') }--listE :: Quote m => [m Exp] -> m Exp-listE es = do { es1 <- sequenceA es; pure (ListE es1) }--sigE :: Quote m => m Exp -> m Type -> m Exp-sigE e t = do { e1 <- e; t1 <- t; pure (SigE e1 t1) }--recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp-recConE c fs = do { flds <- sequenceA fs; pure (RecConE c flds) }--recUpdE :: Quote m => m Exp -> [m (Name,Exp)] -> m Exp-recUpdE e fs = do { e1 <- e; flds <- sequenceA fs; pure (RecUpdE e1 flds) }--stringE :: Quote m => String -> m Exp-stringE = litE . stringL--fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)-fieldExp s e = do { e' <- e; pure (s,e') }---- | @staticE x = [| static x |]@-staticE :: Quote m => m Exp -> m Exp-staticE = fmap StaticE--unboundVarE :: Quote m => Name -> m Exp-unboundVarE s = pure (UnboundVarE s)--labelE :: Quote m => String -> m Exp-labelE s = pure (LabelE s)--implicitParamVarE :: Quote m => String -> m Exp-implicitParamVarE n = pure (ImplicitParamVarE n)--getFieldE :: Quote m => m Exp -> String -> m Exp-getFieldE e f = do-  e' <- e-  pure (GetFieldE e' f)--projectionE :: Quote m => NonEmpty String -> m Exp-projectionE xs = pure (ProjectionE xs)--typedSpliceE :: Quote m => m Exp -> m Exp-typedSpliceE = fmap TypedSpliceE--typedBracketE :: Quote m => m Exp -> m Exp-typedBracketE = fmap TypedBracketE---- ** 'arithSeqE' Shortcuts-fromE :: Quote m => m Exp -> m Exp-fromE x = do { a <- x; pure (ArithSeqE (FromR a)) }--fromThenE :: Quote m => m Exp -> m Exp -> m Exp-fromThenE x y = do { a <- x; b <- y; pure (ArithSeqE (FromThenR a b)) }--fromToE :: Quote m => m Exp -> m Exp -> m Exp-fromToE x y = do { a <- x; b <- y; pure (ArithSeqE (FromToR a b)) }--fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp-fromThenToE x y z = do { a <- x; b <- y; c <- z;-                         pure (ArithSeqE (FromThenToR a b c)) }--typeE :: Quote m => m Type -> m Exp-typeE = fmap TypeE------------------------------------------------------------------------------------ *   Dec--valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec-valD p b ds =-  do { p' <- p-     ; ds' <- sequenceA ds-     ; b' <- b-     ; pure (ValD p' b' ds')-     }--funD :: Quote m => Name -> [m Clause] -> m Dec-funD nm cs =- do { cs1 <- sequenceA cs-    ; pure (FunD nm cs1)-    }--tySynD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m Type -> m Dec-tySynD tc tvs rhs =-  do { tvs1 <- sequenceA tvs-     ; rhs1 <- rhs-     ; pure (TySynD tc tvs1 rhs1)-     }--dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con]-      -> [m DerivClause] -> m Dec-dataD ctxt tc tvs ksig cons derivs =-  do-    ctxt1   <- ctxt-    tvs1    <- sequenceA tvs-    ksig1   <- sequenceA ksig-    cons1   <- sequenceA cons-    derivs1 <- sequenceA derivs-    pure (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)--newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Con-         -> [m DerivClause] -> m Dec-newtypeD ctxt tc tvs ksig con derivs =-  do-    ctxt1   <- ctxt-    tvs1    <- sequenceA tvs-    ksig1   <- sequenceA ksig-    con1    <- con-    derivs1 <- sequenceA derivs-    pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)--typeDataD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con]-      -> m Dec-typeDataD tc tvs ksig cons =-  do-    tvs1    <- sequenceA tvs-    ksig1   <- sequenceA ksig-    cons1   <- sequenceA cons-    pure (TypeDataD tc tvs1 ksig1 cons1)--classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> [FunDep] -> [m Dec] -> m Dec-classD ctxt cls tvs fds decs =-  do-    tvs1  <- sequenceA tvs-    decs1 <- sequenceA decs-    ctxt1 <- ctxt-    pure $ ClassD ctxt1 cls tvs1 fds decs1--instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec-instanceD = instanceWithOverlapD Nothing--instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec-instanceWithOverlapD o ctxt ty decs =-  do-    ctxt1 <- ctxt-    decs1 <- sequenceA decs-    ty1   <- ty-    pure $ InstanceD o ctxt1 ty1 decs1----sigD :: Quote m => Name -> m Type -> m Dec-sigD fun ty = liftA (SigD fun) $ ty--kiSigD :: Quote m => Name -> m Kind -> m Dec-kiSigD fun ki = liftA (KiSigD fun) $ ki--forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec-forImpD cc s str n ty- = do ty' <- ty-      pure $ ForeignD (ImportF cc s str n ty')--infixLD :: Quote m => Int -> Name -> m Dec-infixLD prec = infixLWithSpecD prec NoNamespaceSpecifier--infixRD :: Quote m => Int -> Name -> m Dec-infixRD prec = infixRWithSpecD prec NoNamespaceSpecifier--infixND :: Quote m => Int -> Name -> m Dec-infixND prec = infixNWithSpecD prec NoNamespaceSpecifier--infixLWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec-infixLWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixL) ns_spec nm)--infixRWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec-infixRWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixR) ns_spec nm)--infixNWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec-infixNWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixN) ns_spec nm)--defaultD :: Quote m => [m Type] -> m Dec-defaultD tys = DefaultD <$> sequenceA tys--pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec-pragInlD name inline rm phases-  = pure $ PragmaD $ InlineP name inline rm phases--pragOpaqueD :: Quote m => Name -> m Dec-pragOpaqueD name = pure $ PragmaD $ OpaqueP name--pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec-pragSpecD n ty phases-  = do-      ty1    <- ty-      pure $ PragmaD $ SpecialiseP n ty1 Nothing phases--pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec-pragSpecInlD n ty inline phases-  = do-      ty1    <- ty-      pure $ PragmaD $ SpecialiseP n ty1 (Just inline) phases--pragSpecInstD :: Quote m => m Type -> m Dec-pragSpecInstD ty-  = do-      ty1    <- ty-      pure $ PragmaD $ SpecialiseInstP ty1--pragRuleD :: Quote m => String -> Maybe [m (TyVarBndr ())] -> [m RuleBndr] -> m Exp -> m Exp-          -> Phases -> m Dec-pragRuleD n ty_bndrs tm_bndrs lhs rhs phases-  = do-      ty_bndrs1 <- traverse sequenceA ty_bndrs-      tm_bndrs1 <- sequenceA tm_bndrs-      lhs1   <- lhs-      rhs1   <- rhs-      pure $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases--pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec-pragAnnD target expr-  = do-      exp1 <- expr-      pure $ PragmaD $ AnnP target exp1--pragLineD :: Quote m => Int -> String -> m Dec-pragLineD line file = pure $ PragmaD $ LineP line file--pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec-pragCompleteD cls mty = pure $ PragmaD $ CompleteP cls mty--pragSCCFunD :: Quote m => Name -> m Dec-pragSCCFunD nm = pure $ PragmaD $ SCCP nm Nothing--pragSCCFunNamedD :: Quote m => Name -> String -> m Dec-pragSCCFunNamedD nm str = pure $ PragmaD $ SCCP nm (Just str)--dataInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> [m Con]-          -> [m DerivClause] -> m Dec-dataInstD ctxt mb_bndrs ty ksig cons derivs =-  do-    ctxt1   <- ctxt-    mb_bndrs1 <- traverse sequenceA mb_bndrs-    ty1    <- ty-    ksig1   <- sequenceA ksig-    cons1   <- sequenceA cons-    derivs1 <- sequenceA derivs-    pure (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)--newtypeInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> m Con-             -> [m DerivClause] -> m Dec-newtypeInstD ctxt mb_bndrs ty ksig con derivs =-  do-    ctxt1   <- ctxt-    mb_bndrs1 <- traverse sequenceA mb_bndrs-    ty1    <- ty-    ksig1   <- sequenceA ksig-    con1    <- con-    derivs1 <- sequenceA derivs-    pure (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)--tySynInstD :: Quote m => m TySynEqn -> m Dec-tySynInstD eqn =-  do-    eqn1 <- eqn-    pure (TySynInstD eqn1)--dataFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Dec-dataFamilyD tc tvs kind =-  do tvs'  <- sequenceA tvs-     kind' <- sequenceA kind-     pure $ DataFamilyD tc tvs' kind'--openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig-                -> Maybe InjectivityAnn -> m Dec-openTypeFamilyD tc tvs res inj =-  do tvs' <- sequenceA tvs-     res' <- res-     pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)--closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig-                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec-closedTypeFamilyD tc tvs result injectivity eqns =-  do tvs1    <- sequenceA tvs-     result1 <- result-     eqns1   <- sequenceA eqns-     pure (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)--roleAnnotD :: Quote m => Name -> [Role] -> m Dec-roleAnnotD name roles = pure $ RoleAnnotD name roles--standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec-standaloneDerivD = standaloneDerivWithStrategyD Nothing--standaloneDerivWithStrategyD :: Quote m => Maybe (m DerivStrategy) -> m Cxt -> m Type -> m Dec-standaloneDerivWithStrategyD mdsq ctxtq tyq =-  do-    mds  <- sequenceA mdsq-    ctxt <- ctxtq-    ty   <- tyq-    pure $ StandaloneDerivD mds ctxt ty--defaultSigD :: Quote m => Name -> m Type -> m Dec-defaultSigD n tyq =-  do-    ty <- tyq-    pure $ DefaultSigD n ty---- | Pattern synonym declaration-patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec-patSynD name args dir pat = do-  args'    <- args-  dir'     <- dir-  pat'     <- pat-  pure (PatSynD name args' dir' pat')---- | Pattern synonym type signature-patSynSigD :: Quote m => Name -> m Type -> m Dec-patSynSigD nm ty =-  do ty' <- ty-     pure $ PatSynSigD nm ty'---- | Implicit parameter binding declaration. Can only be used in let--- and where clauses which consist entirely of implicit bindings.-implicitParamBindD :: Quote m => String -> m Exp -> m Dec-implicitParamBindD n e =-  do-    e' <- e-    pure $ ImplicitParamBindD n e'--tySynEqn :: Quote m => (Maybe [m (TyVarBndr ())]) -> m Type -> m Type -> m TySynEqn-tySynEqn mb_bndrs lhs rhs =-  do-    mb_bndrs1 <- traverse sequenceA mb_bndrs-    lhs1 <- lhs-    rhs1 <- rhs-    pure (TySynEqn mb_bndrs1 lhs1 rhs1)--cxt :: Quote m => [m Pred] -> m Cxt-cxt = sequenceA--derivClause :: Quote m => Maybe (m DerivStrategy) -> [m Pred] -> m DerivClause-derivClause mds p = do mds' <- sequenceA mds-                       p'   <- cxt p-                       pure $ DerivClause mds' p'--stockStrategy :: Quote m => m DerivStrategy-stockStrategy = pure StockStrategy--anyclassStrategy :: Quote m => m DerivStrategy-anyclassStrategy = pure AnyclassStrategy--newtypeStrategy :: Quote m => m DerivStrategy-newtypeStrategy = pure NewtypeStrategy--viaStrategy :: Quote m => m Type -> m DerivStrategy-viaStrategy = fmap ViaStrategy--normalC :: Quote m => Name -> [m BangType] -> m Con-normalC con strtys = liftA (NormalC con) $ sequenceA strtys--recC :: Quote m => Name -> [m VarBangType] -> m Con-recC con varstrtys = liftA (RecC con) $ sequenceA varstrtys--infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con-infixC st1 con st2 = do st1' <- st1-                        st2' <- st2-                        pure $ InfixC st1' con st2'--forallC :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Con -> m Con-forallC ns ctxt con = do-  ns'   <- sequenceA ns-  ctxt' <- ctxt-  con'  <- con-  pure $ ForallC ns' ctxt' con'--gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con-gadtC cons strtys ty = liftA2 (GadtC cons) (sequenceA strtys) ty--recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con-recGadtC cons varstrtys ty = liftA2 (RecGadtC cons) (sequenceA varstrtys) ty------------------------------------------------------------------------------------ *   Type--forallT :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Type -> m Type-forallT tvars ctxt ty = do-    tvars1 <- sequenceA tvars-    ctxt1  <- ctxt-    ty1    <- ty-    pure $ ForallT tvars1 ctxt1 ty1--forallVisT :: Quote m => [m (TyVarBndr ())] -> m Type -> m Type-forallVisT tvars ty = ForallVisT <$> sequenceA tvars <*> ty--varT :: Quote m => Name -> m Type-varT = pure . VarT--conT :: Quote m => Name -> m Type-conT = pure . ConT--infixT :: Quote m => m Type -> Name -> m Type -> m Type-infixT t1 n t2 = do t1' <- t1-                    t2' <- t2-                    pure (InfixT t1' n t2')--uInfixT :: Quote m => m Type -> Name -> m Type -> m Type-uInfixT t1 n t2 = do t1' <- t1-                     t2' <- t2-                     pure (UInfixT t1' n t2')--promotedInfixT :: Quote m => m Type -> Name -> m Type -> m Type-promotedInfixT t1 n t2 = do t1' <- t1-                            t2' <- t2-                            pure (PromotedInfixT t1' n t2')--promotedUInfixT :: Quote m => m Type -> Name -> m Type -> m Type-promotedUInfixT t1 n t2 = do t1' <- t1-                             t2' <- t2-                             pure (PromotedUInfixT t1' n t2')--parensT :: Quote m => m Type -> m Type-parensT t = do t' <- t-               pure (ParensT t')--appT :: Quote m => m Type -> m Type -> m Type-appT t1 t2 = do-           t1' <- t1-           t2' <- t2-           pure $ AppT t1' t2'--appKindT :: Quote m => m Type -> m Kind -> m Type-appKindT ty ki = do-               ty' <- ty-               ki' <- ki-               pure $ AppKindT ty' ki'--arrowT :: Quote m => m Type-arrowT = pure ArrowT--mulArrowT :: Quote m => m Type-mulArrowT = pure MulArrowT--listT :: Quote m => m Type-listT = pure ListT--litT :: Quote m => m TyLit -> m Type-litT l = fmap LitT l--tupleT :: Quote m => Int -> m Type-tupleT i = pure (TupleT i)--unboxedTupleT :: Quote m => Int -> m Type-unboxedTupleT i = pure (UnboxedTupleT i)--unboxedSumT :: Quote m => SumArity -> m Type-unboxedSumT arity = pure (UnboxedSumT arity)--sigT :: Quote m => m Type -> m Kind -> m Type-sigT t k-  = do-      t' <- t-      k' <- k-      pure $ SigT t' k'--equalityT :: Quote m => m Type-equalityT = pure EqualityT--wildCardT :: Quote m => m Type-wildCardT = pure WildCardT--implicitParamT :: Quote m => String -> m Type -> m Type-implicitParamT n t-  = do-      t' <- t-      pure $ ImplicitParamT n t'--{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}-classP :: Quote m => Name -> [m Type] -> m Pred-classP cla tys-  = do-      tysl <- sequenceA tys-      pure (foldl AppT (ConT cla) tysl)--{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}-equalP :: Quote m => m Type -> m Type -> m Pred-equalP tleft tright-  = do-      tleft1  <- tleft-      tright1 <- tright-      eqT <- equalityT-      pure (foldl AppT eqT [tleft1, tright1])--promotedT :: Quote m => Name -> m Type-promotedT = pure . PromotedT--promotedTupleT :: Quote m => Int -> m Type-promotedTupleT i = pure (PromotedTupleT i)--promotedNilT :: Quote m => m Type-promotedNilT = pure PromotedNilT--promotedConsT :: Quote m => m Type-promotedConsT = pure PromotedConsT--noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: Quote m => m SourceUnpackedness-noSourceUnpackedness = pure NoSourceUnpackedness-sourceNoUnpack       = pure SourceNoUnpack-sourceUnpack         = pure SourceUnpack--noSourceStrictness, sourceLazy, sourceStrict :: Quote m => m SourceStrictness-noSourceStrictness = pure NoSourceStrictness-sourceLazy         = pure SourceLazy-sourceStrict       = pure SourceStrict--{-# DEPRECATED isStrict-    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",-     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}-{-# DEPRECATED notStrict-    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",-     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}-{-# DEPRECATED unpacked-    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",-     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}-isStrict, notStrict, unpacked :: Quote m => m Strict-isStrict = bang noSourceUnpackedness sourceStrict-notStrict = bang noSourceUnpackedness noSourceStrictness-unpacked = bang sourceUnpack sourceStrict--bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang-bang u s = do u' <- u-              s' <- s-              pure (Bang u' s')--bangType :: Quote m => m Bang -> m Type -> m BangType-bangType = liftA2 (,)--varBangType :: Quote m => Name -> m BangType -> m VarBangType-varBangType v bt = (\(b, t) -> (v, b, t)) <$> bt--{-# DEPRECATED strictType-               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}-strictType :: Quote m => m Strict -> m Type -> m StrictType-strictType = bangType--{-# DEPRECATED varStrictType-               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}-varStrictType :: Quote m => Name -> m StrictType -> m VarStrictType-varStrictType = varBangType---- * Type Literals---- MonadFail here complicates things (a lot) because it would mean we would--- have to emit a MonadFail constraint during typechecking if there was any--- chance the desugaring would use numTyLit, which in general is hard to--- predict.-numTyLit :: Quote m => Integer -> m TyLit-numTyLit n = if n >= 0 then pure (NumTyLit n)-                       else error ("Negative type-level number: " ++ show n)--strTyLit :: Quote m => String -> m TyLit-strTyLit s = pure (StrTyLit s)--charTyLit :: Quote m => Char -> m TyLit-charTyLit c = pure (CharTyLit c)------------------------------------------------------------------------------------ *   Kind--plainTV :: Quote m => Name -> m (TyVarBndr ())-plainTV n = pure $ PlainTV n ()--plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity)-plainInvisTV n s = pure $ PlainTV n s--plainBndrTV :: Quote m => Name -> BndrVis -> m (TyVarBndr BndrVis)-plainBndrTV n v = pure $ PlainTV n v--kindedTV :: Quote m => Name -> m Kind -> m (TyVarBndr ())-kindedTV n = fmap (KindedTV n ())--kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity)-kindedInvisTV n s = fmap (KindedTV n s)--kindedBndrTV :: Quote m => Name -> BndrVis -> m Kind -> m (TyVarBndr BndrVis)-kindedBndrTV n v = fmap (KindedTV n v)--specifiedSpec :: Specificity-specifiedSpec = SpecifiedSpec--inferredSpec :: Specificity-inferredSpec = InferredSpec--bndrReq :: BndrVis-bndrReq = BndrReq--bndrInvis :: BndrVis-bndrInvis = BndrInvis--varK :: Name -> Kind-varK = VarT--conK :: Name -> Kind-conK = ConT--tupleK :: Int -> Kind-tupleK = TupleT--arrowK ::  Kind-arrowK = ArrowT--listK ::  Kind-listK = ListT--appK :: Kind -> Kind -> Kind-appK = AppT--starK :: Quote m => m Kind-starK = pure StarT--constraintK :: Quote m => m Kind-constraintK = pure ConstraintT------------------------------------------------------------------------------------ *   Type family result--noSig :: Quote m => m FamilyResultSig-noSig = pure NoSig--kindSig :: Quote m => m Kind -> m FamilyResultSig-kindSig = fmap KindSig--tyVarSig :: Quote m => m (TyVarBndr ()) -> m FamilyResultSig-tyVarSig = fmap TyVarSig------------------------------------------------------------------------------------ *   Injectivity annotation--injectivityAnn :: Name -> [Name] -> InjectivityAnn-injectivityAnn = TH.InjectivityAnn------------------------------------------------------------------------------------ *   Role--nominalR, representationalR, phantomR, inferR :: Role-nominalR          = NominalR-representationalR = RepresentationalR-phantomR          = PhantomR-inferR            = InferR------------------------------------------------------------------------------------ *   Callconv--cCall, stdCall, cApi, prim, javaScript :: Callconv-cCall      = CCall-stdCall    = StdCall-cApi       = CApi-prim       = Prim-javaScript = JavaScript------------------------------------------------------------------------------------ *   Safety--unsafe, safe, interruptible :: Safety-unsafe = Unsafe-safe = Safe-interruptible = Interruptible------------------------------------------------------------------------------------ *   FunDep--funDep ::  [Name] -> [Name] -> FunDep-funDep = FunDep------------------------------------------------------------------------------------ *   RuleBndr-ruleVar :: Quote m => Name -> m RuleBndr-ruleVar = pure . RuleVar--typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr-typedRuleVar n ty = TypedRuleVar n <$> ty------------------------------------------------------------------------------------ *   AnnTarget-valueAnnotation ::  Name -> AnnTarget-valueAnnotation = ValueAnnotation--typeAnnotation ::  Name -> AnnTarget-typeAnnotation = TypeAnnotation--moduleAnnotation :: AnnTarget-moduleAnnotation = ModuleAnnotation------------------------------------------------------------------------------------ * Pattern Synonyms (sub constructs)--unidir, implBidir :: Quote m => m PatSynDir-unidir    = pure Unidir-implBidir = pure ImplBidir--explBidir :: Quote m => [m Clause] -> m PatSynDir-explBidir cls = do-  cls' <- sequenceA cls-  pure (ExplBidir cls')--prefixPatSyn :: Quote m => [Name] -> m PatSynArgs-prefixPatSyn args = pure $ PrefixPatSyn args--recordPatSyn :: Quote m => [Name] -> m PatSynArgs-recordPatSyn sels = pure $ RecordPatSyn sels--infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs-infixPatSyn arg1 arg2 = pure $ InfixPatSyn arg1 arg2------------------------------------------------------------------- * Useful helper function--appsE :: Quote m => [m Exp] -> m Exp-appsE [] = error "appsE []"-appsE [x] = x-appsE (x:y:zs) = appsE ( (appE x y) : zs )---- | pure the Module at the place of splicing.  Can be used as an--- input for 'reifyModule'.-thisModule :: Q Module-thisModule = do-  loc <- location-  pure $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)------------------------------------------------------------------- * Documentation combinators---- | Attaches Haddock documentation to the declaration provided. Unlike--- 'putDoc', the names do not need to be in scope when calling this function so--- it can be used for quoted declarations and anything else currently being--- spliced.--- Not all declarations can have documentation attached to them. For those that--- can't, 'withDecDoc' will return it unchanged without any side effects.-withDecDoc :: String -> Q Dec -> Q Dec-withDecDoc doc dec = do-  dec' <- dec-  case doc_loc dec' of-    Just loc -> qAddModFinalizer $ qPutDoc loc doc-    Nothing  -> pure ()-  pure dec'-  where-    doc_loc (FunD n _)                                     = Just $ DeclDoc n-    doc_loc (ValD (VarP n) _ _)                            = Just $ DeclDoc n-    doc_loc (DataD _ n _ _ _ _)                            = Just $ DeclDoc n-    doc_loc (NewtypeD _ n _ _ _ _)                         = Just $ DeclDoc n-    doc_loc (TypeDataD n _ _ _)                            = Just $ DeclDoc n-    doc_loc (TySynD n _ _)                                 = Just $ DeclDoc n-    doc_loc (ClassD _ n _ _ _)                             = Just $ DeclDoc n-    doc_loc (SigD n _)                                     = Just $ DeclDoc n-    doc_loc (ForeignD (ImportF _ _ _ n _))                 = Just $ DeclDoc n-    doc_loc (ForeignD (ExportF _ _ n _))                   = Just $ DeclDoc n-    doc_loc (InfixD _ _ n)                                 = Just $ DeclDoc n-    doc_loc (DataFamilyD n _ _)                            = Just $ DeclDoc n-    doc_loc (OpenTypeFamilyD (TypeFamilyHead n _ _ _))     = Just $ DeclDoc n-    doc_loc (ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _) = Just $ DeclDoc n-    doc_loc (PatSynD n _ _ _)                              = Just $ DeclDoc n-    doc_loc (PatSynSigD n _)                               = Just $ DeclDoc n--    -- For instances we just pass along the full type-    doc_loc (InstanceD _ _ t _)           = Just $ InstDoc t-    doc_loc (DataInstD _ _ t _ _ _)       = Just $ InstDoc t-    doc_loc (NewtypeInstD _ _ t _ _ _)    = Just $ InstDoc t-    doc_loc (TySynInstD (TySynEqn _ t _)) = Just $ InstDoc t--    -- Declarations that can't have documentation attached to-    -- ValDs that aren't a simple variable pattern-    doc_loc (ValD _ _ _)             = Nothing-    doc_loc (KiSigD _ _)             = Nothing-    doc_loc (PragmaD _)              = Nothing-    doc_loc (RoleAnnotD _ _)         = Nothing-    doc_loc (StandaloneDerivD _ _ _) = Nothing-    doc_loc (DefaultSigD _ _)        = Nothing-    doc_loc (ImplicitParamBindD _ _) = Nothing-    doc_loc (DefaultD _)             = Nothing---- | Variant of 'withDecDoc' that applies the same documentation to--- multiple declarations. Useful for documenting quoted declarations.-withDecsDoc :: String -> Q [Dec] -> Q [Dec]-withDecsDoc doc decs = decs >>= mapM (withDecDoc doc . pure)---- | Variant of 'funD' that attaches Haddock documentation.-funD_doc :: Name -> [Q Clause]-         -> Maybe String -- ^ Documentation to attach to function-         -> [Maybe String] -- ^ Documentation to attach to arguments-         -> Q Dec-funD_doc nm cs mfun_doc arg_docs = do-  qAddModFinalizer $ sequence_-    [putDoc (ArgDoc nm i) s | (i, Just s) <- zip [0..] arg_docs]-  let dec = funD nm cs-  case mfun_doc of-    Just fun_doc -> withDecDoc fun_doc dec-    Nothing -> funD nm cs---- | Variant of 'dataD' that attaches Haddock documentation.-dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)-          -> [(Q Con, Maybe String, [Maybe String])]-          -- ^ List of constructors, documentation for the constructor, and-          -- documentation for the arguments-          -> [Q DerivClause]-          -> Maybe String-          -- ^ Documentation to attach to the data declaration-          -> Q Dec-dataD_doc ctxt tc tvs ksig cons_with_docs derivs mdoc = do-  qAddModFinalizer $ mapM_ docCons cons_with_docs-  let dec = dataD ctxt tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs) derivs-  maybe dec (flip withDecDoc dec) mdoc---- | Variant of 'newtypeD' that attaches Haddock documentation.-newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)-             -> (Q Con, Maybe String, [Maybe String])-             -- ^ The constructor, documentation for the constructor, and-             -- documentation for the arguments-             -> [Q DerivClause]-             -> Maybe String-             -- ^ Documentation to attach to the newtype declaration-             -> Q Dec-newtypeD_doc ctxt tc tvs ksig con_with_docs@(con, _, _) derivs mdoc = do-  qAddModFinalizer $ docCons con_with_docs-  let dec = newtypeD ctxt tc tvs ksig con derivs-  maybe dec (flip withDecDoc dec) mdoc---- | Variant of 'typeDataD' that attaches Haddock documentation.-typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)-          -> [(Q Con, Maybe String, [Maybe String])]-          -- ^ List of constructors, documentation for the constructor, and-          -- documentation for the arguments-          -> Maybe String-          -- ^ Documentation to attach to the data declaration-          -> Q Dec-typeDataD_doc tc tvs ksig cons_with_docs mdoc = do-  qAddModFinalizer $ mapM_ docCons cons_with_docs-  let dec = typeDataD tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs)-  maybe dec (flip withDecDoc dec) mdoc---- | Variant of 'dataInstD' that attaches Haddock documentation.-dataInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type -> Maybe (Q Kind)-              -> [(Q Con, Maybe String, [Maybe String])]-              -- ^ List of constructors, documentation for the constructor, and-              -- documentation for the arguments-              -> [Q DerivClause]-              -> Maybe String-              -- ^ Documentation to attach to the instance declaration-              -> Q Dec-dataInstD_doc ctxt mb_bndrs ty ksig cons_with_docs derivs mdoc = do-  qAddModFinalizer $ mapM_ docCons cons_with_docs-  let dec = dataInstD ctxt mb_bndrs ty ksig (map (\(con, _, _) -> con) cons_with_docs)-              derivs-  maybe dec (flip withDecDoc dec) mdoc---- | Variant of 'newtypeInstD' that attaches Haddock documentation.-newtypeInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type-                 -> Maybe (Q Kind)-                 -> (Q Con, Maybe String, [Maybe String])-                 -- ^ The constructor, documentation for the constructor, and-                 -- documentation for the arguments-                 -> [Q DerivClause]-                 -> Maybe String-                 -- ^ Documentation to attach to the instance declaration-                 -> Q Dec-newtypeInstD_doc ctxt mb_bndrs ty ksig con_with_docs@(con, _, _) derivs mdoc = do-  qAddModFinalizer $ docCons con_with_docs-  let dec = newtypeInstD ctxt mb_bndrs ty ksig con derivs-  maybe dec (flip withDecDoc dec) mdoc---- | Variant of 'patSynD' that attaches Haddock documentation.-patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat-            -> Maybe String   -- ^ Documentation to attach to the pattern synonym-            -> [Maybe String] -- ^ Documentation to attach to the pattern arguments-            -> Q Dec-patSynD_doc name args dir pat mdoc arg_docs = do-  qAddModFinalizer $ sequence_-    [putDoc (ArgDoc name i) s | (i, Just s) <- zip [0..] arg_docs]-  let dec = patSynD name args dir pat-  maybe dec (flip withDecDoc dec) mdoc---- | Document a data/newtype constructor with its arguments.-docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()-docCons (c, md, arg_docs) = do-  c' <- c-  -- Attach docs to the constructors-  sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- get_cons_names c' ]-  -- Attach docs to the arguments-  case c' of-    -- Record selector documentation isn't stored in the argument map,-    -- but in the declaration map instead-    RecC _ var_bang_types ->-      sequence_ [ putDoc (DeclDoc nm) arg_doc-                  | (Just arg_doc, (nm, _, _)) <- zip arg_docs var_bang_types-                ]-    _ ->-      sequence_ [ putDoc (ArgDoc nm i) arg_doc-                    | nm <- get_cons_names c'-                    , (i, Just arg_doc) <- zip [0..] arg_docs-                ]
− libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs 
@@ -1,111 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE Safe #-}---- This is a non-exposed internal module------ The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost--- verbatimely to avoid a dependency of 'template-haskell' on the containers package.------ [1] see https://hackage.haskell.org/package/containers-0.5.5.1------ The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.--module Language.Haskell.TH.Lib.Map-    ( Map-    , empty-    , insert-    , Language.Haskell.TH.Lib.Map.lookup-    ) where--import Prelude--data Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)-              | Tip--type Size     = Int--empty :: Map k a-empty = Tip-{-# INLINE empty #-}--singleton :: k -> a -> Map k a-singleton k x = Bin 1 k x Tip Tip-{-# INLINE singleton #-}--size :: Map k a -> Int-size Tip              = 0-size (Bin sz _ _ _ _) = sz-{-# INLINE size #-}--lookup :: Ord k => k -> Map k a -> Maybe a-lookup = go-  where-    go _ Tip = Nothing-    go !k (Bin _ kx x l r) = case compare k kx of-      LT -> go k l-      GT -> go k r-      EQ -> Just x-{-# INLINABLE lookup #-}---insert :: Ord k => k -> a -> Map k a -> Map k a-insert = go-  where-    go :: Ord k => k -> a -> Map k a -> Map k a-    go !kx x Tip = singleton kx x-    go !kx x (Bin sz ky y l r) =-        case compare kx ky of-            LT -> balanceL ky y (go kx x l) r-            GT -> balanceR ky y l (go kx x r)-            EQ -> Bin sz kx x l r-{-# INLINABLE insert #-}--balanceL :: k -> a -> Map k a -> Map k a -> Map k a-balanceL k x l r = case r of-  Tip -> case l of-           Tip -> Bin 1 k x Tip Tip-           (Bin _ _ _ Tip Tip) -> Bin 2 k x l Tip-           (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) -> Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)-           (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) -> Bin 3 lk lx ll (Bin 1 k x Tip Tip)-           (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr))-             | lrs < ratio*lls -> Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)-             | otherwise -> Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)--  (Bin rs _ _ _ _) -> case l of-           Tip -> Bin (1+rs) k x Tip r--           (Bin ls lk lx ll lr)-              | ls > delta*rs  -> case (ll, lr) of-                   (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr)-                     | lrs < ratio*lls -> Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)-                     | otherwise -> Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)-                   (_, _) -> error "Failure in Data.Map.balanceL"-              | otherwise -> Bin (1+ls+rs) k x l r-{-# NOINLINE balanceL #-}--balanceR :: k -> a -> Map k a -> Map k a -> Map k a-balanceR k x l r = case l of-  Tip -> case r of-           Tip -> Bin 1 k x Tip Tip-           (Bin _ _ _ Tip Tip) -> Bin 2 k x Tip r-           (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) -> Bin 3 rk rx (Bin 1 k x Tip Tip) rr-           (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) -> Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)-           (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _))-             | rls < ratio*rrs -> Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr-             | otherwise -> Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)--  (Bin ls _ _ _ _) -> case r of-           Tip -> Bin (1+ls) k x l Tip--           (Bin rs rk rx rl rr)-              | rs > delta*ls  -> case (rl, rr) of-                   (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _)-                     | rls < ratio*rrs -> Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr-                     | otherwise -> Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)-                   (_, _) -> error "Failure in Data.Map.balanceR"-              | otherwise -> Bin (1+ls+rs) k x l r-{-# NOINLINE balanceR #-}--delta,ratio :: Int-delta = 3-ratio = 2
− libraries/template-haskell/Language/Haskell/TH/Ppr.hs 
@@ -1,1075 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE LambdaCase #-}--- | contains a prettyprinter for the--- Template Haskell datatypes--module Language.Haskell.TH.Ppr where-    -- All of the exports from this module should-    -- be "public" functions.  The main module TH-    -- re-exports them all.--import Text.PrettyPrint (render)-import Language.Haskell.TH.PprLib-import Language.Haskell.TH.Syntax-import Data.Word ( Word8 )-import Data.Char ( toLower, chr)-import GHC.Show  ( showMultiLineString )-import GHC.Lexeme( isVarSymChar )-import Data.Ratio ( numerator, denominator )-import Data.Foldable ( toList )-import Prelude hiding ((<>))--nestDepth :: Int-nestDepth = 4--type Precedence = Int-appPrec, opPrec, unopPrec, funPrec, qualPrec, sigPrec, noPrec :: Precedence-appPrec  = 6    -- Argument of a function or type application-opPrec   = 5    -- Argument of an infix operator-unopPrec = 4    -- Argument of an unresolved infix operator-funPrec  = 3    -- Argument of a function arrow-qualPrec = 2    -- Forall-qualified type or result of a function arrow-sigPrec  = 1    -- Argument of an explicit type signature-noPrec   = 0    -- Others--parensIf :: Bool -> Doc -> Doc-parensIf True d = parens d-parensIf False d = d----------------------------------pprint :: Ppr a => a -> String-pprint x = render $ to_HPJ_Doc $ ppr x--class Ppr a where-    ppr :: a -> Doc-    ppr_list :: [a] -> Doc-    ppr_list = vcat . map ppr--instance Ppr a => Ppr [a] where-    ppr x = ppr_list x---------------------------------instance Ppr Name where-    ppr v = pprName v---------------------------------instance Ppr Info where-    ppr (TyConI d)     = ppr d-    ppr (ClassI d is)  = ppr d $$ vcat (map ppr is)-    ppr (FamilyI d is) = ppr d $$ vcat (map ppr is)-    ppr (PrimTyConI name arity is_unlifted)-      = text "Primitive"-        <+> (if is_unlifted then text "unlifted" else empty)-        <+> text "type constructor" <+> quotes (ppr name)-        <+> parens (text "arity" <+> int arity)-    ppr (ClassOpI v ty cls)-      = text "Class op from" <+> ppr cls <> colon <+> ppr_sig v ty-    ppr (DataConI v ty tc)-      = text "Constructor from" <+> ppr tc <> colon <+> ppr_sig v ty-    ppr (PatSynI nm ty) = pprPatSynSig nm ty-    ppr (TyVarI v ty)-      = text "Type variable" <+> ppr v <+> equals <+> ppr ty-    ppr (VarI v ty mb_d)-      = vcat [ppr_sig v ty,-              case mb_d of { Nothing -> empty; Just d -> ppr d }]--ppr_sig :: Name -> Type -> Doc-ppr_sig v ty = pprName' Applied v <+> dcolon <+> ppr ty--pprFixity :: Name -> Fixity -> NamespaceSpecifier -> Doc-pprFixity _ f _ | f == defaultFixity = empty-pprFixity v (Fixity i d) ns_spec-  = ppr_fix d <+> int i <+> pprNamespaceSpecifier ns_spec <+> pprName' Infix v-    where ppr_fix InfixR = text "infixr"-          ppr_fix InfixL = text "infixl"-          ppr_fix InfixN = text "infix"--pprNamespaceSpecifier :: NamespaceSpecifier -> Doc-pprNamespaceSpecifier NoNamespaceSpecifier = empty-pprNamespaceSpecifier TypeNamespaceSpecifier = text "type"-pprNamespaceSpecifier DataNamespaceSpecifier = text "data"---- | Pretty prints a pattern synonym type signature-pprPatSynSig :: Name -> PatSynType -> Doc-pprPatSynSig nm ty-  = text "pattern" <+> pprPrefixOcc nm <+> dcolon <+> pprPatSynType ty---- | Pretty prints a pattern synonym's type; follows the usual--- conventions to print a pattern synonym type compactly, yet--- unambiguously. See the note on 'PatSynType' and the section on--- pattern synonyms in the GHC user's guide for more information.-pprPatSynType :: PatSynType -> Doc-pprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))-  | null exTys,  null provs = ppr (ForallT uniTys reqs ty'')-  | null uniTys, null reqs  = noreqs <+> ppr ty'-  | null reqs               = pprForallBndrs uniTys <+> noreqs <+> ppr ty'-  | otherwise               = ppr ty-  where noreqs = text "() =>"-        pprForallBndrs tvs = text "forall" <+> hsep (map ppr tvs) <+> text "."-pprPatSynType ty            = ppr ty---------------------------------instance Ppr Module where-  ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)--instance Ppr ModuleInfo where-  ppr (ModuleInfo imps) = text "Module" <+> vcat (map ppr imps)---------------------------------instance Ppr Exp where-    ppr = pprExp noPrec--pprPrefixOcc :: Name -> Doc--- Print operators with parens around them-pprPrefixOcc n = parensIf (isSymOcc n) (ppr n)--isSymOcc :: Name -> Bool-isSymOcc n-  = case nameBase n of-      []    -> True  -- Empty name; weird-      (c:_) -> isVarSymChar c-                   -- c.f. isVarSymChar in GHC itself--pprInfixExp :: Exp -> Doc-pprInfixExp (VarE v) = pprName' Infix v-pprInfixExp (ConE v) = pprName' Infix v-pprInfixExp (UnboundVarE v) = pprName' Infix v--- This case will only ever be reached in exceptional circumstances.--- For example, when printing an error message in case of a malformed expression.-pprInfixExp e = text "`" <> ppr e <> text "`"--pprExp :: Precedence -> Exp -> Doc-pprExp _ (VarE v)     = pprName' Applied v-pprExp _ (ConE c)     = pprName' Applied c-pprExp i (LitE l)     = pprLit i l-pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1-                                              <+> pprExp appPrec e2-pprExp i (AppTypeE e t)- = parensIf (i >= appPrec) $ pprExp opPrec e <+> char '@' <> pprParendType t-pprExp _ (ParensE e)  = parens (pprExp noPrec e)-pprExp i (UInfixE e1 op e2)- = parensIf (i > unopPrec) $ pprExp unopPrec e1-                         <+> pprInfixExp op-                         <+> pprExp unopPrec e2-pprExp i (InfixE (Just e1) op (Just e2))- = parensIf (i >= opPrec) $ pprExp opPrec e1-                        <+> pprInfixExp op-                        <+> pprExp opPrec e2-pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1-                                    <+> pprInfixExp op-                                    <+> pprMaybeExp noPrec me2-pprExp i (LamE [] e) = pprExp i e -- #13856-pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)-                                           <+> text "->" <+> ppr e-pprExp i (LamCaseE ms)-  = parensIf (i > noPrec) $ text "\\case" $$ braces (semiSep ms)-pprExp i (LamCasesE ms)-  = parensIf (i > noPrec) $ text "\\cases" $$ braces (semi_sep ms)-  where semi_sep = sep . punctuate semi . map (pprClause False)-pprExp i (TupE es)-  | [Just e] <- es-  = pprExp i (ConE (tupleDataName 1) `AppE` e)-  | otherwise-  = parens (commaSepWith (pprMaybeExp noPrec) es)-pprExp _ (UnboxedTupE es) = hashParens (commaSepWith (pprMaybeExp noPrec) es)-pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity--- Nesting in Cond is to avoid potential problems in do statements-pprExp i (CondE guard true false)- = parensIf (i > noPrec) $ sep [text "if"   <+> ppr guard,-                       nest 1 $ text "then" <+> ppr true,-                       nest 1 $ text "else" <+> ppr false]-pprExp i (MultiIfE alts)-  = parensIf (i > noPrec) $ vcat $-      case alts of-        []            -> [text "if {}"]-        (alt : alts') -> text "if" <+> pprGuarded arrow alt-                         : map (nest 3 . pprGuarded arrow) alts'-pprExp i (LetE ds_ e) = parensIf (i > noPrec) $ text "let" <+> pprDecs ds_-                                             $$ text " in" <+> ppr e-  where-    pprDecs []  = empty-    pprDecs [d] = ppr d-    pprDecs ds  = braces (semiSep ds)--pprExp i (CaseE e ms)- = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"-                        $$ braces (semiSep ms)-pprExp i (DoE m ss_) = parensIf (i > noPrec) $-    pprQualifier m <> text "do" <+> pprStms ss_-  where-    pprQualifier Nothing = empty-    pprQualifier (Just modName) = text (modString modName) <> char '.'-    pprStms []  = empty-    pprStms [s] = ppr s-    pprStms ss  = braces (semiSep ss)-pprExp i (MDoE m ss_) = parensIf (i > noPrec) $-    pprQualifier m <> text "mdo" <+> pprStms ss_-  where-    pprQualifier Nothing = empty-    pprQualifier (Just modName) = text (modString modName) <> char '.'-    pprStms []  = empty-    pprStms [s] = ppr s-    pprStms ss  = braces (semiSep ss)--pprExp _ (CompE []) = text "<<Empty CompExp>>"--- This will probably break with fixity declarations - would need a ';'-pprExp _ (CompE ss) =-    if null ss'-       -- If there are no statements in a list comprehension besides the last-       -- one, we simply treat it like a normal list.-       then text "[" <> ppr s <> text "]"-       else text "[" <> ppr s-        <+> bar-        <+> commaSep ss'-         <> text "]"-  where s = last ss-        ss' = init ss-pprExp _ (ArithSeqE d) = ppr d-pprExp _ (ListE es) = brackets (commaSep es)-pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e-                                          <+> dcolon <+> pprType sigPrec t-pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs)-pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)-pprExp i (StaticE e) = parensIf (i >= appPrec) $-                         text "static"<+> pprExp appPrec e-pprExp _ (UnboundVarE v) = pprName' Applied v-pprExp _ (LabelE s) = text "#" <> text s-pprExp _ (ImplicitParamVarE n) = text ('?' : n)-pprExp _ (GetFieldE e f) = pprExp appPrec e <> text ('.': f)-pprExp _ (ProjectionE xs) = parens $ hcat $ map ((char '.'<>) . text) $ toList xs-pprExp _ (TypedBracketE e) = text "[||" <> ppr e <> text "||]"-pprExp _ (TypedSpliceE e) = text "$$" <> pprExp appPrec e-pprExp i (TypeE t) = parensIf (i > noPrec) $ text "type" <+> ppr t--pprFields :: [(Name,Exp)] -> Doc-pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e)--pprMaybeExp :: Precedence -> Maybe Exp -> Doc-pprMaybeExp _ Nothing = empty-pprMaybeExp i (Just e) = pprExp i e---------------------------------instance Ppr Stmt where-    ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e-    ppr (LetS ds) = text "let" <+> (braces (semiSep ds))-    ppr (NoBindS e) = ppr e-    ppr (ParS sss) = sep $ punctuate bar-                         $ map commaSep sss-    ppr (RecS ss) = text "rec" <+> (braces (semiSep ss))---------------------------------instance Ppr Match where-    ppr (Match p rhs ds) = pprMatchPat p <+> pprBody False rhs-                        $$ where_clause ds--pprMatchPat :: Pat -> Doc--- Everything except pattern signatures bind more tightly than (->)-pprMatchPat p@(SigP {}) = parens (ppr p)-pprMatchPat p           = ppr p---------------------------------pprGuarded :: Doc -> (Guard, Exp) -> Doc-pprGuarded eqDoc (guard, expr) = case guard of-  NormalG guardExpr -> bar <+> ppr guardExpr <+> eqDoc <+> ppr expr-  PatG    stmts     -> bar <+> vcat (punctuate comma $ map ppr stmts) $$-                         nest nestDepth (eqDoc <+> ppr expr)---------------------------------pprBody :: Bool -> Body -> Doc-pprBody eq body = case body of-    GuardedB xs -> nest nestDepth $ vcat $ map (pprGuarded eqDoc) xs-    NormalB  e  -> eqDoc <+> ppr e-  where eqDoc | eq        = equals-              | otherwise = arrow---------------------------------pprClause :: Bool -> Clause -> Doc-pprClause eqDoc (Clause ps rhs ds)-  = hsep (map (pprPat appPrec) ps) <+> pprBody eqDoc rhs-    $$ where_clause ds---------------------------------instance Ppr Lit where-  ppr = pprLit noPrec--pprLit :: Precedence -> Lit -> Doc-pprLit i (IntPrimL x)    = parensIf (i > noPrec && x < 0)-                                    (integer x <> char '#')-pprLit _ (WordPrimL x)    = integer x <> text "##"-pprLit i (FloatPrimL x)  = parensIf (i > noPrec && x < 0)-                                    (float (fromRational x) <> char '#')-pprLit i (DoublePrimL x) = parensIf (i > noPrec && x < 0)-                                    (double (fromRational x) <> text "##")-pprLit i (IntegerL x)    = parensIf (i > noPrec && x < 0) (integer x)-pprLit _ (CharL c)       = text (show c)-pprLit _ (CharPrimL c)   = text (show c) <> char '#'-pprLit _ (StringL s)     = pprString s-pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'-pprLit _ (BytesPrimL {}) = pprString "<binary data>"-pprLit i (RationalL rat)-  | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1-  -- if the denominator has prime factors other than 2 and 5-  -- or can't be represented as Double, show as fraction-  = parensIf (i > noPrec) $-    integer (numerator rat) <+> char '/' <+> integer (denominator rat)-  | rat /= 0 && (zeroes < -2 || zeroes > 6),-    let (n, d) = properFraction (rat / magnitude)-  -- if < 0.01 or >= 100_000_000, use scientific notation-  = parensIf (i > noPrec && rat < 0)-             (integer n-              <> (if d == 0 then empty else char '.' <> decimals (abs d))-              <> char 'e' <> integer zeroes)-  | let (n, d) = properFraction rat-  = parensIf (i > noPrec && rat < 0)-             (integer n <> char '.'-              <> if d == 0 then char '0' else decimals (abs d))-  where zeroes :: Integer-        zeroes = log10 (abs rat)-        log10 :: Rational -> Integer-        log10 x-          | x >= 10 = 1 + log10 (x / 10)-          | x < 1 = -1 + log10 (x * 10)-          | otherwise = 0-        magnitude :: Rational-        magnitude = 10 ^^ zeroes-        withoutFactor :: Integer -> Integer -> Integer-        withoutFactor _ 0 = 0-        withoutFactor p n-          | (n', 0) <- divMod n p = withoutFactor p n'-          | otherwise = n-        -- | Expects the argument 0 <= x < 1-        decimals :: Rational -> Doc-        decimals x-          | x == 0 = empty-          | otherwise = integer n <> decimals d-          where (n, d) = properFraction (x * 10)--bytesToString :: [Word8] -> String-bytesToString = map (chr . fromIntegral)--pprString :: String -> Doc--- Print newlines as newlines with Haskell string escape notation,--- not as '\n'.  For other non-printables use regular escape notation.-pprString s = vcat (map text (showMultiLineString s))---------------------------------instance Ppr Pat where-    ppr = pprPat noPrec--pprPat :: Precedence -> Pat -> Doc-pprPat i (LitP l)     = pprLit i l-pprPat _ (VarP v)     = pprName' Applied v-pprPat i (TupP ps)-  | [_] <- ps-  = pprPat i (ConP (tupleDataName 1) [] ps)-  | otherwise-  = parens (commaSep ps)-pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)-pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity-pprPat i (ConP s ts ps)  = parensIf (i >= appPrec) $-      pprName' Applied s-  <+> sep (map (\t -> char '@' <> pprParendType t) ts)-  <+> sep (map (pprPat appPrec) ps)-pprPat _ (ParensP p)  = parens $ pprPat noPrec p-pprPat i (UInfixP p1 n p2)-                      = parensIf (i > unopPrec) (pprPat unopPrec p1 <+>-                                                 pprName' Infix n   <+>-                                                 pprPat unopPrec p2)-pprPat i (InfixP p1 n p2)-                      = parensIf (i >= opPrec) (pprPat opPrec p1 <+>-                                                pprName' Infix n <+>-                                                pprPat opPrec p2)-pprPat i (TildeP p)   = parensIf (i > noPrec) $ char '~' <> pprPat appPrec p-pprPat i (BangP p)    = parensIf (i > noPrec) $ char '!' <> pprPat appPrec p-pprPat i (AsP v p)    = parensIf (i > noPrec) $ ppr v <> text "@"-                                                      <> pprPat appPrec p-pprPat _ WildP        = text "_"-pprPat _ (RecP nm fs)- = parens $     pprName' Applied nm-            <+> braces (sep $ punctuate comma $-                        map (\(s,p) -> pprName' Applied s <+> equals <+> ppr p) fs)-pprPat _ (ListP ps) = brackets (commaSep ps)-pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> dcolon <+> ppr t-pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p-pprPat _ (TypeP t) = parens $ text "type" <+> ppr t-pprPat _ (InvisP t) = parens $ text "@" <+> ppr t---------------------------------instance Ppr Dec where-    ppr = ppr_dec True--ppr_dec :: Bool     -- ^ declaration on the toplevel?-        -> Dec-        -> Doc-ppr_dec isTop (FunD f cs)   = layout $ map (\c -> pprPrefixOcc f <+> ppr c) cs-  where-    layout :: [Doc] -> Doc-    layout = if isTop then vcat else semiSepWith id-ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r-                          $$ where_clause ds-ppr_dec _ (TySynD t xs rhs)-  = ppr_tySyn empty (Just t) (hsep (map ppr xs)) rhs-ppr_dec isTop (DataD ctxt t xs ksig cs decs)-  = ppr_data isTop empty ctxt (Just t) (hsep (map ppr xs)) ksig cs decs-ppr_dec isTop (NewtypeD ctxt t xs ksig c decs)-  = ppr_newtype isTop empty ctxt (Just t) (sep (map ppr xs)) ksig c decs-ppr_dec isTop (TypeDataD t xs ksig cs)-  = ppr_type_data isTop empty [] (Just t) (hsep (map ppr xs)) ksig cs []-ppr_dec _  (ClassD ctxt c xs fds ds)-  = text "class" <+> pprCxt ctxt <+> pprName' Applied c <+> hsep (map ppr xs) <+> ppr fds-    $$ where_clause ds-ppr_dec _ (InstanceD o ctxt i ds) =-        text "instance" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i-                                  $$ where_clause ds-ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> dcolon <+> ppr t-ppr_dec _ (KiSigD f k)  = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k-ppr_dec _ (ForeignD f)  = ppr f-ppr_dec _ (InfixD fx ns_spec n) = pprFixity n fx ns_spec-ppr_dec _ (DefaultD tys) =-        text "default" <+> parens (sep $ punctuate comma $ map ppr tys)-ppr_dec _ (PragmaD p)   = ppr p-ppr_dec isTop (DataFamilyD tc tvs kind)-  = text "data" <+> maybeFamily <+> pprName' Applied tc <+> hsep (map ppr tvs) <+> maybeKind-  where-    maybeFamily | isTop     = text "family"-                | otherwise = empty-    maybeKind | (Just k') <- kind = dcolon <+> ppr k'-              | otherwise = empty-ppr_dec isTop (DataInstD ctxt bndrs ty ksig cs decs)-  = ppr_data isTop (maybeInst <+> ppr_bndrs bndrs)-             ctxt Nothing (ppr ty) ksig cs decs-  where-    maybeInst | isTop     = text "instance"-              | otherwise = empty-ppr_dec isTop (NewtypeInstD ctxt bndrs ty ksig c decs)-  = ppr_newtype isTop (maybeInst <+> ppr_bndrs bndrs)-                ctxt Nothing (ppr ty) ksig c decs-  where-    maybeInst | isTop     = text "instance"-              | otherwise = empty-ppr_dec isTop (TySynInstD (TySynEqn mb_bndrs ty rhs))-  = ppr_tySyn (maybeInst <+> ppr_bndrs mb_bndrs)-              Nothing (ppr ty) rhs-  where-    maybeInst | isTop     = text "instance"-              | otherwise = empty-ppr_dec isTop (OpenTypeFamilyD tfhead)-  = text "type" <+> maybeFamily <+> ppr_tf_head tfhead-  where-    maybeFamily | isTop     = text "family"-                | otherwise = empty-ppr_dec _ (ClosedTypeFamilyD tfhead eqns)-  = hang (text "type family" <+> ppr_tf_head tfhead <+> text "where")-      nestDepth (vcat (map ppr_eqn eqns))-  where-    ppr_eqn (TySynEqn mb_bndrs lhs rhs)-      = ppr_bndrs mb_bndrs <+> ppr lhs <+> text "=" <+> ppr rhs-ppr_dec _ (RoleAnnotD name roles)-  = hsep [ text "type role", pprName' Applied name ] <+> hsep (map ppr roles)-ppr_dec _ (StandaloneDerivD ds cxt ty)-  = hsep [ text "deriving"-         , maybe empty ppr_deriv_strategy ds-         , text "instance"-         , pprCxt cxt-         , ppr ty ]-ppr_dec _ (DefaultSigD n ty)-  = hsep [ text "default", pprPrefixOcc n, dcolon, ppr ty ]-ppr_dec _ (PatSynD name args dir pat)-  = text "pattern" <+> pprNameArgs <+> ppr dir <+> pprPatRHS-  where-    pprNameArgs | InfixPatSyn a1 a2 <- args = ppr a1 <+> pprName' Infix name <+> ppr a2-                | otherwise                 = pprName' Applied name <+> ppr args-    pprPatRHS   | ExplBidir cls <- dir = hang (ppr pat <+> text "where")-                                              nestDepth-                                              (vcat $ (pprName' Applied name <+>) . ppr <$> cls)-                | otherwise            = ppr pat-ppr_dec _ (PatSynSigD name ty)-  = pprPatSynSig name ty-ppr_dec _ (ImplicitParamBindD n e)-  = hsep [text ('?' : n), text "=", ppr e]--ppr_deriv_strategy :: DerivStrategy -> Doc-ppr_deriv_strategy ds =-  case ds of-    StockStrategy    -> text "stock"-    AnyclassStrategy -> text "anyclass"-    NewtypeStrategy  -> text "newtype"-    ViaStrategy ty   -> text "via" <+> pprParendType ty--ppr_overlap :: Overlap -> Doc-ppr_overlap o = text $-  case o of-    Overlaps      -> "{-# OVERLAPS #-}"-    Overlappable  -> "{-# OVERLAPPABLE #-}"-    Overlapping   -> "{-# OVERLAPPING #-}"-    Incoherent    -> "{-# INCOHERENT #-}"--ppr_data :: Bool     -- ^ declaration on the toplevel?-         -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]-         -> Doc-ppr_data = ppr_typedef "data"--ppr_newtype :: Bool     -- ^ declaration on the toplevel?-            -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]-            -> Doc-ppr_newtype isTop maybeInst ctxt t argsDoc ksig c decs-  = ppr_typedef "newtype" isTop maybeInst ctxt t argsDoc ksig [c] decs--ppr_type_data :: Bool     -- ^ declaration on the toplevel?-              -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]-              -> Doc-ppr_type_data = ppr_typedef "type data"--ppr_typedef :: String -> Bool -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc-ppr_typedef data_or_newtype isTop maybeInst ctxt t argsDoc ksig cs decs-  = sep [text data_or_newtype <+> maybeInst-            <+> pprCxt ctxt-            <+> case t of-                 Just n -> pprName' Applied n <+> argsDoc-                 Nothing -> argsDoc-            <+> ksigDoc <+> maybeWhere,-         nest nestDepth (layout (pref $ map ppr cs)),-         if null decs-           then empty-           else nest nestDepth-              $ vcat $ map ppr_deriv_clause decs]-  where-    pref :: [Doc] -> [Doc]-    pref xs | isGadtDecl = xs-    pref []              = []      -- No constructors; can't happen in H98-    pref (d:ds)          = (char '=' <+> d):map (bar <+>) ds--    layout :: [Doc] -> Doc-    layout | isGadtDecl && not isTop = braces . semiSepWith id-           | otherwise = vcat--    maybeWhere :: Doc-    maybeWhere | isGadtDecl = text "where"-               | otherwise  = empty--    isGadtDecl :: Bool-    isGadtDecl = not (null cs) && all isGadtCon cs-        where isGadtCon (GadtC _ _ _   ) = True-              isGadtCon (RecGadtC _ _ _) = True-              isGadtCon (ForallC _ _ x ) = isGadtCon x-              isGadtCon  _               = False--    ksigDoc = case ksig of-                Nothing -> empty-                Just k  -> dcolon <+> ppr k---ppr_deriv_clause :: DerivClause -> Doc-ppr_deriv_clause (DerivClause ds ctxt)-  = text "deriving" <+> pp_strat_before-                    <+> ppr_cxt_preds appPrec ctxt-                    <+> pp_strat_after-  where-    -- @via@ is unique in that in comes /after/ the class being derived,-    -- so we must special-case it.-    (pp_strat_before, pp_strat_after) =-      case ds of-        Just (via@ViaStrategy{}) -> (empty, ppr_deriv_strategy via)-        _                        -> (maybe empty ppr_deriv_strategy ds, empty)--ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc-ppr_tySyn maybeInst t argsDoc rhs-  = text "type" <+> maybeInst-    <+> case t of-         Just n -> pprName' Applied n <+> argsDoc-         Nothing -> argsDoc-    <+> text "=" <+> ppr rhs--ppr_tf_head :: TypeFamilyHead -> Doc-ppr_tf_head (TypeFamilyHead tc tvs res inj)-  = pprName' Applied tc <+> hsep (map ppr tvs) <+> ppr res <+> maybeInj-  where-    maybeInj | (Just inj') <- inj = ppr inj'-             | otherwise          = empty--ppr_bndrs :: PprFlag flag => Maybe [TyVarBndr flag] -> Doc-ppr_bndrs (Just bndrs) = text "forall" <+> sep (map ppr bndrs) <> text "."-ppr_bndrs Nothing = empty---------------------------------instance Ppr FunDep where-    ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)-    ppr_list [] = empty-    ppr_list xs = bar <+> commaSep xs---------------------------------instance Ppr FamilyResultSig where-    ppr NoSig           = empty-    ppr (KindSig k)     = dcolon <+> ppr k-    ppr (TyVarSig bndr) = text "=" <+> ppr bndr---------------------------------instance Ppr InjectivityAnn where-    ppr (InjectivityAnn lhs rhs) =-        bar <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)---------------------------------instance Ppr Foreign where-    ppr (ImportF callconv safety impent as typ)-       = text "foreign import"-     <+> showtextl callconv-     <+> showtextl safety-     <+> text (show impent)-     <+> pprName' Applied as-     <+> dcolon <+> ppr typ-    ppr (ExportF callconv expent as typ)-        = text "foreign export"-      <+> showtextl callconv-      <+> text (show expent)-      <+> pprName' Applied as-      <+> dcolon <+> ppr typ---------------------------------instance Ppr Pragma where-    ppr (InlineP n inline rm phases)-       = text "{-#"-     <+> ppr inline-     <+> ppr rm-     <+> ppr phases-     <+> pprName' Applied n-     <+> text "#-}"-    ppr (OpaqueP n)-       = text "{-# OPAQUE" <+> pprName' Applied n <+> text "#-}"-    ppr (SpecialiseP n ty inline phases)-       =   text "{-# SPECIALISE"-       <+> maybe empty ppr inline-       <+> ppr phases-       <+> sep [ pprName' Applied n <+> dcolon-               , nest 2 $ ppr ty ]-       <+> text "#-}"-    ppr (SpecialiseInstP inst)-       = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"-    ppr (RuleP n ty_bndrs tm_bndrs lhs rhs phases)-       = sep [ text "{-# RULES" <+> pprString n <+> ppr phases-             , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs-                                               <+> ppr lhs-             , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]-      where ppr_ty_forall Nothing      = empty-            ppr_ty_forall (Just bndrs) = text "forall"-                                         <+> fsep (map ppr bndrs)-                                         <+> char '.'-            ppr_tm_forall Nothing | null tm_bndrs = empty-            ppr_tm_forall _ = text "forall"-                              <+> fsep (map ppr tm_bndrs)-                              <+> char '.'-    ppr (AnnP tgt expr)-       = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}"-      where target1 ModuleAnnotation    = text "module"-            target1 (TypeAnnotation t)  = text "type" <+> pprName' Applied t-            target1 (ValueAnnotation v) = pprName' Applied v-    ppr (LineP line file)-       = text "{-# LINE" <+> int line <+> text (show file) <+> text "#-}"-    ppr (CompleteP cls mty)-       = text "{-# COMPLETE" <+> (fsep $ punctuate comma $ map (pprName' Applied) cls)-                <+> maybe empty (\ty -> dcolon <+> pprName' Applied ty) mty <+> text "#-}"-    ppr (SCCP nm str)-       = text "{-# SCC" <+> pprName' Applied nm <+> maybe empty pprString str <+> text "#-}"---------------------------------instance Ppr Inline where-    ppr NoInline  = text "NOINLINE"-    ppr Inline    = text "INLINE"-    ppr Inlinable = text "INLINABLE"---------------------------------instance Ppr RuleMatch where-    ppr ConLike = text "CONLIKE"-    ppr FunLike = empty---------------------------------instance Ppr Phases where-    ppr AllPhases       = empty-    ppr (FromPhase i)   = brackets $ int i-    ppr (BeforePhase i) = brackets $ char '~' <> int i---------------------------------instance Ppr RuleBndr where-    ppr (RuleVar n)         = ppr n-    ppr (TypedRuleVar n ty) = parens $ ppr n <+> dcolon <+> ppr ty---------------------------------instance Ppr Clause where-    ppr = pprClause True---------------------------------instance Ppr Con where-    ppr (NormalC c sts) = pprName' Applied c <+> sep (map pprBangType sts)--    ppr (RecC c vsts)-        = pprName' Applied c <+> braces (sep (punctuate comma $ map pprVarBangType vsts))--    ppr (InfixC st1 c st2) = pprBangType st1-                         <+> pprName' Infix c-                         <+> pprBangType st2--    ppr (ForallC ns ctxt (GadtC cs sts ty))-        = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt-      <+> pprGadtRHS sts ty--    ppr (ForallC ns ctxt (RecGadtC cs vsts ty))-        = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt-      <+> pprRecFields vsts ty--    ppr (ForallC ns ctxt con)-        = pprForall ns ctxt <+> ppr con--    ppr (GadtC cs sts ty)-        = commaSepApplied cs <+> dcolon <+> pprGadtRHS sts ty--    ppr (RecGadtC cs vsts ty)-        = commaSepApplied cs <+> dcolon <+> pprRecFields vsts ty--instance Ppr PatSynDir where-  ppr Unidir        = text "<-"-  ppr ImplBidir     = text "="-  ppr (ExplBidir _) = text "<-"-    -- the ExplBidir's clauses are pretty printed together with the-    -- entire pattern synonym; so only print the direction here.--instance Ppr PatSynArgs where-  ppr (PrefixPatSyn args) = sep $ map ppr args-  ppr (InfixPatSyn a1 a2) = ppr a1 <+> ppr a2-  ppr (RecordPatSyn sels) = braces $ sep (punctuate comma (map (pprName' Applied) sels))--commaSepApplied :: [Name] -> Doc-commaSepApplied = commaSepWith (pprName' Applied)--pprForall :: [TyVarBndr Specificity] -> Cxt -> Doc-pprForall = pprForall' ForallInvis--pprForallVis :: [TyVarBndr ()] -> Cxt -> Doc-pprForallVis = pprForall' ForallVis--pprForall' :: PprFlag flag => ForallVisFlag -> [TyVarBndr flag] -> Cxt -> Doc-pprForall' fvf tvs cxt-  -- even in the case without any tvs, there could be a non-empty-  -- context cxt (e.g., in the case of pattern synonyms, where there-  -- are multiple forall binders and contexts).-  | [] <- tvs = pprCxt cxt-  | otherwise = text "forall" <+> hsep (map ppr tvs)-                              <+> separator <+> pprCxt cxt-  where-    separator = case fvf of-                  ForallVis   -> text "->"-                  ForallInvis -> char '.'--pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc-pprRecFields vsts ty-    = braces (sep (punctuate comma $ map pprVarBangType vsts))-  <+> arrow <+> ppr ty--pprGadtRHS :: [(Strict, Type)] -> Type -> Doc-pprGadtRHS [] ty-    = ppr ty-pprGadtRHS sts ty-    = sep (punctuate (space <> arrow) (map pprBangType sts))-  <+> arrow <+> ppr ty---------------------------------pprVarBangType :: VarBangType -> Doc--- Slight infelicity: with print non-atomic type with parens-pprVarBangType (v, bang, t) = pprName' Applied v <+> dcolon <+> pprBangType (bang, t)---------------------------------pprBangType :: BangType -> Doc--- Make sure we print------ Con {-# UNPACK #-} a------ rather than------ Con {-# UNPACK #-}a------ when there's no strictness annotation. If there is a strictness annotation,--- it's okay to not put a space between it and the type.-pprBangType (bt@(Bang _ NoSourceStrictness), t) = ppr bt <+> pprParendType t-pprBangType (bt, t) = ppr bt <> pprParendType t---------------------------------instance Ppr Bang where-    ppr (Bang su ss) = ppr su <+> ppr ss---------------------------------instance Ppr SourceUnpackedness where-    ppr NoSourceUnpackedness = empty-    ppr SourceNoUnpack       = text "{-# NOUNPACK #-}"-    ppr SourceUnpack         = text "{-# UNPACK #-}"---------------------------------instance Ppr SourceStrictness where-    ppr NoSourceStrictness = empty-    ppr SourceLazy         = char '~'-    ppr SourceStrict       = char '!'---------------------------------instance Ppr DecidedStrictness where-    ppr DecidedLazy   = empty-    ppr DecidedStrict = char '!'-    ppr DecidedUnpack = text "{-# UNPACK #-} !"---------------------------------{-# DEPRECATED pprVarStrictType-               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'pprVarBangType' instead." #-}-pprVarStrictType :: (Name, Strict, Type) -> Doc-pprVarStrictType = pprVarBangType---------------------------------{-# DEPRECATED pprStrictType-               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'pprBangType' instead." #-}-pprStrictType :: (Strict, Type) -> Doc-pprStrictType = pprBangType---------------------------------pprType :: Precedence -> Type -> Doc-pprType _ (VarT v)               = pprName' Applied v--- `Applied` is used here instead of `ppr` because of infix names (#13887)-pprType _ (ConT c)               = pprName' Applied c-pprType _ (TupleT 0)             = text "()"-pprType p (TupleT 1)             = pprType p (ConT (tupleTypeName 1))-pprType _ (TupleT n)             = parens (hcat (replicate (n-1) comma))-pprType _ (UnboxedTupleT n)      = hashParens $ hcat $ replicate (n-1) comma-pprType _ (UnboxedSumT arity)    = hashParens $ hcat $ replicate (arity-1) bar-pprType _ ArrowT                 = parens (text "->")-pprType _ MulArrowT              = text "FUN"-pprType _ ListT                  = text "[]"-pprType _ (LitT l)               = pprTyLit l-pprType _ (PromotedT c)          = text "'" <> pprName' Applied c-pprType _ (PromotedTupleT 0)     = text "'()"-pprType p (PromotedTupleT 1)     = pprType p (PromotedT (tupleDataName 1))-pprType _ (PromotedTupleT n)     = quoteParens (hcat (replicate (n-1) comma))-pprType _ PromotedNilT           = text "'[]"-pprType _ PromotedConsT          = text "'(:)"-pprType _ StarT                  = char '*'-pprType _ ConstraintT            = text "Constraint"-pprType _ (SigT ty k)            = parens (ppr ty <+> text "::" <+> ppr k)-pprType _ WildCardT              = char '_'-pprType p t@(InfixT {})          = pprInfixT p t-pprType p t@(UInfixT {})         = pprInfixT p t-pprType p t@(PromotedInfixT {})  = pprInfixT p t-pprType p t@(PromotedUInfixT {}) = pprInfixT p t-pprType _ (ParensT t)            = parens (pprType noPrec t)-pprType p (ImplicitParamT n ty) =-  parensIf (p >= sigPrec) $ text ('?':n) <+> text "::" <+> pprType sigPrec ty-pprType _ EqualityT              = text "(~)"-pprType p (ForallT tvars ctxt ty) =-  parensIf (p >= funPrec) $ sep [pprForall tvars ctxt, pprType qualPrec ty]-pprType p (ForallVisT tvars ty) =-  parensIf (p >= funPrec) $ sep [pprForallVis tvars [], pprType qualPrec ty]-pprType p t@AppT{}               = pprTyApp p (split t)-pprType p t@AppKindT{}           = pprTyApp p (split t)---------------------------------pprParendType :: Type -> Doc-pprParendType = pprType appPrec--pprInfixT :: Precedence -> Type -> Doc-pprInfixT p = \case-  InfixT x n y          -> with x n y ""  opPrec-  UInfixT x n y         -> with x n y ""  unopPrec-  PromotedInfixT x n y  -> with x n y "'" opPrec-  PromotedUInfixT x n y -> with x n y "'" unopPrec-  t                     -> pprParendType t-  where-    with x n y prefix p' =-      parensIf-        (p >= p')-        (pprType opPrec x <+> text prefix <> pprName' Infix n <+> pprType opPrec y)--instance Ppr Type where-    ppr = pprType noPrec-instance Ppr TypeArg where-    ppr (TANormal ty) = ppr ty-    ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki)--pprParendTypeArg :: TypeArg -> Doc-pprParendTypeArg (TANormal ty) = pprParendType ty-pprParendTypeArg (TyArg ki) = char '@' <> parensIf (isStarT ki) (pprParendType ki)--isStarT :: Type -> Bool-isStarT StarT = True-isStarT _ = False--{- Note [Pretty-printing kind signatures]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-GHC's parser only recognises a kind signature in a type when there are-parens around it.  E.g. the parens are required here:-   f :: (Int :: *)-   type instance F Int = (Bool :: *)-So we always print a SigT with parens (see #10050). -}--pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc-pprTyApp p app@(MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2])-  | p >= funPrec  = parens (pprTyApp noPrec app)-  | c == oneName  = sep [pprFunArgType arg1 <+> text "%1 ->", pprType qualPrec arg2]-  | c == manyName = sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2]-pprTyApp p (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) =-  parensIf (p >= funPrec) $-    sep [pprFunArgType arg1 <+> text "%" <> pprType appPrec argm <+> text "->",-         pprType qualPrec arg2]-pprTyApp p (ArrowT, [TANormal arg1, TANormal arg2]) =-  parensIf (p >= funPrec) $-    sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2]-pprTyApp p (EqualityT, [TANormal arg1, TANormal arg2]) =-  parensIf (p >= opPrec) $-    sep [pprType opPrec arg1 <+> text "~", pprType opPrec arg2]-pprTyApp _ (ListT, [TANormal arg]) = brackets (pprType noPrec arg)-pprTyApp p (TupleT 1, args) = pprTyApp p (ConT (tupleTypeName 1), args)-pprTyApp _ (TupleT n, args)- | length args == n, Just args' <- traverse fromTANormal args- = parens (commaSep args')-pprTyApp p (PromotedTupleT 1, args) = pprTyApp p (PromotedT (tupleDataName 1), args)-pprTyApp _ (PromotedTupleT n, args)- | length args == n, Just args' <- traverse fromTANormal args- = quoteParens (commaSep args')-pprTyApp p (fun, args) =-  parensIf (p >= appPrec) $ pprParendType fun <+> sep (map pprParendTypeArg args)--fromTANormal :: TypeArg -> Maybe Type-fromTANormal (TANormal arg) = Just arg-fromTANormal (TyArg _) = Nothing---- Print the type to the left of @->@. Everything except forall and (->) binds more tightly than (->).-pprFunArgType :: Type -> Doc-pprFunArgType = pprType funPrec--data ForallVisFlag = ForallVis   -- forall a -> {...}-                   | ForallInvis -- forall a.   {...}-  deriving Show--data TypeArg = TANormal Type-             | TyArg Kind--split :: Type -> (Type, [TypeArg])    -- Split into function and args-split t = go t []-    where go (AppT t1 t2) args = go t1 (TANormal t2:args)-          go (AppKindT ty ki) args = go ty (TyArg ki:args)-          go ty           args = (ty, args)--pprTyLit :: TyLit -> Doc-pprTyLit (NumTyLit n) = integer n-pprTyLit (StrTyLit s) = text (show s)-pprTyLit (CharTyLit c) = text (show c)--instance Ppr TyLit where-  ppr = pprTyLit---------------------------------class PprFlag flag where-    pprTyVarBndr :: (TyVarBndr flag) -> Doc--instance PprFlag () where-    pprTyVarBndr (PlainTV nm ())    = ppr nm-    pprTyVarBndr (KindedTV nm () k) = parens (ppr nm <+> dcolon <+> ppr k)--instance PprFlag Specificity where-    pprTyVarBndr (PlainTV nm SpecifiedSpec)    = ppr nm-    pprTyVarBndr (PlainTV nm InferredSpec)     = braces (ppr nm)-    pprTyVarBndr (KindedTV nm SpecifiedSpec k) = parens (ppr nm <+> dcolon <+> ppr k)-    pprTyVarBndr (KindedTV nm InferredSpec  k) = braces (ppr nm <+> dcolon <+> ppr k)--instance PprFlag BndrVis where-    pprTyVarBndr (PlainTV nm vis)    = pprBndrVis vis (ppr nm)-    pprTyVarBndr (KindedTV nm vis k) = pprBndrVis vis (parens (ppr nm <+> dcolon <+> ppr k))--pprBndrVis :: BndrVis -> Doc -> Doc-pprBndrVis BndrReq   d = d-pprBndrVis BndrInvis d = char '@' <> d--instance PprFlag flag => Ppr (TyVarBndr flag) where-    ppr bndr = pprTyVarBndr bndr--instance Ppr Role where-    ppr NominalR          = text "nominal"-    ppr RepresentationalR = text "representational"-    ppr PhantomR          = text "phantom"-    ppr InferR            = text "_"---------------------------------pprCxt :: Cxt -> Doc-pprCxt [] = empty-pprCxt ts = ppr_cxt_preds funPrec ts <+> text "=>"--ppr_cxt_preds :: Precedence -> Cxt -> Doc-ppr_cxt_preds _ [] = text "()"-ppr_cxt_preds p [t] = pprType p t-ppr_cxt_preds _ ts = parens (commaSep ts)---------------------------------instance Ppr Range where-    ppr = brackets . pprRange-        where pprRange :: Range -> Doc-              pprRange (FromR e) = ppr e <+> text ".."-              pprRange (FromThenR e1 e2) = ppr e1 <> text ","-                                           <+> ppr e2 <+> text ".."-              pprRange (FromToR e1 e2) = ppr e1 <+> text ".." <+> ppr e2-              pprRange (FromThenToR e1 e2 e3) = ppr e1 <> text ","-                                             <+> ppr e2 <+> text ".."-                                             <+> ppr e3---------------------------------where_clause :: [Dec] -> Doc-where_clause [] = empty-where_clause ds = nest nestDepth $ text "where" <+> braces (semiSepWith (ppr_dec False) ds)--showtextl :: Show a => a -> Doc-showtextl = text . map toLower . show--hashParens :: Doc -> Doc-hashParens d = text "(# " <> d <> text " #)"--quoteParens :: Doc -> Doc-quoteParens d = text "'(" <> d <> text ")"--------------------------------instance Ppr Loc where-  ppr (Loc { loc_module = md-           , loc_package = pkg-           , loc_start = (start_ln, start_col)-           , loc_end = (end_ln, end_col) })-    = hcat [ text pkg, colon, text md, colon-           , parens $ int start_ln <> comma <> int start_col-           , text "-"-           , parens $ int end_ln <> comma <> int end_col ]---- Takes a separator and a pretty-printing function and prints a list of things--- separated by the separator followed by space.-sepWith :: Doc -> (a -> Doc) -> [a] -> Doc-sepWith sepDoc pprFun = sep . punctuate sepDoc . map pprFun---- Takes a list of printable things and prints them separated by commas followed--- by space.-commaSep :: Ppr a => [a] -> Doc-commaSep = commaSepWith ppr---- Takes a list of things and prints them with the given pretty-printing--- function, separated by commas followed by space.-commaSepWith :: (a -> Doc) -> [a] -> Doc-commaSepWith pprFun = sepWith comma pprFun---- Takes a list of printable things and prints them separated by semicolons--- followed by space.-semiSep :: Ppr a => [a] -> Doc-semiSep = sep . punctuate semi . map ppr---- Takes a list of things and prints them with the given pretty-printing--- function, separated by semicolons followed by space.-semiSepWith :: (a -> Doc) -> [a] -> Doc-semiSepWith pprFun = sepWith semi pprFun---- Prints out the series of vertical bars that wraps an expression or pattern--- used in an unboxed sum.-unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc-unboxedSumBars d alt arity = hashParens $-    bars (alt-1) <> d <> bars (arity - alt)-  where-    bars i = hsep (replicate i bar)---- Text containing the vertical bar character.-bar :: Doc-bar = char '|'
− libraries/template-haskell/Language/Haskell/TH/PprLib.hs 
@@ -1,226 +0,0 @@-{-# LANGUAGE FlexibleInstances, Safe #-}---- | Monadic front-end to Text.PrettyPrint--module Language.Haskell.TH.PprLib (--        -- * The document type-        Doc,            -- Abstract, instance of Show-        PprM,--        -- * Primitive Documents-        empty,-        semi, comma, colon, dcolon, space, equals, arrow,-        lparen, rparen, lbrack, rbrack, lbrace, rbrace,--        -- * Converting values into documents-        text, char, ptext,-        int, integer, float, double, rational,--        -- * Wrapping documents in delimiters-        parens, brackets, braces, quotes, doubleQuotes,--        -- * Combining documents-        (<>), (<+>), hcat, hsep,-        ($$), ($+$), vcat,-        sep, cat,-        fsep, fcat,-        nest,-        hang, punctuate,--        -- * Predicates on documents-        isEmpty,--    to_HPJ_Doc, pprName, pprName'-  ) where---import Language.Haskell.TH.Syntax-    (Uniq, Name(..), showName', NameFlavour(..), NameIs(..))-import qualified Text.PrettyPrint as HPJ-import Control.Monad (liftM, liftM2, ap)-import Language.Haskell.TH.Lib.Map ( Map )-import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )-import Prelude hiding ((<>))--infixl 6 <>-infixl 6 <+>-infixl 5 $$, $+$---- ------------------------------------------------------------------------------ The interface---- The primitive Doc values--instance Show Doc where-   show d = HPJ.render (to_HPJ_Doc d)--isEmpty :: Doc    -> PprM Bool;  -- ^ Returns 'True' if the document is empty--empty   :: Doc;                 -- ^ An empty document-semi    :: Doc;                 -- ^ A ';' character-comma   :: Doc;                 -- ^ A ',' character-colon   :: Doc;                 -- ^ A ':' character-dcolon  :: Doc;                 -- ^ A "::" string-space   :: Doc;                 -- ^ A space character-equals  :: Doc;                 -- ^ A '=' character-arrow   :: Doc;                 -- ^ A "->" string-lparen  :: Doc;                 -- ^ A '(' character-rparen  :: Doc;                 -- ^ A ')' character-lbrack  :: Doc;                 -- ^ A '[' character-rbrack  :: Doc;                 -- ^ A ']' character-lbrace  :: Doc;                 -- ^ A '{' character-rbrace  :: Doc;                 -- ^ A '}' character--text     :: String   -> Doc-ptext    :: String   -> Doc-char     :: Char     -> Doc-int      :: Int      -> Doc-integer  :: Integer  -> Doc-float    :: Float    -> Doc-double   :: Double   -> Doc-rational :: Rational -> Doc---parens       :: Doc -> Doc;     -- ^ Wrap document in @(...)@-brackets     :: Doc -> Doc;     -- ^ Wrap document in @[...]@-braces       :: Doc -> Doc;     -- ^ Wrap document in @{...}@-quotes       :: Doc -> Doc;     -- ^ Wrap document in @\'...\'@-doubleQuotes :: Doc -> Doc;     -- ^ Wrap document in @\"...\"@---- Combining @Doc@ values--(<>)   :: Doc -> Doc -> Doc;     -- ^Beside-hcat   :: [Doc] -> Doc;          -- ^List version of '<>'-(<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space-hsep   :: [Doc] -> Doc;          -- ^List version of '<+>'--($$)   :: Doc -> Doc -> Doc;     -- ^Above; if there is no-                                 -- overlap it \"dovetails\" the two-($+$)  :: Doc -> Doc -> Doc;     -- ^Above, without dovetailing.-vcat   :: [Doc] -> Doc;          -- ^List version of '$$'--cat    :: [Doc] -> Doc;          -- ^ Either hcat or vcat-sep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat-fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of cat-fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of sep--nest   :: Int -> Doc -> Doc;     -- ^ Nested----- GHC-specific ones.--hang :: Doc -> Int -> Doc -> Doc;      -- ^ @hang d1 n d2 = sep [d1, nest n d2]@-punctuate :: Doc -> [Doc] -> [Doc]-   -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@---- ------------------------------------------------------------------------------ The "implementation"--type State = (Map Name Name, Uniq)-data PprM a = PprM { runPprM :: State -> (a, State) }--pprName :: Name -> Doc-pprName = pprName' Alone--pprName' :: NameIs -> Name -> Doc-pprName' ni n@(Name o (NameU _))- = PprM $ \s@(fm, i)-        -> let (n', s') = case Map.lookup n fm of-                         Just d -> (d, s)-                         Nothing -> let n'' = Name o (NameU i)-                                    in (n'', (Map.insert n n'' fm, i + 1))-           in (HPJ.text $ showName' ni n', s')-pprName' ni n = text $ showName' ni n--{--instance Show Name where-  show (Name occ (NameU u))    = occString occ ++ "_" ++ show (I# u)-  show (Name occ NameS)        = occString occ-  show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ--data Name = Name OccName NameFlavour--data NameFlavour-  | NameU Int#                  -- A unique local name--}--to_HPJ_Doc :: Doc -> HPJ.Doc-to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)--instance Functor PprM where-      fmap = liftM--instance Applicative PprM where-      pure x = PprM $ \s -> (x, s)-      (<*>) = ap--instance Monad PprM where-    m >>= k  = PprM $ \s -> let (x, s') = runPprM m s-                            in runPprM (k x) s'--type Doc = PprM HPJ.Doc---- The primitive Doc values--isEmpty = liftM HPJ.isEmpty--empty = return HPJ.empty-semi = return HPJ.semi-comma = return HPJ.comma-colon = return HPJ.colon-dcolon = return $ HPJ.text "::"-space = return HPJ.space-equals = return HPJ.equals-arrow = return $ HPJ.text "->"-lparen = return HPJ.lparen-rparen = return HPJ.rparen-lbrack = return HPJ.lbrack-rbrack = return HPJ.rbrack-lbrace = return HPJ.lbrace-rbrace = return HPJ.rbrace--text = return . HPJ.text-ptext = return . HPJ.ptext-char = return . HPJ.char-int = return . HPJ.int-integer = return . HPJ.integer-float = return . HPJ.float-double = return . HPJ.double-rational = return . HPJ.rational---parens = liftM HPJ.parens-brackets = liftM HPJ.brackets-braces = liftM HPJ.braces-quotes = liftM HPJ.quotes-doubleQuotes = liftM HPJ.doubleQuotes---- Combining @Doc@ values--(<>) = liftM2 (HPJ.<>)-hcat = liftM HPJ.hcat . sequence-(<+>) = liftM2 (HPJ.<+>)-hsep = liftM HPJ.hsep . sequence--($$) = liftM2 (HPJ.$$)-($+$) = liftM2 (HPJ.$+$)-vcat = liftM HPJ.vcat . sequence--cat  = liftM HPJ.cat . sequence-sep  = liftM HPJ.sep . sequence-fcat = liftM HPJ.fcat . sequence-fsep = liftM HPJ.fsep . sequence--nest n = liftM (HPJ.nest n)--hang d1 n d2 = do d1' <- d1-                  d2' <- d2-                  return (HPJ.hang d1' n d2')---- punctuate uses the same definition as Text.PrettyPrint-punctuate _ []     = []-punctuate p (d:ds) = go d ds-                   where-                     go d' [] = [d']-                     go d' (e:es) = (d' <> p) : go e es
− libraries/template-haskell/Language/Haskell/TH/Syntax.hs 
@@ -1,3007 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable,-             DeriveGeneric, FlexibleInstances, DefaultSignatures,-             RankNTypes, RoleAnnotations, ScopedTypeVariables,-             MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,-             GADTs, UnboxedTuples, UnboxedSums, TypeOperators,-             Trustworthy, DeriveFunctor, DeriveTraversable,-             BangPatterns, RecordWildCards, ImplicitParams #-}--{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}--{-# LANGUAGE StandaloneKindSignatures #-}---------------------------------------------------------------------------------- |--- Module      :  Language.Haskell.Syntax--- Copyright   :  (c) The University of Glasgow 2003--- License     :  BSD-style (see the file libraries/base/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ Abstract syntax definitions for Template Haskell.-----------------------------------------------------------------------------------module Language.Haskell.TH.Syntax-    ( module Language.Haskell.TH.Syntax-      -- * Language extensions-    , module Language.Haskell.TH.LanguageExtensions-    , ForeignSrcLang(..)-    -- * Notes-    -- ** Unresolved Infix-    -- $infix-    ) where--import qualified Data.Fixed as Fixed-import Data.Data hiding (Fixity(..))-import Data.IORef-import System.IO.Unsafe ( unsafePerformIO )-import System.FilePath-import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )-import Control.Monad (liftM)-import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Fix (MonadFix (..))-import Control.Applicative (Applicative(..))-import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)-import Control.Exception.Base (FixIOException (..))-import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)-import System.IO        ( hPutStrLn, stderr )-import Data.Char        ( isAlpha, isAlphaNum, isUpper, ord )-import Data.Int-import Data.List.NonEmpty ( NonEmpty(..) )-import Data.Void        ( Void, absurd )-import Data.Word-import Data.Ratio-import GHC.CString      ( unpackCString# )-import GHC.Generics     ( Generic )-import GHC.Types        ( Int(..), Word(..), Char(..), Double(..), Float(..),-                          TYPE, RuntimeRep(..), Levity(..), Multiplicity (..) )-import qualified Data.Kind as Kind (Type)-import GHC.Prim         ( Int#, Word#, Char#, Double#, Float#, Addr# )-import GHC.Ptr          ( Ptr, plusPtr )-import GHC.Lexeme       ( startsVarSym, startsVarId )-import GHC.ForeignSrcLang.Type-import Language.Haskell.TH.LanguageExtensions-import Numeric.Natural-import Prelude hiding (Applicative(..))-import Foreign.ForeignPtr-import Foreign.C.String-import Foreign.C.Types-import GHC.Stack---import Data.Array.Byte (ByteArray(..))-import GHC.Exts-  ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray#-  , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents#-  , copyByteArray#, newPinnedByteArray#)-import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))-import GHC.ST (ST(..), runST)-------------------------------------------------------------              The Quasi class-----------------------------------------------------------class (MonadIO m, MonadFail m) => Quasi m where-  qNewName :: String -> m Name-        -- ^ Fresh names--        -- Error reporting and recovery-  qReport  :: Bool -> String -> m ()    -- ^ Report an error (True) or warning (False)-                                        -- ...but carry on; use 'fail' to stop-  qRecover :: m a -- ^ the error handler-           -> m a -- ^ action which may fail-           -> m a               -- ^ Recover from the monadic 'fail'--        -- Inspect the type-checker's environment-  qLookupName :: Bool -> String -> m (Maybe Name)-       -- True <=> type namespace, False <=> value namespace-  qReify          :: Name -> m Info-  qReifyFixity    :: Name -> m (Maybe Fixity)-  qReifyType      :: Name -> m Type-  qReifyInstances :: Name -> [Type] -> m [Dec]-       -- Is (n tys) an instance?-       -- Returns list of matching instance Decs-       --    (with empty sub-Decs)-       -- Works for classes and type functions-  qReifyRoles         :: Name -> m [Role]-  qReifyAnnotations   :: Data a => AnnLookup -> m [a]-  qReifyModule        :: Module -> m ModuleInfo-  qReifyConStrictness :: Name -> m [DecidedStrictness]--  qLocation :: m Loc--  qRunIO :: IO a -> m a-  qRunIO = liftIO-  -- ^ Input/output (dangerous)-  qGetPackageRoot :: m FilePath--  qAddDependentFile :: FilePath -> m ()--  qAddTempFile :: String -> m FilePath--  qAddTopDecls :: [Dec] -> m ()--  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()--  qAddModFinalizer :: Q () -> m ()--  qAddCorePlugin :: String -> m ()--  qGetQ :: Typeable a => m (Maybe a)--  qPutQ :: Typeable a => a -> m ()--  qIsExtEnabled :: Extension -> m Bool-  qExtsEnabled :: m [Extension]--  qPutDoc :: DocLoc -> String -> m ()-  qGetDoc :: DocLoc -> m (Maybe String)----------------------------------------------------------      The IO instance of Quasi------  This instance is used only when running a Q---  computation in the IO monad, usually just to---  print the result.  There is no interesting---  type environment, so reification isn't going to---  work.-----------------------------------------------------------instance Quasi IO where-  qNewName = newNameIO--  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)-  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)--  qLookupName _ _       = badIO "lookupName"-  qReify _              = badIO "reify"-  qReifyFixity _        = badIO "reifyFixity"-  qReifyType _          = badIO "reifyFixity"-  qReifyInstances _ _   = badIO "reifyInstances"-  qReifyRoles _         = badIO "reifyRoles"-  qReifyAnnotations _   = badIO "reifyAnnotations"-  qReifyModule _        = badIO "reifyModule"-  qReifyConStrictness _ = badIO "reifyConStrictness"-  qLocation             = badIO "currentLocation"-  qRecover _ _          = badIO "recover" -- Maybe we could fix this?-  qGetPackageRoot       = badIO "getProjectRoot"-  qAddDependentFile _   = badIO "addDependentFile"-  qAddTempFile _        = badIO "addTempFile"-  qAddTopDecls _        = badIO "addTopDecls"-  qAddForeignFilePath _ _ = badIO "addForeignFilePath"-  qAddModFinalizer _    = badIO "addModFinalizer"-  qAddCorePlugin _      = badIO "addCorePlugin"-  qGetQ                 = badIO "getQ"-  qPutQ _               = badIO "putQ"-  qIsExtEnabled _       = badIO "isExtEnabled"-  qExtsEnabled          = badIO "extsEnabled"-  qPutDoc _ _           = badIO "putDoc"-  qGetDoc _             = badIO "getDoc"--instance Quote IO where-  newName = newNameIO--newNameIO :: String -> IO Name-newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))-                 ; pure (mkNameU s n) }--badIO :: String -> IO a-badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")-                ; fail "Template Haskell failure" }---- Global variable to generate unique symbols-counter :: IORef Uniq-{-# NOINLINE counter #-}-counter = unsafePerformIO (newIORef 0)--------------------------------------------------------------              The Q monad-----------------------------------------------------------newtype Q a = Q { unQ :: forall m. Quasi m => m a }---- \"Runs\" the 'Q' monad. Normal users of Template Haskell--- should not need this function, as the splice brackets @$( ... )@--- are the usual way of running a 'Q' computation.------ This function is primarily used in GHC internals, and for debugging--- splices by running them in 'IO'.------ Note that many functions in 'Q', such as 'reify' and other compiler--- queries, are not supported when running 'Q' in 'IO'; these operations--- simply fail at runtime. Indeed, the only operations guaranteed to succeed--- are 'newName', 'runIO', 'reportError' and 'reportWarning'.-runQ :: Quasi m => Q a -> m a-runQ (Q m) = m--instance Monad Q where-  Q m >>= k  = Q (m >>= \x -> unQ (k x))-  (>>) = (*>)--instance MonadFail Q where-  fail s     = report True s >> Q (fail "Q monad failure")--instance Functor Q where-  fmap f (Q x) = Q (fmap f x)--instance Applicative Q where-  pure x = Q (pure x)-  Q f <*> Q x = Q (f <*> x)-  Q m *> Q n = Q (m *> n)---- | @since 2.17.0.0-instance Semigroup a => Semigroup (Q a) where-  (<>) = liftA2 (<>)---- | @since 2.17.0.0-instance Monoid a => Monoid (Q a) where-  mempty = pure mempty---- | If the function passed to 'mfix' inspects its argument,--- the resulting action will throw a 'FixIOException'.------ @since 2.17.0.0-instance MonadFix Q where-  -- We use the same blackholing approach as in fixIO.-  -- See Note [Blackholing in fixIO] in System.IO in base.-  mfix k = do-    m <- runIO newEmptyMVar-    ans <- runIO (unsafeDupableInterleaveIO-             (readMVar m `catch` \BlockedIndefinitelyOnMVar ->-                                    throwIO FixIOException))-    result <- k ans-    runIO (putMVar m result)-    return result--------------------------------------------------------------              The Quote class--------------------------------------------------------------- | The 'Quote' class implements the minimal interface which is necessary for--- desugaring quotations.------ * The @Monad m@ superclass is needed to stitch together the different--- AST fragments.--- * 'newName' is used when desugaring binding structures such as lambdas--- to generate fresh names.------ Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`------ For many years the type of a quotation was fixed to be `Q Exp` but by--- more precisely specifying the minimal interface it enables the `Exp` to--- be extracted purely from the quotation without interacting with `Q`.-class Monad m => Quote m where-  {- |-  Generate a fresh name, which cannot be captured.--  For example, this:--  @f = $(do-    nm1 <- newName \"x\"-    let nm2 = 'mkName' \"x\"-    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))-   )@--  will produce the splice--  >f = \x0 -> \x -> x0--  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,-  and is not captured by the binding @VarP nm2@.--  Although names generated by @newName@ cannot /be captured/, they can-  /capture/ other names. For example, this:--  >g = $(do-  >  nm1 <- newName "x"-  >  let nm2 = mkName "x"-  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))-  > )--  will produce the splice--  >g = \x -> \x0 -> x0--  since the occurrence @VarE nm2@ is captured by the innermost binding-  of @x@, namely @VarP nm1@.-  -}-  newName :: String -> m Name--instance Quote Q where-  newName s = Q (qNewName s)-------------------------------------------------------------              The TExp type-----------------------------------------------------------type TExp :: TYPE r -> Kind.Type-type role TExp nominal   -- See Note [Role of TExp]-newtype TExp a = TExp-  { unType :: Exp -- ^ Underlying untyped Template Haskell expression-  }--- ^ Typed wrapper around an 'Exp'.------ This is the typed representation of terms produced by typed quotes.------ Representation-polymorphic since /template-haskell-2.16.0.0/.---- | Discard the type annotation and produce a plain Template Haskell--- expression------ Representation-polymorphic since /template-haskell-2.16.0.0/.-unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp-unTypeQ m = do { TExp e <- m-               ; return e }---- | Annotate the Template Haskell expression with a type------ This is unsafe because GHC cannot check for you that the expression--- really does have the type you claim it has.------ Representation-polymorphic since /template-haskell-2.16.0.0/.-unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .-                      Quote m => m Exp -> m (TExp a)-unsafeTExpCoerce m = do { e <- m-                        ; return (TExp e) }--{- Note [Role of TExp]-~~~~~~~~~~~~~~~~~~~~~~-TExp's argument must have a nominal role, not phantom as would-be inferred (#8459).  Consider--  e :: Code Q Age-  e = [|| MkAge 3 ||]--  foo = $(coerce e) + 4::Int--The splice will evaluate to (MkAge 3) and you can't add that to-4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}---- Code constructor-#if __GLASGOW_HASKELL__ >= 909-type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type-  -- See Note [Foralls to the right in Code]-#else-type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type-#endif-type role Code representational nominal   -- See Note [Role of TExp]-newtype Code m a = Code-  { examineCode :: m (TExp a) -- ^ Underlying monadic value-  }--- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed--- expressions allow for type-safe splicing via:------   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if---     that expression has type @a@, then the quotation has type---     @Quote m => Code m a@------   - typed splices inside of typed quotes, written as @$$(...)@ where @...@---     is an arbitrary expression of type @Quote m => Code m a@------ Traditional expression quotes and splices let us construct ill-typed--- expressions:------ >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])--- GHC.Types.True GHC.Classes.== "foo"--- >>> GHC.Types.True GHC.Classes.== "foo"--- <interactive> error:---     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’---     • In the second argument of ‘(==)’, namely ‘"foo"’---       In the expression: True == "foo"---       In an equation for ‘it’: it = True == "foo"------ With typed expressions, the type error occurs when /constructing/ the--- Template Haskell expression:------ >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])--- <interactive> error:---     • Couldn't match type ‘[Char]’ with ‘Bool’---       Expected type: Code Q Bool---         Actual type: Code Q [Char]---     • In the Template Haskell quotation [|| "foo" ||]---       In the expression: [|| "foo" ||]---       In the Template Haskell splice $$([|| "foo" ||])---{- Note [Foralls to the right in Code]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Code has the following type signature:-   type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type--This allows us to write-   data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)--   tcodeq :: T (Code Q)-   tcodeq = MkT [||5||] [||5#||]--If we used the slightly more straightforward signature-   type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type--then the example above would become ill-typed.  (See #23592 for some discussion.)--}---- | Unsafely convert an untyped code representation into a typed code--- representation.-unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .-                      Quote m => m Exp -> Code m a-unsafeCodeCoerce m = Code (unsafeTExpCoerce m)---- | Lift a monadic action producing code into the typed 'Code'--- representation-liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a-liftCode = Code---- | Extract the untyped representation from the typed representation-unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m-           => Code m a -> m Exp-unTypeCode = unTypeQ . examineCode---- | Modify the ambient monad used during code generation. For example, you--- can use `hoistCode` to handle a state effect:--- @---  handleState :: Code (StateT Int Q) a -> Code Q a---  handleState = hoistCode (flip runState 0)--- @-hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m-          => (forall x . m x -> n x) -> Code m a -> Code n a-hoistCode f (Code a) = Code (f a)----- | Variant of (>>=) which allows effectful computations to be injected--- into code generation.-bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m-         => m a -> (a -> Code m b) -> Code m b-bindCode q k = liftCode (q >>= examineCode . k)---- | Variant of (>>) which allows effectful computations to be injected--- into code generation.-bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m-          => m a -> Code m b -> Code m b-bindCode_ q c = liftCode ( q >> examineCode c)---- | A useful combinator for embedding monadic actions into 'Code'--- @--- myCode :: ... => Code m a--- myCode = joinCode $ do---   x <- someSideEffect---   return (makeCodeWith x)--- @-joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m-         => m (Code m a) -> Code m a-joinCode = flip bindCode id--------------------------------------------------------- Packaged versions for the programmer, hiding the Quasi-ness----- | Report an error (True) or warning (False),--- but carry on; use 'fail' to stop.-report  :: Bool -> String -> Q ()-report b s = Q (qReport b s)-{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6---- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.-reportError :: String -> Q ()-reportError = report True---- | Report a warning to the user, and carry on.-reportWarning :: String -> Q ()-reportWarning = report False---- | Recover from errors raised by 'reportError' or 'fail'.-recover :: Q a -- ^ handler to invoke on failure-        -> Q a -- ^ computation to run-        -> Q a-recover (Q r) (Q m) = Q (qRecover r m)---- We don't export lookupName; the Bool isn't a great API--- Instead we export lookupTypeName, lookupValueName-lookupName :: Bool -> String -> Q (Maybe Name)-lookupName ns s = Q (qLookupName ns s)---- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.-lookupTypeName :: String -> Q (Maybe Name)-lookupTypeName  s = Q (qLookupName True s)---- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.-lookupValueName :: String -> Q (Maybe Name)-lookupValueName s = Q (qLookupName False s)--{--Note [Name lookup]-~~~~~~~~~~~~~~~~~~--}-{- $namelookup #namelookup#-The functions 'lookupTypeName' and 'lookupValueName' provide-a way to query the current splice's context for what names-are in scope. The function 'lookupTypeName' queries the type-namespace, whereas 'lookupValueName' queries the value namespace,-but the functions are otherwise identical.--A call @lookupValueName s@ will check if there is a value-with name @s@ in scope at the current splice's location. If-there is, the @Name@ of this value is returned;-if not, then @Nothing@ is returned.--The returned name cannot be \"captured\".-For example:--> f = "global"-> g = $( do->          Just nm <- lookupValueName "f"->          [| let f = "local" in $( varE nm ) |]--In this case, @g = \"global\"@; the call to @lookupValueName@-returned the global @f@, and this name was /not/ captured by-the local definition of @f@.--The lookup is performed in the context of the /top-level/ splice-being run. For example:--> f = "global"-> g = $( [| let f = "local" in->            $(do->                Just nm <- lookupValueName "f"->                varE nm->             ) |] )--Again in this example, @g = \"global\"@, because the call to-@lookupValueName@ queries the context of the outer-most @$(...)@.--Operators should be queried without any surrounding parentheses, like so:--> lookupValueName "+"--Qualified names are also supported, like so:--> lookupValueName "Prelude.+"-> lookupValueName "Prelude.map"---}---{- | 'reify' looks up information about the 'Name'. It will fail with-a compile error if the 'Name' is not visible. A 'Name' is visible if it is-imported or defined in a prior top-level declaration group. See the-documentation for 'newDeclarationGroup' for more details.--It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'-to ensure that we are reifying from the right namespace. For instance, in this context:--> data D = D--which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)-To ensure we get information about @D@-the-value, use 'lookupValueName':--> do->   Just nm <- lookupValueName "D"->   reify nm--and to get information about @D@-the-type, use 'lookupTypeName'.--}-reify :: Name -> Q Info-reify v = Q (qReify v)--{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For-example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then-@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function-@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns-'Nothing', so you may assume @bar@ has 'defaultFixity'.--}-reifyFixity :: Name -> Q (Maybe Fixity)-reifyFixity nm = Q (qReifyFixity nm)--{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,-@reifyType 'not@   returns @Bool -> Bool@, and-@reifyType ''Bool@ returns @Type@.-This works even if there's no explicit signature and the type or kind is inferred.--}-reifyType :: Name -> Q Type-reifyType nm = Q (qReifyType nm)--{- | Template Haskell is capable of reifying information about types and-terms defined in previous declaration groups. Top-level declaration splices break up-declaration groups.--For an example, consider this  code block. We define a datatype @X@ and-then try to call 'reify' on the datatype.--@-module Check where--data X = X-    deriving Eq--$(do-    info <- reify ''X-    runIO $ print info- )-@--This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:--@-data X = X-    deriving Eq--$(pure [])--$(do-    info <- reify ''X-    runIO $ print info- )-@--We provide 'newDeclarationGroup' as a means of documenting this behavior-and providing a name for the pattern.--Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:--@-data X = X-    deriving Eq--newDeclarationGroup--$(do-    info <- reify ''X-    runIO $ print info- )-@---}-newDeclarationGroup :: Q [Dec]-newDeclarationGroup = pure []--{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")-of @nm tys@. That is,-if @nm@ is the name of a type class, then all instances of this class at the types @tys@-are returned. Alternatively, if @nm@ is the name of a data family or type family,-all instances of this family at the types @tys@ are returned.--Note that this is a \"shallow\" test; the declarations returned merely have-instance heads which unify with @nm tys@, they need not actually be satisfiable.--  - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains-    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and-    @B@ themselves implement 'Eq'--  - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available-    instance of 'Show'--There is one edge case: @reifyInstances ''Typeable tys@ currently always-produces an empty list (no matter what @tys@ are given).--In principle, the *visible* instances are-* all instances defined in a prior top-level declaration group-  (see docs on @newDeclarationGroup@), or-* all instances defined in any module transitively imported by the-  module being compiled--However, actually searching all modules transitively below the one being-compiled is unreasonably expensive, so @reifyInstances@ will report only the-instance for modules that GHC has had some cause to visit during this-compilation.  This is a shortcoming: @reifyInstances@ might fail to report-instances for a type that is otherwise unusued, or instances defined in a-different component.  You can work around this shortcoming by explicitly importing the modules-whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>-has some discussion around this.---}-reifyInstances :: Name -> [Type] -> Q [InstanceDec]-reifyInstances cls tys = Q (qReifyInstances cls tys)--{- | @reifyRoles nm@ returns the list of roles associated with the parameters-(both visible and invisible) of-the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.-The returned list should never contain 'InferR'.--An invisible parameter to a tycon is often a kind parameter. For example, if-we have--@-type Proxy :: forall k. k -> Type-data Proxy a = MkProxy-@--and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is-the role of the invisible @k@ parameter. Kind parameters are always nominal.--}-reifyRoles :: Name -> Q [Role]-reifyRoles nm = Q (qReifyRoles nm)---- | @reifyAnnotations target@ returns the list of annotations--- associated with @target@.  Only the annotations that are--- appropriately typed is returned.  So if you have @Int@ and @String@--- annotations for the same target, you have to call this function twice.-reifyAnnotations :: Data a => AnnLookup -> Q [a]-reifyAnnotations an = Q (qReifyAnnotations an)---- | @reifyModule mod@ looks up information about module @mod@.  To--- look up the current module, call this function with the return--- value of 'Language.Haskell.TH.Lib.thisModule'.-reifyModule :: Module -> Q ModuleInfo-reifyModule m = Q (qReifyModule m)---- | @reifyConStrictness nm@ looks up the strictness information for the fields--- of the constructor with the name @nm@. Note that the strictness information--- that 'reifyConStrictness' returns may not correspond to what is written in--- the source code. For example, in the following data declaration:------ @--- data Pair a = Pair a a--- @------ 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most--- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the--- @-XStrictData@ language extension was enabled.-reifyConStrictness :: Name -> Q [DecidedStrictness]-reifyConStrictness n = Q (qReifyConStrictness n)---- | Is the list of instances returned by 'reifyInstances' nonempty?------ If you're confused by an instance not being visible despite being--- defined in the same module and above the splice in question, see the--- docs for 'newDeclarationGroup' for a possible explanation.-isInstance :: Name -> [Type] -> Q Bool-isInstance nm tys = do { decs <- reifyInstances nm tys-                       ; return (not (null decs)) }---- | The location at which this computation is spliced.-location :: Q Loc-location = Q qLocation---- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.--- Take care: you are guaranteed the ordering of calls to 'runIO' within--- a single 'Q' computation, but not about the order in which splices are run.------ Note: for various murky reasons, stdout and stderr handles are not--- necessarily flushed when the compiler finishes running, so you should--- flush them yourself.-runIO :: IO a -> Q a-runIO m = Q (qRunIO m)---- | Get the package root for the current package which is being compiled.--- This can be set explicitly with the -package-root flag but is normally--- just the current working directory.------ The motivation for this flag is to provide a principled means to remove the--- assumption from splices that they will be executed in the directory where the--- cabal file resides. Projects such as haskell-language-server can't and don't--- change directory when compiling files but instead set the -package-root flag--- appropriately.-getPackageRoot :: Q FilePath-getPackageRoot = Q qGetPackageRoot---- | The input is a filepath, which if relative is offset by the package root.-makeRelativeToProject :: FilePath -> Q FilePath-makeRelativeToProject fp | isRelative fp = do-  root <- getPackageRoot-  return (root </> fp)-makeRelativeToProject fp = return fp------ | Record external files that runIO is using (dependent upon).--- The compiler can then recognize that it should re-compile the Haskell file--- when an external file changes.------ Expects an absolute file path.------ Notes:------   * ghc -M does not know about these dependencies - it does not execute TH.------   * The dependency is based on file content, not a modification time-addDependentFile :: FilePath -> Q ()-addDependentFile fp = Q (qAddDependentFile fp)---- | Obtain a temporary file path with the given suffix. The compiler will--- delete this file after compilation.-addTempFile :: String -> Q FilePath-addTempFile suffix = Q (qAddTempFile suffix)---- | Add additional top-level declarations. The added declarations will be type--- checked along with the current declaration group.-addTopDecls :: [Dec] -> Q ()-addTopDecls ds = Q (qAddTopDecls ds)---- |-addForeignFile :: ForeignSrcLang -> String -> Q ()-addForeignFile = addForeignSource-{-# DEPRECATED addForeignFile-               "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"-  #-} -- deprecated in 8.6---- | Emit a foreign file which will be compiled and linked to the object for--- the current module. Currently only languages that can be compiled with--- the C compiler are supported, and the flags passed as part of -optc will--- be also applied to the C compiler invocation that will compile them.------ Note that for non-C languages (for example C++) @extern "C"@ directives--- must be used to get symbols that we can access from Haskell.------ To get better errors, it is recommended to use #line pragmas when--- emitting C files, e.g.------ > {-# LANGUAGE CPP #-}--- > ...--- > addForeignSource LangC $ unlines--- >   [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__--- >   , ...--- >   ]-addForeignSource :: ForeignSrcLang -> String -> Q ()-addForeignSource lang src = do-  let suffix = case lang of-                 LangC      -> "c"-                 LangCxx    -> "cpp"-                 LangObjc   -> "m"-                 LangObjcxx -> "mm"-                 LangAsm    -> "s"-                 LangJs     -> "js"-                 RawObject  -> "a"-  path <- addTempFile suffix-  runIO $ writeFile path src-  addForeignFilePath lang path---- | Same as 'addForeignSource', but expects to receive a path pointing to the--- foreign file instead of a 'String' of its contents. Consider using this in--- conjunction with 'addTempFile'.------ This is a good alternative to 'addForeignSource' when you are trying to--- directly link in an object file.-addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()-addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)---- | Add a finalizer that will run in the Q monad after the current module has--- been type checked. This only makes sense when run within a top-level splice.------ The finalizer is given the local type environment at the splice point. Thus--- 'reify' is able to find the local definitions when executed inside the--- finalizer.-addModFinalizer :: Q () -> Q ()-addModFinalizer act = Q (qAddModFinalizer (unQ act))---- | Adds a core plugin to the compilation pipeline.------ @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc--- in the command line. The major difference is that the plugin module @m@--- must not belong to the current package. When TH executes, it is too late--- to tell the compiler that we needed to compile first a plugin module in the--- current package.-addCorePlugin :: String -> Q ()-addCorePlugin plugin = Q (qAddCorePlugin plugin)---- | Get state from the 'Q' monad. Note that the state is local to the--- Haskell module in which the Template Haskell expression is executed.-getQ :: Typeable a => Q (Maybe a)-getQ = Q qGetQ---- | Replace the state in the 'Q' monad. Note that the state is local to the--- Haskell module in which the Template Haskell expression is executed.-putQ :: Typeable a => a -> Q ()-putQ x = Q (qPutQ x)---- | Determine whether the given language extension is enabled in the 'Q' monad.-isExtEnabled :: Extension -> Q Bool-isExtEnabled ext = Q (qIsExtEnabled ext)---- | List all enabled language extensions.-extsEnabled :: Q [Extension]-extsEnabled = Q qExtsEnabled---- | Add Haddock documentation to the specified location. This will overwrite--- any documentation at the location if it already exists. This will reify the--- specified name, so it must be in scope when you call it. If you want to add--- documentation to something that you are currently splicing, you can use--- 'addModFinalizer' e.g.------ > do--- >   let nm = mkName "x"--- >   addModFinalizer $ putDoc (DeclDoc nm) "Hello"--- >   [d| $(varP nm) = 42 |]------ The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as--- will the 'funD_doc' and other @_doc@ combinators.--- You most likely want to have the @-haddock@ flag turned on when using this.--- Adding documentation to anything outside of the current module will cause an--- error.-putDoc :: DocLoc -> String -> Q ()-putDoc t s = Q (qPutDoc t s)---- | Retrieves the Haddock documentation at the specified location, if one--- exists.--- It can be used to read documentation on things defined outside of the current--- module, provided that those modules were compiled with the @-haddock@ flag.-getDoc :: DocLoc -> Q (Maybe String)-getDoc n = Q (qGetDoc n)--instance MonadIO Q where-  liftIO = runIO--instance Quasi Q where-  qNewName            = newName-  qReport             = report-  qRecover            = recover-  qReify              = reify-  qReifyFixity        = reifyFixity-  qReifyType          = reifyType-  qReifyInstances     = reifyInstances-  qReifyRoles         = reifyRoles-  qReifyAnnotations   = reifyAnnotations-  qReifyModule        = reifyModule-  qReifyConStrictness = reifyConStrictness-  qLookupName         = lookupName-  qLocation           = location-  qGetPackageRoot     = getPackageRoot-  qAddDependentFile   = addDependentFile-  qAddTempFile        = addTempFile-  qAddTopDecls        = addTopDecls-  qAddForeignFilePath = addForeignFilePath-  qAddModFinalizer    = addModFinalizer-  qAddCorePlugin      = addCorePlugin-  qGetQ               = getQ-  qPutQ               = putQ-  qIsExtEnabled       = isExtEnabled-  qExtsEnabled        = extsEnabled-  qPutDoc             = putDoc-  qGetDoc             = getDoc---------------------------------------------------------- The following operations are used solely in GHC.HsToCore.Quote when--- desugaring brackets. They are not necessary for the user, who can use--- ordinary return and (>>=) etc--sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]-sequenceQ = sequence--------------------------------------------------------------              The Lift class------------------------------------------------------------- | A 'Lift' instance can have any of its values turned into a Template--- Haskell expression. This is needed when a value used within a Template--- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or--- @[|| ... ||]@) but not at the top level. As an example:------ > add1 :: Int -> Code Q Int--- > add1 x = [|| x + 1 ||]------ Template Haskell has no way of knowing what value @x@ will take on at--- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.------ A 'Lift' instance must satisfy @$(lift x) ≡ x@ and @$$(liftTyped x) ≡ x@--- for all @x@, where @$(...)@ and @$$(...)@ are Template Haskell splices.--- It is additionally expected that @'lift' x ≡ 'unTypeCode' ('liftTyped' x)@.------ 'Lift' instances can be derived automatically by use of the @-XDeriveLift@--- GHC language extension:------ > {-# LANGUAGE DeriveLift #-}--- > module Foo where--- >--- > import Language.Haskell.TH.Syntax--- >--- > data Bar a = Bar1 a (Bar a) | Bar2 String--- >   deriving Lift------ Representation-polymorphic since /template-haskell-2.16.0.0/.-class Lift (t :: TYPE r) where-  -- | Turn a value into a Template Haskell expression, suitable for use in-  -- a splice.-  lift :: Quote m => t -> m Exp-  default lift :: (r ~ ('BoxedRep 'Lifted), Quote m) => t -> m Exp-  lift = unTypeCode . liftTyped--  -- | Turn a value into a Template Haskell typed expression, suitable for use-  -- in a typed splice.-  ---  -- @since 2.16.0.0-  liftTyped :: Quote m => t -> Code m t----- If you add any instances here, consider updating test th/TH_Lift-instance Lift Integer where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL x))--instance Lift Int where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))---- | @since 2.16.0.0-instance Lift Int# where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntPrimL (fromIntegral (I# x))))--instance Lift Int8 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Int16 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Int32 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Int64 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))---- | @since 2.16.0.0-instance Lift Word# where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (WordPrimL (fromIntegral (W# x))))--instance Lift Word where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Word8 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Word16 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Word32 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Word64 where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift Natural where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (IntegerL (fromIntegral x)))--instance Lift (Fixed.Fixed a) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (Fixed.MkFixed x) = do-    ex <- lift x-    return (ConE mkFixedName `AppE` ex)-    where-      mkFixedName = mkNameG DataName "base" "Data.Fixed" "MkFixed"--instance Integral a => Lift (Ratio a) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (RationalL (toRational x)))--instance Lift Float where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (RationalL (toRational x)))---- | @since 2.16.0.0-instance Lift Float# where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (FloatPrimL (toRational (F# x))))--instance Lift Double where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (RationalL (toRational x)))---- | @since 2.16.0.0-instance Lift Double# where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (DoublePrimL (toRational (D# x))))--instance Lift Char where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (CharL x))---- | @since 2.16.0.0-instance Lift Char# where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x = return (LitE (CharPrimL (C# x)))--instance Lift Bool where-  liftTyped x = unsafeCodeCoerce (lift x)--  lift True  = return (ConE trueName)-  lift False = return (ConE falseName)---- | Produces an 'Addr#' literal from the NUL-terminated C-string starting at--- the given memory address.------ @since 2.16.0.0-instance Lift Addr# where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))---- |--- @since 2.19.0.0-instance Lift ByteArray where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (ByteArray b) = return-    (AppE (AppE (VarE addrToByteArrayName) (LitE (IntegerL (fromIntegral len))))-      (LitE (BytesPrimL (Bytes ptr 0 (fromIntegral len)))))-    where-      len# = sizeofByteArray# b-      len = I# len#-      pb :: ByteArray#-      !(ByteArray pb)-        | isTrue# (isByteArrayPinned# b) = ByteArray b-        | otherwise = runST $ ST $-          \s -> case newPinnedByteArray# len# s of-            (# s', mb #) -> case copyByteArray# b 0# mb 0# len# s' of-              s'' -> case unsafeFreezeByteArray# mb s'' of-                (# s''', ret #) -> (# s''', ByteArray ret #)-      ptr :: ForeignPtr Word8-      ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))--addrToByteArrayName :: Name-addrToByteArrayName = helper-  where-    helper :: HasCallStack => Name-    helper =-      case getCallStack ?callStack of-        [] -> error "addrToByteArrayName: empty call stack"-        (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"---addrToByteArray :: Int -> Addr# -> ByteArray-addrToByteArray (I# len) addr = runST $ ST $-  \s -> case newByteArray# len s of-    (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of-      s'' -> case unsafeFreezeByteArray# mb s'' of-        (# s''', ret #) -> (# s''', ByteArray ret #)--instance Lift a => Lift (Maybe a) where-  liftTyped x = unsafeCodeCoerce (lift x)--  lift Nothing  = return (ConE nothingName)-  lift (Just x) = liftM (ConE justName `AppE`) (lift x)--instance (Lift a, Lift b) => Lift (Either a b) where-  liftTyped x = unsafeCodeCoerce (lift x)--  lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)-  lift (Right y) = liftM (ConE rightName `AppE`) (lift y)--instance Lift a => Lift [a] where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }--liftString :: Quote m => String -> m Exp--- Used in GHC.Tc.Gen.Expr to short-circuit the lifting for strings-liftString s = return (LitE (StringL s))---- | @since 2.15.0.0-instance Lift a => Lift (NonEmpty a) where-  liftTyped x = unsafeCodeCoerce (lift x)--  lift (x :| xs) = do-    x' <- lift x-    xs' <- lift xs-    return (InfixE (Just x') (ConE nonemptyName) (Just xs'))---- | @since 2.15.0.0-instance Lift Void where-  liftTyped = liftCode . absurd-  lift = pure . absurd--instance Lift () where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift () = return (ConE (tupleDataName 0))--instance (Lift a, Lift b) => Lift (a, b) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (a, b)-    = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b]--instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (a, b, c)-    = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]--instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (a, b, c, d)-    = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d]--instance (Lift a, Lift b, Lift c, Lift d, Lift e)-      => Lift (a, b, c, d, e) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (a, b, c, d, e)-    = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b-                                              , lift c, lift d, lift e ]--instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)-      => Lift (a, b, c, d, e, f) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (a, b, c, d, e, f)-    = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c-                                              , lift d, lift e, lift f ]--instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)-      => Lift (a, b, c, d, e, f, g) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (a, b, c, d, e, f, g)-    = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c-                                              , lift d, lift e, lift f, lift g ]---- | @since 2.16.0.0-instance Lift (# #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# #) = return (ConE (unboxedTupleTypeName 0))---- | @since 2.16.0.0-instance (Lift a) => Lift (# a #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a]---- | @since 2.16.0.0-instance (Lift a, Lift b) => Lift (# a, b #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a, b #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b]---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c)-      => Lift (# a, b, c #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a, b, c #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d)-      => Lift (# a, b, c, d #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a, b, c, d #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b-                                                     , lift c, lift d ]---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d, Lift e)-      => Lift (# a, b, c, d, e #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a, b, c, d, e #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b-                                                     , lift c, lift d, lift e ]---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)-      => Lift (# a, b, c, d, e, f #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a, b, c, d, e, f #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c-                                                     , lift d, lift e, lift f ]---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)-      => Lift (# a, b, c, d, e, f, g #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift (# a, b, c, d, e, f, g #)-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c-                                                     , lift d, lift e, lift f-                                                     , lift g ]---- | @since 2.16.0.0-instance (Lift a, Lift b) => Lift (# a | b #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = case x of-        (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2-        (# | y #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 2---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c)-      => Lift (# a | b | c #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = case x of-        (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3-        (# | y | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 3-        (# | | y #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 3---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d)-      => Lift (# a | b | c | d #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = case x of-        (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4-        (# | y | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 4-        (# | | y | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 4-        (# | | | y #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 4---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d, Lift e)-      => Lift (# a | b | c | d | e #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = case x of-        (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5-        (# | y | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 5-        (# | | y | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 5-        (# | | | y | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 5-        (# | | | | y #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 5---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)-      => Lift (# a | b | c | d | e | f #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = case x of-        (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6-        (# | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 6-        (# | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 6-        (# | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 6-        (# | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 6-        (# | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 6---- | @since 2.16.0.0-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)-      => Lift (# a | b | c | d | e | f | g #) where-  liftTyped x = unsafeCodeCoerce (lift x)-  lift x-    = case x of-        (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7-        (# | y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 7-        (# | | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 7-        (# | | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 7-        (# | | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 7-        (# | | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 7-        (# | | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 7 <*> pure 7---- TH has a special form for literal strings,--- which we should take advantage of.--- NB: the lhs of the rule has no args, so that---     the rule will apply to a 'lift' all on its own---     which happens to be the way the type checker---     creates it.-{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}---trueName, falseName :: Name-trueName  = mkNameG DataName "ghc-prim" "GHC.Types" "True"-falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"--nothingName, justName :: Name-nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing"-justName    = mkNameG DataName "base" "GHC.Maybe" "Just"--leftName, rightName :: Name-leftName  = mkNameG DataName "base" "Data.Either" "Left"-rightName = mkNameG DataName "base" "Data.Either" "Right"--nonemptyName :: Name-nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"--oneName, manyName :: Name-oneName  = mkNameG DataName "ghc-prim" "GHC.Types" "One"-manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"-------------------------------------------------------------              Generic Lift implementations------------------------------------------------------------- | 'dataToQa' is an internal utility function for constructing generic--- conversion functions from types with 'Data' instances to various--- quasi-quoting representations.  See the source of 'dataToExpQ' and--- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@--- and @appQ@ are overloadable to account for different syntax for--- expressions and patterns; @antiQ@ allows you to override type-specific--- cases, a common usage is just @const Nothing@, which results in--- no overloading.-dataToQa  ::  forall m a k q. (Quote m, Data a)-          =>  (Name -> k)-          ->  (Lit -> m q)-          ->  (k -> [m q] -> m q)-          ->  (forall b . Data b => b -> Maybe (m q))-          ->  a-          ->  m q-dataToQa mkCon mkLit appCon antiQ t =-    case antiQ t of-      Nothing ->-          case constrRep constr of-            AlgConstr _ ->-                appCon (mkCon funOrConName) conArgs-              where-                funOrConName :: Name-                funOrConName =-                    case showConstr constr of-                      "(:)"       -> Name (mkOccName ":")-                                          (NameG DataName-                                                (mkPkgName "ghc-prim")-                                                (mkModName "GHC.Types"))-                      con@"[]"    -> Name (mkOccName con)-                                          (NameG DataName-                                                (mkPkgName "ghc-prim")-                                                (mkModName "GHC.Types"))-                      con@('(':_) -> Name (mkOccName con)-                                          (NameG DataName-                                                (mkPkgName "ghc-prim")-                                                (mkModName "GHC.Tuple"))--                      -- Tricky case: see Note [Data for non-algebraic types]-                      fun@(x:_)   | startsVarSym x || startsVarId x-                                  -> mkNameG_v tyconPkg tyconMod fun-                      con         -> mkNameG_d tyconPkg tyconMod con--                  where-                    tycon :: TyCon-                    tycon = (typeRepTyCon . typeOf) t--                    tyconPkg, tyconMod :: String-                    tyconPkg = tyConPackage tycon-                    tyconMod = tyConModule  tycon--                conArgs :: [m q]-                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t-            IntConstr n ->-                mkLit $ IntegerL n-            FloatConstr n ->-                mkLit $ RationalL n-            CharConstr c ->-                mkLit $ CharL c-        where-          constr :: Constr-          constr = toConstr t--      Just y -> y---{- Note [Data for non-algebraic types]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Class Data was originally intended for algebraic data types.  But-it is possible to use it for abstract types too.  For example, in-package `text` we find--  instance Data Text where-    ...-    toConstr _ = packConstr--  packConstr :: Constr-  packConstr = mkConstr textDataType "pack" [] Prefix--Here `packConstr` isn't a real data constructor, it's an ordinary-function.  Two complications--* In such a case, we must take care to build the Name using-  mkNameG_v (for values), not mkNameG_d (for data constructors).-  See #10796.--* The pseudo-constructor is named only by its string, here "pack".-  But 'dataToQa' needs the TyCon of its defining module, and has-  to assume it's defined in the same module as the TyCon itself.-  But nothing enforces that; #12596 shows what goes wrong if-  "pack" is defined in a different module than the data type "Text".-  -}---- | 'dataToExpQ' converts a value to a 'Exp' representation of the--- same value, in the SYB style. It is generalized to take a function--- override type-specific cases; see 'liftData' for a more commonly--- used variant.-dataToExpQ  ::  (Quote m, Data a)-            =>  (forall b . Data b => b -> Maybe (m Exp))-            ->  a-            ->  m Exp-dataToExpQ = dataToQa varOrConE litE (foldl appE)-    where-          -- Make sure that VarE is used if the Constr value relies on a-          -- function underneath the surface (instead of a constructor).-          -- See #10796.-          varOrConE s =-            case nameSpace s of-                 Just VarName      -> return (VarE s)-                 Just (FldName {}) -> return (VarE s)-                 Just DataName     -> return (ConE s)-                 _ -> error $ "Can't construct an expression from name "-                           ++ showName s-          appE x y = do { a <- x; b <- y; return (AppE a b)}-          litE c = return (LitE c)---- | 'liftData' is a variant of 'lift' in the 'Lift' type class which--- works for any type with a 'Data' instance.-liftData :: (Quote m, Data a) => a -> m Exp-liftData = dataToExpQ (const Nothing)---- | 'dataToPatQ' converts a value to a 'Pat' representation of the same--- value, in the SYB style. It takes a function to handle type-specific cases,--- alternatively, pass @const Nothing@ to get default behavior.-dataToPatQ  ::  (Quote m, Data a)-            =>  (forall b . Data b => b -> Maybe (m Pat))-            ->  a-            ->  m Pat-dataToPatQ = dataToQa id litP conP-    where litP l = return (LitP l)-          conP n ps =-            case nameSpace n of-                Just DataName -> do-                    ps' <- sequence ps-                    return (ConP n [] ps')-                _ -> error $ "Can't construct a pattern from name "-                          ++ showName n----------------------------------------------------------              Names and uniques--------------------------------------------------------newtype ModName = ModName String        -- Module name- deriving (Show,Eq,Ord,Data,Generic)--newtype PkgName = PkgName String        -- package name- deriving (Show,Eq,Ord,Data,Generic)---- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.-data Module = Module PkgName ModName -- package qualified module name- deriving (Show,Eq,Ord,Data,Generic)--newtype OccName = OccName String- deriving (Show,Eq,Ord,Data,Generic)--mkModName :: String -> ModName-mkModName s = ModName s--modString :: ModName -> String-modString (ModName m) = m---mkPkgName :: String -> PkgName-mkPkgName s = PkgName s--pkgString :: PkgName -> String-pkgString (PkgName m) = m-----------------------------------------------------------              OccName--------------------------------------------------------mkOccName :: String -> OccName-mkOccName s = OccName s--occString :: OccName -> String-occString (OccName occ) = occ-----------------------------------------------------------               Names------------------------------------------------------------ For "global" names ('NameG') we need a totally unique name,--- so we must include the name-space of the thing------ For unique-numbered things ('NameU'), we've got a unique reference--- anyway, so no need for name space------ For dynamically bound thing ('NameS') we probably want them to--- in a context-dependent way, so again we don't want the name--- space.  For example:------ > let v = mkName "T" in [| data $v = $v |]------ Here we use the same Name for both type constructor and data constructor--------- NameL and NameG are bound *outside* the TH syntax tree--- either globally (NameG) or locally (NameL). Ex:------ > f x = $(h [| (map, x) |])------ The 'map' will be a NameG, and 'x' wil be a NameL------ These Names should never appear in a binding position in a TH syntax tree--{- $namecapture #namecapture#-Much of 'Name' API is concerned with the problem of /name capture/, which-can be seen in the following example.--> f expr = [| let x = 0 in $expr |]-> ...-> g x = $( f [| x |] )-> h y = $( f [| y |] )--A naive desugaring of this would yield:--> g x = let x = 0 in x-> h y = let x = 0 in y--All of a sudden, @g@ and @h@ have different meanings! In this case,-we say that the @x@ in the RHS of @g@ has been /captured/-by the binding of @x@ in @f@.--What we actually want is for the @x@ in @f@ to be distinct from the-@x@ in @g@, so we get the following desugaring:--> g x = let x' = 0 in x-> h y = let x' = 0 in y--which avoids name capture as desired.--In the general case, we say that a @Name@ can be captured if-the thing it refers to can be changed by adding new declarations.--}--{- |-An abstract type representing names in the syntax tree.--'Name's can be constructed in several ways, which come with different-name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for-an explanation of name capture):--  * the built-in syntax @'f@ and @''T@ can be used to construct names,-    The expression @'f@ gives a @Name@ which refers to the value @f@-    currently in scope, and @''T@ gives a @Name@ which refers to the-    type @T@ currently in scope. These names can never be captured.--  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and-     @''T@ respectively, but the @Name@s are looked up at the point-     where the current splice is being run. These names can never be-     captured.--  * 'newName' monadically generates a new name, which can never-     be captured.--  * 'mkName' generates a capturable name.--Names constructed using @newName@ and @mkName@ may be used in bindings-(such as @let x = ...@ or @\x -> ...@), but names constructed using-@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.--}-data Name = Name OccName NameFlavour deriving (Data, Eq, Generic)--instance Ord Name where-    -- check if unique is different before looking at strings-  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`-                                        (o1 `compare` o2)--data NameFlavour-  = NameS           -- ^ An unqualified name; dynamically bound-  | NameQ ModName   -- ^ A qualified name; dynamically bound-  | NameU !Uniq     -- ^ A unique local name-  | NameL !Uniq     -- ^ Local name bound outside of the TH AST-  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:-                -- An original name (occurrences only, not binders)-                -- Need the namespace too to be sure which-                -- thing we are naming-  deriving ( Data, Eq, Ord, Show, Generic )--data NameSpace = VarName        -- ^ Variables-               | DataName       -- ^ Data constructors-               | TcClsName      -- ^ Type constructors and classes; Haskell has them-                                -- in the same name space for now.-               | FldName-                 { fldParent :: !String-                   -- ^ The textual name of the parent of the field.-                   ---                   --   - For a field of a datatype, this is the name of the first constructor-                   --     of the datatype (regardless of whether this constructor has this field).-                   --   - For a field of a pattern synonym, this is the name of the pattern synonym.-                 }-               deriving( Eq, Ord, Show, Data, Generic )---- | @Uniq@ is used by GHC to distinguish names from each other.-type Uniq = Integer---- | The name without its module prefix.------ ==== __Examples__------ >>> nameBase ''Data.Either.Either--- "Either"--- >>> nameBase (mkName "foo")--- "foo"--- >>> nameBase (mkName "Module.foo")--- "foo"-nameBase :: Name -> String-nameBase (Name occ _) = occString occ---- | Module prefix of a name, if it exists.------ ==== __Examples__------ >>> nameModule ''Data.Either.Either--- Just "Data.Either"--- >>> nameModule (mkName "foo")--- Nothing--- >>> nameModule (mkName "Module.foo")--- Just "Module"-nameModule :: Name -> Maybe String-nameModule (Name _ (NameQ m))     = Just (modString m)-nameModule (Name _ (NameG _ _ m)) = Just (modString m)-nameModule _                      = Nothing---- | A name's package, if it exists.------ ==== __Examples__------ >>> namePackage ''Data.Either.Either--- Just "base"--- >>> namePackage (mkName "foo")--- Nothing--- >>> namePackage (mkName "Module.foo")--- Nothing-namePackage :: Name -> Maybe String-namePackage (Name _ (NameG _ p _)) = Just (pkgString p)-namePackage _                      = Nothing---- | Returns whether a name represents an occurrence of a top-level variable--- ('VarName'), data constructor ('DataName'), type constructor, or type class--- ('TcClsName'). If we can't be sure, it returns 'Nothing'.------ ==== __Examples__------ >>> nameSpace 'Prelude.id--- Just VarName--- >>> nameSpace (mkName "id")--- Nothing -- only works for top-level variable names--- >>> nameSpace 'Data.Maybe.Just--- Just DataName--- >>> nameSpace ''Data.Maybe.Maybe--- Just TcClsName--- >>> nameSpace ''Data.Ord.Ord--- Just TcClsName-nameSpace :: Name -> Maybe NameSpace-nameSpace (Name _ (NameG ns _ _)) = Just ns-nameSpace _                       = Nothing--{- |-Generate a capturable name. Occurrences of such names will be-resolved according to the Haskell scoping rules at the occurrence-site.--For example:--> f = [| pi + $(varE (mkName "pi")) |]-> ...-> g = let pi = 3 in $f--In this case, @g@ is desugared to--> g = Prelude.pi + 3--Note that @mkName@ may be used with qualified names:--> mkName "Prelude.pi"--See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could-be rewritten using 'Language.Haskell.TH.Lib.dyn' as--> f = [| pi + $(dyn "pi") |]--}-mkName :: String -> Name--- The string can have a '.', thus "Foo.baz",--- giving a dynamically-bound qualified name,--- in which case we want to generate a NameQ------ Parse the string to see if it has a "." in it--- so we know whether to generate a qualified or unqualified name--- It's a bit tricky because we need to parse------ > Foo.Baz.x   as    Qual Foo.Baz x------ So we parse it from back to front-mkName str-  = split [] (reverse str)-  where-    split occ []        = Name (mkOccName occ) NameS-    split occ ('.':rev) | not (null occ)-                        , is_rev_mod_name rev-                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))-        -- The 'not (null occ)' guard ensures that-        --      mkName "&." = Name "&." NameS-        -- The 'is_rev_mod' guards ensure that-        --      mkName ".&" = Name ".&" NameS-        --      mkName "^.." = Name "^.." NameS      -- #8633-        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")-        -- This rather bizarre case actually happened; (.&.) is in Data.Bits-    split occ (c:rev)   = split (c:occ) rev--    -- Recognises a reversed module name xA.yB.C,-    -- with at least one component,-    -- and each component looks like a module name-    --   (i.e. non-empty, starts with capital, all alpha)-    is_rev_mod_name rev_mod_str-      | (compt, rest) <- break (== '.') rev_mod_str-      , not (null compt), isUpper (last compt), all is_mod_char compt-      = case rest of-          []             -> True-          (_dot : rest') -> is_rev_mod_name rest'-      | otherwise-      = False--    is_mod_char c = isAlphaNum c || c == '_' || c == '\''---- | Only used internally-mkNameU :: String -> Uniq -> Name-mkNameU s u = Name (mkOccName s) (NameU u)---- | Only used internally-mkNameL :: String -> Uniq -> Name-mkNameL s u = Name (mkOccName s) (NameL u)---- | Only used internally-mkNameQ :: String -> String -> Name-mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))---- | Used for 'x etc, but not available to the programmer-mkNameG :: NameSpace -> String -> String -> String -> Name-mkNameG ns pkg modu occ-  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))--mkNameS :: String -> Name-mkNameS n = Name (mkOccName n) NameS--mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name-mkNameG_v  = mkNameG VarName-mkNameG_tc = mkNameG TcClsName-mkNameG_d  = mkNameG DataName--mkNameG_fld :: String -- ^ package-            -> String -- ^ module-            -> String -- ^ parent (first constructor of parent type)-            -> String -- ^ field name-            -> Name-mkNameG_fld pkg modu con occ = mkNameG (FldName con) pkg modu occ--data NameIs = Alone | Applied | Infix--showName :: Name -> String-showName = showName' Alone--showName' :: NameIs -> Name -> String-showName' ni nm- = case ni of-       Alone        -> nms-       Applied-        | pnam      -> nms-        | otherwise -> "(" ++ nms ++ ")"-       Infix-        | pnam      -> "`" ++ nms ++ "`"-        | otherwise -> nms-    where-        -- For now, we make the NameQ and NameG print the same, even though-        -- NameQ is a qualified name (so what it means depends on what the-        -- current scope is), and NameG is an original name (so its meaning-        -- should be independent of what's in scope.-        -- We may well want to distinguish them in the end.-        -- Ditto NameU and NameL-        nms = case nm of-          Name occ NameS          -> occString occ-          Name occ (NameQ m)      -> modString m ++ "." ++ occString occ-          Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ-          Name occ (NameU u)      -> occString occ ++ "_" ++ show u-          Name occ (NameL u)      -> occString occ ++ "_" ++ show u--        pnam = classify nms--        -- True if we are function style, e.g. f, [], (,)-        -- False if we are operator style, e.g. +, :+-        classify "" = False -- shouldn't happen; . operator is handled below-        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =-                            case dropWhile (/='.') xs of-                                  (_:xs') -> classify xs'-                                  []      -> True-                        | otherwise = False--instance Show Name where-  show = showName---- Tuple data and type constructors--- | Tuple data constructor-tupleDataName :: Int -> Name--- | Tuple type constructor-tupleTypeName :: Int -> Name--tupleDataName n = mk_tup_name n DataName  True-tupleTypeName n = mk_tup_name n TcClsName True---- Unboxed tuple data and type constructors--- | Unboxed tuple data constructor-unboxedTupleDataName :: Int -> Name--- | Unboxed tuple type constructor-unboxedTupleTypeName :: Int -> Name--unboxedTupleDataName n = mk_tup_name n DataName  False-unboxedTupleTypeName n = mk_tup_name n TcClsName False--mk_tup_name :: Int -> NameSpace -> Bool -> Name-mk_tup_name n space boxed-  = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod)-  where-    withParens thing-      | boxed     = "("  ++ thing ++ ")"-      | otherwise = "(#" ++ thing ++ "#)"-    tup_occ | n == 0, space == TcClsName = if boxed then "Unit" else "Unit#"-            | n == 1 = if boxed then solo else unboxed_solo-            | space == TcClsName = "Tuple" ++ show n ++ if boxed then "" else "#"-            | otherwise = withParens (replicate n_commas ',')-    n_commas = n - 1-    tup_mod  = mkModName (if boxed then "GHC.Tuple" else "GHC.Types")-    solo-      | space == DataName = "MkSolo"-      | otherwise = "Solo"--    unboxed_solo-      | space == DataName = "(# #)"-      | otherwise = "Solo#"---- Unboxed sum data and type constructors--- | Unboxed sum data constructor-unboxedSumDataName :: SumAlt -> SumArity -> Name--- | Unboxed sum type constructor-unboxedSumTypeName :: SumArity -> Name--unboxedSumDataName alt arity-  | alt > arity-  = error $ prefix ++ "Index out of bounds." ++ debug_info--  | alt <= 0-  = error $ prefix ++ "Alt must be > 0." ++ debug_info--  | arity < 2-  = error $ prefix ++ "Arity must be >= 2." ++ debug_info--  | otherwise-  = Name (mkOccName sum_occ)-         (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))--  where-    prefix     = "unboxedSumDataName: "-    debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"--    -- Synced with the definition of mkSumDataConOcc in GHC.Builtin.Types-    sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)"-    bars i = replicate i '|'-    nbars_before = alt - 1-    nbars_after  = arity - alt--unboxedSumTypeName arity-  | arity < 2-  = error $ "unboxedSumTypeName: Arity must be >= 2."-         ++ " (arity: " ++ show arity ++ ")"--  | otherwise-  = Name (mkOccName sum_occ)-         (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))--  where-    -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types-    sum_occ = "Sum" ++ show arity ++ "#"----------------------------------------------------------              Locations--------------------------------------------------------data Loc-  = Loc { loc_filename :: String-        , loc_package  :: String-        , loc_module   :: String-        , loc_start    :: CharPos-        , loc_end      :: CharPos }-   deriving( Show, Eq, Ord, Data, Generic )--type CharPos = (Int, Int)       -- ^ Line and character position--------------------------------------------------------------      The Info returned by reification------------------------------------------------------------- | Obtained from 'reify' in the 'Q' Monad.-data Info-  =-  -- | A class, with a list of its visible instances-  ClassI-      Dec-      [InstanceDec]--  -- | A class method-  | ClassOpI-       Name-       Type-       ParentName--  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned-  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified-  -- declaration will never have derived instances attached to it (if you wish-  -- to check for an instance, see 'reifyInstances').-  | TyConI-        Dec--  -- | A type or data family, with a list of its visible instances. A closed-  -- type family is returned with 0 instances.-  | FamilyI-        Dec-        [InstanceDec]--  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.-  -- Examples: @(->)@, @Int#@.-  | PrimTyConI-       Name-       Arity-       Unlifted--  -- | A data constructor-  | DataConI-       Name-       Type-       ParentName--  -- | A pattern synonym-  | PatSynI-       Name-       PatSynType--  {- |-  A \"value\" variable (as opposed to a type variable, see 'TyVarI').--  The @Maybe Dec@ field contains @Just@ the declaration which-  defined the variable - including the RHS of the declaration --  or else @Nothing@, in the case where the RHS is unavailable to-  the compiler. At present, this value is /always/ @Nothing@:-  returning the RHS has not yet been implemented because of-  lack of interest.-  -}-  | VarI-       Name-       Type-       (Maybe Dec)--  {- |-  A type variable.--  The @Type@ field contains the type which underlies the variable.-  At present, this is always @'VarT' theName@, but future changes-  may permit refinement of this.-  -}-  | TyVarI      -- Scoped type variable-        Name-        Type    -- What it is bound to-  deriving( Show, Eq, Ord, Data, Generic )---- | Obtained from 'reifyModule' in the 'Q' Monad.-data ModuleInfo =-  -- | Contains the import list of the module.-  ModuleInfo [Module]-  deriving( Show, Eq, Ord, Data, Generic )--{- |-In 'ClassOpI' and 'DataConI', name of the parent class or type--}-type ParentName = Name---- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a--- particular data constructor. 'SumAlt's are one-indexed and should never--- exceed the value of its corresponding 'SumArity'. For example:------ * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)------ * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)-type SumAlt = Int---- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of--- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.-type SumArity = Int---- | In 'PrimTyConI', arity of the type constructor-type Arity = Int---- | In 'PrimTyConI', is the type constructor unlifted?-type Unlifted = Bool---- | 'InstanceDec' describes a single instance of a class or type function.--- It is just a 'Dec', but guaranteed to be one of the following:------   * 'InstanceD' (with empty @['Dec']@)------   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)------   * 'TySynInstD'-type InstanceDec = Dec--data Fixity          = Fixity Int FixityDirection-    deriving( Eq, Ord, Show, Data, Generic )-data FixityDirection = InfixL | InfixR | InfixN-    deriving( Eq, Ord, Show, Data, Generic )---- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)-maxPrecedence :: Int-maxPrecedence = (9::Int)---- | Default fixity: @infixl 9@-defaultFixity :: Fixity-defaultFixity = Fixity maxPrecedence InfixL---{--Note [Unresolved infix]-~~~~~~~~~~~~~~~~~~~~~~~--}-{- $infix #infix#--When implementing antiquotation for quasiquoters, one often wants-to parse strings into expressions:--> parse :: String -> Maybe Exp--But how should we parse @a + b * c@? If we don't know the fixities of-@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a-+ b) * c@.--In cases like this, use 'UInfixE', 'UInfixP', 'UInfixT', or 'PromotedUInfixT',-which stand for \"unresolved infix expression/pattern/type/promoted-constructor\", respectively. When the compiler is given a splice containing a-tree of @UInfixE@ applications such as--> UInfixE->   (UInfixE e1 op1 e2)->   op2->   (UInfixE e3 op3 e4)--it will look up and the fixities of the relevant operators and-reassociate the tree as necessary.--  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',-    which are of use for parsing expressions like--    > (a + b * c) + d * e--  * 'InfixE', 'InfixP', 'InfixT', and 'PromotedInfixT' expressions are never-    reassociated.--  * The 'UInfixE' constructor doesn't support sections. Sections-    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer-    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the-    outer-most section, and use 'UInfixE' constructors for all-    other operators:--    > InfixE-    >   Just (UInfixE ...a + b * c...)-    >   op-    >   Nothing--    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered-    into 'Exp's differently:--    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)-    >                    -- will result in a fixity error if (+) is left-infix-    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)-    >                    -- no fixity errors--  * Quoted expressions such as--    > [| a * b + c |] :: Q Exp-    > [p| a : b : c |] :: Q Pat-    > [t| T + T |] :: Q Type--    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'PromotedUInfixT',-    'InfixT', 'PromotedInfixT, 'ParensE', 'ParensP', or 'ParensT' constructors.---}-------------------------------------------------------------      The main syntax data types-----------------------------------------------------------data Lit = CharL Char-         | StringL String-         | IntegerL Integer     -- ^ Used for overloaded and non-overloaded-                                -- literals. We don't have a good way to-                                -- represent non-overloaded literals at-                                -- the moment. Maybe that doesn't matter?-         | RationalL Rational   -- Ditto-         | IntPrimL Integer-         | WordPrimL Integer-         | FloatPrimL Rational-         | DoublePrimL Rational-         | StringPrimL [Word8]  -- ^ A primitive C-style string, type 'Addr#'-         | BytesPrimL Bytes     -- ^ Some raw bytes, type 'Addr#':-         | CharPrimL Char-    deriving( Show, Eq, Ord, Data, Generic )--    -- We could add Int, Float, Double etc, as we do in HsLit,-    -- but that could complicate the-    -- supposedly-simple TH.Syntax literal type---- | Raw bytes embedded into the binary.------ Avoid using Bytes constructor directly as it is likely to change in the--- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead.-data Bytes = Bytes-   { bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data-   , bytesOffset :: Word             -- ^ Offset from the pointer-   , bytesSize   :: Word             -- ^ Number of bytes--   -- Maybe someday:-   -- , bytesAlignement  :: Word -- ^ Alignement constraint-   -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only-   --                            --   section or not-   -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate-   --                            --   an uninitialized region-   }-   deriving (Data,Generic)---- We can't derive Show instance for Bytes because we don't want to show the--- pointer value but the actual bytes (similarly to what ByteString does). See--- #16457.-instance Show Bytes where-   show b = unsafePerformIO $ withForeignPtr (bytesPtr b) $ \ptr ->-               peekCStringLen ( ptr `plusPtr` fromIntegral (bytesOffset b)-                              , fromIntegral (bytesSize b)-                              )---- We can't derive Eq and Ord instances for Bytes because we don't want to--- compare pointer values but the actual bytes (similarly to what ByteString--- does).  See #16457-instance Eq Bytes where-   (==) = eqBytes--instance Ord Bytes where-   compare = compareBytes--eqBytes :: Bytes -> Bytes -> Bool-eqBytes a@(Bytes fp off len) b@(Bytes fp' off' len')-  | len /= len'              = False    -- short cut on length-  | fp == fp' && off == off' = True     -- short cut for the same bytes-  | otherwise                = compareBytes a b == EQ--compareBytes :: Bytes -> Bytes -> Ordering-compareBytes (Bytes _   _    0)    (Bytes _   _    0)    = EQ  -- short cut for empty Bytes-compareBytes (Bytes fp1 off1 len1) (Bytes fp2 off2 len2) =-    unsafePerformIO $-      withForeignPtr fp1 $ \p1 ->-      withForeignPtr fp2 $ \p2 -> do-        i <- memcmp (p1 `plusPtr` fromIntegral off1)-                    (p2 `plusPtr` fromIntegral off2)-                    (fromIntegral (min len1 len2))-        return $! (i `compare` 0) <> (len1 `compare` len2)--foreign import ccall unsafe "memcmp"-  memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt----- | Pattern in Haskell given in @{}@-data Pat-  = LitP Lit                        -- ^ @{ 5 or \'c\' }@-  | VarP Name                       -- ^ @{ x }@-  | TupP [Pat]                      -- ^ @{ (p1,p2) }@-  | UnboxedTupP [Pat]               -- ^ @{ (\# p1,p2 \#) }@-  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@-  | ConP Name [Type] [Pat]          -- ^ @data T1 = C1 t1 t2; {C1 \@ty1 p1 p2} = e@-  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@-  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@-                                    ---                                    -- See "Language.Haskell.TH.Syntax#infix"-  | ParensP Pat                     -- ^ @{(p)}@-                                    ---                                    -- See "Language.Haskell.TH.Syntax#infix"-  | TildeP Pat                      -- ^ @{ ~p }@-  | BangP Pat                       -- ^ @{ !p }@-  | AsP Name Pat                    -- ^ @{ x \@ p }@-  | WildP                           -- ^ @{ _ }@-  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@-  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@-  | SigP Pat Type                   -- ^ @{ p :: t }@-  | ViewP Exp Pat                   -- ^ @{ e -> p }@-  | TypeP Type                      -- ^ @{ type p }@-  | InvisP Type                     -- ^ @{ @p }@-  deriving( Show, Eq, Ord, Data, Generic )--type FieldPat = (Name,Pat)--data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@-    deriving( Show, Eq, Ord, Data, Generic )--data Clause = Clause [Pat] Body [Dec]-                                  -- ^ @f { p1 p2 = body where decs }@-    deriving( Show, Eq, Ord, Data, Generic )--data Exp-  = VarE Name                          -- ^ @{ x }@-  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @-  | LitE Lit                           -- ^ @{ 5 or \'c\'}@-  | AppE Exp Exp                       -- ^ @{ f x }@-  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@--  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@--    -- It's a bit gruesome to use an Exp as the operator when a Name-    -- would suffice. Historically, Exp was used to make it easier to-    -- distinguish between infix constructors and non-constructors.-    -- This is a bit overkill, since one could just as well call-    -- `startsConId` or `startsConSym` (from `GHC.Lexeme`) on a Name.-    -- Unfortunately, changing this design now would involve lots of-    -- code churn for consumers of the TH API, so we continue to use-    -- an Exp as the operator and perform an extra check during conversion-    -- to ensure that the Exp is a constructor or a variable (#16895).--  | UInfixE Exp Exp Exp                -- ^ @{x + y}@-                                       ---                                       -- See "Language.Haskell.TH.Syntax#infix"-  | ParensE Exp                        -- ^ @{ (e) }@-                                       ---                                       -- See "Language.Haskell.TH.Syntax#infix"-  | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@-  | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@-  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@-  | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @-                                       ---                                       -- The 'Maybe' is necessary for handling-                                       -- tuple sections.-                                       ---                                       -- > (1,)-                                       ---                                       -- translates to-                                       ---                                       -- > TupE [Just (LitE (IntegerL 1)),Nothing]--  | UnboxedTupE [Maybe Exp]            -- ^ @{ (\# e1,e2 \#) }  @-                                       ---                                       -- The 'Maybe' is necessary for handling-                                       -- tuple sections.-                                       ---                                       -- > (# 'c', #)-                                       ---                                       -- translates to-                                       ---                                       -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing]--  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\#|e|\#) }@-  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@-  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@-  | LetE [Dec] Exp                     -- ^ @{ let { x=e1; y=e2 } in e3 }@-  | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@-  | DoE (Maybe ModName) [Stmt]         -- ^ @{ do { p <- e1; e2 }  }@ or a qualified do if-                                       -- the module name is present-  | MDoE (Maybe ModName) [Stmt]        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@ or a qualified-                                       -- mdo if the module name is present-  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@-      ---      -- The result expression of the comprehension is-      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.-      ---      -- E.g. translation:-      ---      -- > [ f x | x <- xs ]-      ---      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]--  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@-  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@-  | SigE Exp Type                      -- ^ @{ e :: t }@-  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@-  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@-  | StaticE Exp                        -- ^ @{ static e }@-  | UnboundVarE Name                   -- ^ @{ _x }@-                                       ---                                       -- This is used for holes or unresolved-                                       -- identifiers in AST quotes. Note that-                                       -- it could either have a variable name-                                       -- or constructor name.-  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )-  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )-  | GetFieldE Exp String               -- ^ @{ exp.field }@ ( Overloaded Record Dot )-  | ProjectionE (NonEmpty String)      -- ^ @(.x)@ or @(.x.y)@ (Record projections)-  | TypedBracketE Exp                  -- ^ @[|| e ||]@-  | TypedSpliceE Exp                   -- ^ @$$e@-  | TypeE Type                         -- ^ @{ type t }@-  deriving( Show, Eq, Ord, Data, Generic )--type FieldExp = (Name,Exp)---- Omitted: implicit parameters--data Body-  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2-                                 --      | e3 = e4 }-                                 -- where ds@-  | NormalB Exp              -- ^ @f p { = e } where ds@-  deriving( Show, Eq, Ord, Data, Generic )--data Guard-  = NormalG Exp -- ^ @f x { | odd x } = x@-  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@-  deriving( Show, Eq, Ord, Data, Generic )--data Stmt-  = BindS Pat Exp -- ^ @p <- e@-  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@-  | NoBindS Exp   -- ^ @e@-  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')-  | RecS [Stmt]   -- ^ @rec { s1; s2 }@-  deriving( Show, Eq, Ord, Data, Generic )--data Range = FromR Exp | FromThenR Exp Exp-           | FromToR Exp Exp | FromThenToR Exp Exp Exp-          deriving( Show, Eq, Ord, Data, Generic )--data Dec-  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@-  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@-  | DataD Cxt Name [TyVarBndr BndrVis]-          (Maybe Kind)            -- Kind signature (allowed only for GADTs)-          [Con] [DerivClause]-                                  -- ^ @{ data Cxt x => T x = A x | B (T x)-                                  --       deriving (Z,W)-                                  --       deriving stock Eq }@-  | NewtypeD Cxt Name [TyVarBndr BndrVis]-             (Maybe Kind)         -- Kind signature-             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)-                                  --       deriving (Z,W Q)-                                  --       deriving stock Eq }@-  | TypeDataD Name [TyVarBndr BndrVis]-          (Maybe Kind)            -- Kind signature (allowed only for GADTs)-          [Con]                   -- ^ @{ type data T x = A x | B (T x) }@-  | TySynD Name [TyVarBndr BndrVis] Type -- ^ @{ type T x = (x,x) }@-  | ClassD Cxt Name [TyVarBndr BndrVis]-         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@-  | InstanceD (Maybe Overlap) Cxt Type [Dec]-                                  -- ^ @{ instance {\-\# OVERLAPS \#-\}-                                  --        Show w => Show [w] where ds }@-  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@-  | KiSigD Name Kind              -- ^ @{ type TypeRep :: k -> Type }@-  | ForeignD Foreign              -- ^ @{ foreign import ... }-                                  --{ foreign export ... }@--  | InfixD Fixity NamespaceSpecifier Name-                                  -- ^ @{ infix 3 data foo }@-  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@--  -- | pragmas-  | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@--  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')-  | DataFamilyD Name [TyVarBndr BndrVis]-               (Maybe Kind)-         -- ^ @{ data family T a b c :: * }@--  | DataInstD Cxt (Maybe [TyVarBndr ()]) Type-             (Maybe Kind)         -- Kind signature-             [Con] [DerivClause]  -- ^ @{ data instance Cxt x => T [x]-                                  --       = A x | B (T x)-                                  --       deriving (Z,W)-                                  --       deriving stock Eq }@--  | NewtypeInstD Cxt (Maybe [TyVarBndr ()]) Type -- Quantified type vars-                 (Maybe Kind)      -- Kind signature-                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]-                                   --        = A (B x)-                                   --        deriving (Z,W)-                                   --        deriving stock Eq }@-  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@--  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')-  | OpenTypeFamilyD TypeFamilyHead-         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@--  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]-       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@--  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@-  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type-       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@-  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@--  -- | Pattern Synonyms-  | PatSynD Name PatSynArgs PatSynDir Pat-      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or-      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or-      --   @{ pattern P v1 v2 .. vn <- p-      --        where P v1 v2 .. vn = e  }@  explicit bidirectional-      ---      -- also, besides prefix pattern synonyms, both infix and record-      -- pattern synonyms are supported. See 'PatSynArgs' for details--  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.--  | ImplicitParamBindD String Exp-      -- ^ @{ ?x = expr }@-      ---      -- Implicit parameter binding declaration. Can only be used in let-      -- and where clauses which consist entirely of implicit bindings.-  deriving( Show, Eq, Ord, Data, Generic )---- | A way to specify a namespace to look in when GHC needs to find---   a name's source-data NamespaceSpecifier-  = NoNamespaceSpecifier   -- ^ Name may be everything; If there are two-                           --   names in different namespaces, then consider both-  | TypeNamespaceSpecifier -- ^ Name should be a type-level entity, such as a-                           --   data type, type alias, type family, type class,-                           --   or type variable-  | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a-                           --   function, data constructor, or pattern synonym-  deriving( Show, Eq, Ord, Data, Generic )---- | Varieties of allowed instance overlap.-data Overlap = Overlappable   -- ^ May be overlapped by more specific instances-             | Overlapping    -- ^ May overlap a more general instance-             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'-             | Incoherent     -- ^ Both 'Overlapping' and 'Overlappable', and-                              -- pick an arbitrary one if multiple choices are-                              -- available.-  deriving( Show, Eq, Ord, Data, Generic )---- | A single @deriving@ clause at the end of a datatype.-data DerivClause = DerivClause (Maybe DerivStrategy) Cxt-    -- ^ @{ deriving stock (Eq, Ord) }@-  deriving( Show, Eq, Ord, Data, Generic )---- | What the user explicitly requests when deriving an instance.-data DerivStrategy = StockStrategy    -- ^ A \"standard\" derived instance-                   | AnyclassStrategy -- ^ @-XDeriveAnyClass@-                   | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@-                   | ViaStrategy Type -- ^ @-XDerivingVia@-  deriving( Show, Eq, Ord, Data, Generic )---- | A pattern synonym's type. Note that a pattern synonym's /fully/--- specified type has a peculiar shape coming with two forall--- quantifiers and two constraint contexts. For example, consider the--- pattern synonym------ > pattern P x1 x2 ... xn = <some-pattern>------ P's complete type is of the following form------ > pattern P :: forall universals.   required constraints--- >           => forall existentials. provided constraints--- >           => t1 -> t2 -> ... -> tn -> t------ consisting of four parts:------   1. the (possibly empty lists of) universally quantified type---      variables and required constraints on them.---   2. the (possibly empty lists of) existentially quantified---      type variables and the provided constraints on them.---   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively---   4. the type @t@ of @\<some-pattern\>@, mentioning only universals.------ Pattern synonym types interact with TH when (a) reifying a pattern--- synonym, (b) pretty printing, or (c) specifying a pattern synonym's--- type signature explicitly:------   * Reification always returns a pattern synonym's /fully/ specified---     type in abstract syntax.------   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates---     a pattern synonym's type unambiguously in concrete syntax: The rule of---     thumb is to print initial empty universals and the required---     context as @() =>@, if existentials and a provided context---     follow. If only universals and their required context, but no---     existentials are specified, only the universals and their---     required context are printed. If both or none are specified, so---     both (or none) are printed.------   * When specifying a pattern synonym's type explicitly with---     'PatSynSigD' either one of the universals, the existentials, or---     their contexts may be left empty.------ See the GHC user's guide for more information on pattern synonyms--- and their types:--- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.-type PatSynType = Type---- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By--- analogy with "head" for type classes and type class instances as--- defined in /Type classes: an exploration of the design space/, the--- @TypeFamilyHead@ is defined to be the elements of the declaration--- between @type family@ and @where@.-data TypeFamilyHead =-  TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn)-  deriving( Show, Eq, Ord, Data, Generic )---- | One equation of a type family instance or closed type family. The--- arguments are the left-hand-side type and the right-hand-side result.------ For instance, if you had the following type family:------ @--- type family Foo (a :: k) :: k where---   forall k (a :: k). Foo \@k a = a--- @------ The @Foo \@k a = a@ equation would be represented as follows:------ @--- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])---            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))---            ('VarT' a)--- @-data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type-  deriving( Show, Eq, Ord, Data, Generic )--data FunDep = FunDep [Name] [Name]-  deriving( Show, Eq, Ord, Data, Generic )--data Foreign = ImportF Callconv Safety String Name Type-             | ExportF Callconv        String Name Type-         deriving( Show, Eq, Ord, Data, Generic )---- keep Callconv in sync with module ForeignCall in ghc/compiler/GHC/Types/ForeignCall.hs-data Callconv = CCall | StdCall | CApi | Prim | JavaScript-          deriving( Show, Eq, Ord, Data, Generic )--data Safety = Unsafe | Safe | Interruptible-        deriving( Show, Eq, Ord, Data, Generic )--data Pragma = InlineP         Name Inline RuleMatch Phases-            | OpaqueP         Name-            | SpecialiseP     Name Type (Maybe Inline) Phases-            | SpecialiseInstP Type-            | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases-            | AnnP            AnnTarget Exp-            | LineP           Int String-            | CompleteP       [Name] (Maybe Name)-                -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@-            | SCCP            Name (Maybe String)-                -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@-        deriving( Show, Eq, Ord, Data, Generic )--data Inline = NoInline-            | Inline-            | Inlinable-            deriving (Show, Eq, Ord, Data, Generic)--data RuleMatch = ConLike-               | FunLike-               deriving (Show, Eq, Ord, Data, Generic)--data Phases = AllPhases-            | FromPhase Int-            | BeforePhase Int-            deriving (Show, Eq, Ord, Data, Generic)--data RuleBndr = RuleVar Name-              | TypedRuleVar Name Type-              deriving (Show, Eq, Ord, Data, Generic)--data AnnTarget = ModuleAnnotation-               | TypeAnnotation Name-               | ValueAnnotation Name-              deriving (Show, Eq, Ord, Data, Generic)--type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@---- | Since the advent of @ConstraintKinds@, constraints are really just types.--- Equality constraints use the 'EqualityT' constructor. Constraints may also--- be tuples of other constraints.-type Pred = Type---- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code.------ This may not agree with the annotations returned by 'reifyConStrictness'.--- See 'reifyConStrictness' for more information.-data SourceUnpackedness-  = NoSourceUnpackedness -- ^ @C a@-  | SourceNoUnpack       -- ^ @C { {\-\# NOUNPACK \#-\} } a@-  | SourceUnpack         -- ^ @C { {\-\# UNPACK \#-\} } a@-        deriving (Show, Eq, Ord, Data, Generic)---- | 'SourceStrictness' corresponds to strictness annotations found in the source code.------ This may not agree with the annotations returned by 'reifyConStrictness'.--- See 'reifyConStrictness' for more information.-data SourceStrictness = NoSourceStrictness    -- ^ @C a@-                      | SourceLazy            -- ^ @C {~}a@-                      | SourceStrict          -- ^ @C {!}a@-        deriving (Show, Eq, Ord, Data, Generic)---- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'--- refers to the strictness annotations that the compiler chooses for a data constructor--- field, which may be different from what is written in source code.------ Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate,--- such as the field of a newtype constructor and fields that have an unlifted type.------ See 'reifyConStrictness' for more information.-data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.-                       | DecidedStrict -- ^ Field inferred to have a bang.-                       | DecidedUnpack -- ^ Field inferred to be unpacked.-        deriving (Show, Eq, Ord, Data, Generic)---- | A data constructor.------ The constructors for 'Con' can roughly be divided up into two categories:--- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and--- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and--- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type--- variables and class contexts, can surround either variety of constructor.--- However, the type variables that it quantifies are different depending--- on what constructor syntax is used:------ * If a 'ForallC' surrounds a constructor with vanilla syntax, then the---   'ForallC' will only quantify /existential/ type variables. For example:------   @---   data Foo a = forall b. MkFoo a b---   @------   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.------ * If a 'ForallC' surrounds a constructor with GADT syntax, then the---   'ForallC' will quantify /all/ type variables used in the constructor.---   For example:------   @---   data Bar a b where---     MkBar :: (a ~ b) => c -> MkBar a b---   @------   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.------ Multiplicity annotations for data types are currently not supported--- in Template Haskell (i.e. all fields represented by Template Haskell--- will be linear).-data Con =-  -- | @C Int a@-    NormalC Name [BangType]--  -- | @C { v :: Int, w :: a }@-  | RecC Name [VarBangType]--  -- | @Int :+ a@-  | InfixC BangType Name BangType--  -- | @forall a. Eq a => C [a]@-  | ForallC [TyVarBndr Specificity] Cxt Con--  -- @C :: a -> b -> T b Int@-  | GadtC [Name]-            -- ^ The list of constructors, corresponding to the GADT constructor-            -- syntax @C1, C2 :: a -> T b@.-            ---            -- Invariant: the list must be non-empty.-          [BangType] -- ^ The constructor arguments-          Type -- ^ See Note [GADT return type]--  -- | @C :: { v :: Int } -> T b Int@-  | RecGadtC [Name]-             -- ^ The list of constructors, corresponding to the GADT record-             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.-             ---             -- Invariant: the list must be non-empty.-             [VarBangType] -- ^ The constructor arguments-             Type -- ^ See Note [GADT return type]-        deriving (Show, Eq, Ord, Data, Generic)---- Note [GADT return type]--- ~~~~~~~~~~~~~~~~~~~~~~~--- The return type of a GADT constructor does not necessarily match the name of--- the data type:------ type S = T------ data T a where---     MkT :: S Int--------- type S a = T------ data T a where---     MkT :: S Char Int--------- type Id a = a--- type S a = T------ data T a where---     MkT :: Id (S Char Int)--------- That is why we allow the return type stored by a constructor to be an--- arbitrary type. See also #11341--data Bang = Bang SourceUnpackedness SourceStrictness-         -- ^ @C { {\-\# UNPACK \#-\} !}a@-        deriving (Show, Eq, Ord, Data, Generic)--type BangType    = (Bang, Type)-type VarBangType = (Name, Bang, Type)---- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.-type Strict      = Bang---- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by--- 'BangType'.-type StrictType    = BangType---- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by--- 'VarBangType'.-type VarStrictType = VarBangType---- | A pattern synonym's directionality.-data PatSynDir-  = Unidir             -- ^ @pattern P x {<-} p@-  | ImplBidir          -- ^ @pattern P x {=} p@-  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@-  deriving( Show, Eq, Ord, Data, Generic )---- | A pattern synonym's argument type.-data PatSynArgs-  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@-  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@-  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@-  deriving( Show, Eq, Ord, Data, Generic )--data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@-          | ForallVisT [TyVarBndr ()] Type -- ^ @forall \<vars\> -> \<type\>@-          | AppT Type Type                 -- ^ @T a b@-          | AppKindT Type Kind             -- ^ @T \@k t@-          | SigT Type Kind                 -- ^ @t :: k@-          | VarT Name                      -- ^ @a@-          | ConT Name                      -- ^ @T@-          | PromotedT Name                 -- ^ @'T@-          | InfixT Type Name Type          -- ^ @T + T@-          | UInfixT Type Name Type         -- ^ @T + T@-                                           ---                                           -- See "Language.Haskell.TH.Syntax#infix"-          | PromotedInfixT Type Name Type  -- ^ @T :+: T@-          | PromotedUInfixT Type Name Type -- ^ @T :+: T@-                                           ---                                           -- See "Language.Haskell.TH.Syntax#infix"-          | ParensT Type                   -- ^ @(T)@--          -- See Note [Representing concrete syntax in types]-          | TupleT Int                     -- ^ @(,)@, @(,,)@, etc.-          | UnboxedTupleT Int              -- ^ @(\#,\#)@, @(\#,,\#)@, etc.-          | UnboxedSumT SumArity           -- ^ @(\#|\#)@, @(\#||\#)@, etc.-          | ArrowT                         -- ^ @->@-          | MulArrowT                      -- ^ @%n ->@-                                           ---                                           -- Generalised arrow type with multiplicity argument-          | EqualityT                      -- ^ @~@-          | ListT                          -- ^ @[]@-          | PromotedTupleT Int             -- ^ @'()@, @'(,)@, @'(,,)@, etc.-          | PromotedNilT                   -- ^ @'[]@-          | PromotedConsT                  -- ^ @'(:)@-          | StarT                          -- ^ @*@-          | ConstraintT                    -- ^ @Constraint@-          | LitT TyLit                     -- ^ @0@, @1@, @2@, etc.-          | WildCardT                      -- ^ @_@-          | ImplicitParamT String Type     -- ^ @?x :: t@-      deriving( Show, Eq, Ord, Data, Generic )--data Specificity = SpecifiedSpec          -- ^ @a@-                 | InferredSpec           -- ^ @{a}@-      deriving( Show, Eq, Ord, Data, Generic )---- | The @flag@ type parameter is instantiated to one of the following types:------   * 'Specificity' (examples: 'ForallC', 'ForallT')---   * 'BndrVis' (examples: 'DataD', 'ClassD', etc.)---   * '()', a catch-all type for other forms of binders, including 'ForallVisT', 'DataInstD', 'RuleP', and 'TyVarSig'----data TyVarBndr flag = PlainTV  Name flag      -- ^ @a@-                    | KindedTV Name flag Kind -- ^ @(a :: k)@-      deriving( Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable )--data BndrVis = BndrReq                    -- ^ @a@-             | BndrInvis                  -- ^ @\@a@-      deriving( Show, Eq, Ord, Data, Generic )---- | Type family result signature-data FamilyResultSig = NoSig              -- ^ no signature-                     | KindSig  Kind      -- ^ @k@-                     | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@-      deriving( Show, Eq, Ord, Data, Generic )---- | Injectivity annotation-data InjectivityAnn = InjectivityAnn Name [Name]-  deriving ( Show, Eq, Ord, Data, Generic )--data TyLit = NumTyLit Integer             -- ^ @2@-           | StrTyLit String              -- ^ @\"Hello\"@-           | CharTyLit Char               -- ^ @\'C\'@, @since 4.16.0.0-  deriving ( Show, Eq, Ord, Data, Generic )---- | Role annotations-data Role = NominalR            -- ^ @nominal@-          | RepresentationalR   -- ^ @representational@-          | PhantomR            -- ^ @phantom@-          | InferR              -- ^ @_@-  deriving( Show, Eq, Ord, Data, Generic )---- | Annotation target for reifyAnnotations-data AnnLookup = AnnLookupModule Module-               | AnnLookupName Name-               deriving( Show, Eq, Ord, Data, Generic )---- | To avoid duplication between kinds and types, they--- are defined to be the same. Naturally, you would never--- have a type be 'StarT' and you would never have a kind--- be 'SigT', but many of the other constructors are shared.--- Note that the kind @Bool@ is denoted with 'ConT', not--- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',--- not 'PromotedTupleT'.--type Kind = Type--{- Note [Representing concrete syntax in types]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Haskell has a rich concrete syntax for types, including-  t1 -> t2, (t1,t2), [t], and so on-In TH we represent all of this using AppT, with a distinguished-type constructor at the head.  So,-  Type              TH representation-  ------------------------------------------------  t1 -> t2          ArrowT `AppT` t2 `AppT` t2-  [t]               ListT `AppT` t-  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2-  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2--But if the original HsSyn used prefix application, we won't use-these special TH constructors.  For example-  [] t              ConT "[]" `AppT` t-  (->) t            ConT "->" `AppT` t-In this way we can faithfully represent in TH whether the original-HsType used concrete syntax or not.--The one case that doesn't fit this pattern is that of promoted lists-  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2-but it's very smelly because there really is no type constructor-corresponding to PromotedListT. So we encode HsExplicitListTy with-PromotedConsT and PromotedNilT (which *do* have underlying type-constructors):-  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`-                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)--}---- | A location at which to attach Haddock documentation.--- Note that adding documentation to a 'Name' defined oustide of the current--- module will cause an error.-data DocLoc-  = ModuleDoc         -- ^ At the current module's header.-  | DeclDoc Name      -- ^ At a declaration, not necessarily top level.-  | ArgDoc Name Int   -- ^ At a specific argument of a function, indexed by its-                      -- position.-  | InstDoc Type      -- ^ At a class or family instance.-  deriving ( Show, Eq, Ord, Data, Generic )----------------------------------------------------------              Internal helper functions--------------------------------------------------------cmpEq :: Ordering -> Bool-cmpEq EQ = True-cmpEq _  = False--thenCmp :: Ordering -> Ordering -> Ordering-thenCmp EQ o2 = o2-thenCmp o1 _  = o1--get_cons_names :: Con -> [Name]-get_cons_names (NormalC n _)     = [n]-get_cons_names (RecC n _)        = [n]-get_cons_names (InfixC _ n _)    = [n]-get_cons_names (ForallC _ _ con) = get_cons_names con--- GadtC can have multiple names, e.g--- > data Bar a where--- >   MkBar1, MkBar2 :: a -> Bar a--- Will have one GadtC with [MkBar1, MkBar2] as names-get_cons_names (GadtC ns _ _)    = ns-get_cons_names (RecGadtC ns _ _) = ns
libraries/template-haskell/template-haskell.cabal view
@@ -3,7 +3,7 @@ -- template-haskell.cabal.  name:           template-haskell-version:        2.22.0.0+version:        2.23.0.0 -- NOTE: Don't forget to update ./changelog.md license:        BSD3 license-file:   LICENSE@@ -43,31 +43,20 @@     exposed-modules:         Language.Haskell.TH         Language.Haskell.TH.Lib+        Language.Haskell.TH.Lib.Internal         Language.Haskell.TH.Ppr         Language.Haskell.TH.PprLib         Language.Haskell.TH.Quote         Language.Haskell.TH.Syntax         Language.Haskell.TH.LanguageExtensions         Language.Haskell.TH.CodeDo-        Language.Haskell.TH.Lib.Internal -    other-modules:-        Language.Haskell.TH.Lib.Map-     build-depends:-        base        >= 4.11 && < 4.21,-        ghc-boot-th == 9.10.3,-        ghc-prim,-        pretty      == 1.1.*+        base        >= 4.11 && < 4.22,+        ghc-boot-th == 9.12.1      build-depends:-        filepath+      filepath     hs-source-dirs: .-    default-extensions:-      ImplicitPrelude      ghc-options: -Wall--    -- We need to set the unit ID to template-haskell (without a-    -- version number) as it's magic.-    ghc-options: -this-unit-id template-haskell
rts/include/stg/MachRegs/x86.h view
@@ -107,9 +107,15 @@ #define REG_MachSp  rsp  /*-Map both Fn and Dn to register xmmn so that we can pass a function any-combination of up to six Float# or Double# arguments without touching-the stack. See Note [Overlapping global registers] for implications.+Map Fn, Dn and XMMn to register xmmn.+This unfortunately conflicts with the C calling convention, where the first+argument and destination registers is xmm0, but the GHC calling convention in+LLVM starts with xmm1 instead (and we can't easily change that).++The aliasing allows us to pass a function any combination of up to+six Float#, Double# or vector arguments without touching the stack+(when using the System V calling convention).+See Note [Overlapping global registers] for implications. */  #define REG_F1    xmm1