packages feed

ghc-exactprint 1.8.0.0 → 1.9.0.0

raw patch · 2334 files changed

+44869/−45190 lines, 2334 filesdep −Cabal-syntaxdep −bytestringdep −data-defaultdep ~Diffdep ~HUnitdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: Cabal-syntax, bytestring, data-default, filemanip, free, ordered-containers, temporary, text, turtle

Dependency ranges changed: Diff, HUnit, base, containers, directory, extra, filepath, ghc, ghc-boot, ghc-paths, mtl, syb, time

API changes (from Hackage documentation)

- Language.Haskell.GHC.ExactPrint: BlankEpAnnotations :: BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint: BlankSrcSpan :: BlankSrcSpan
- Language.Haskell.GHC.ExactPrint: BlankSrcSpanFile :: BlankSrcSpan
- Language.Haskell.GHC.ExactPrint: NoBlankEpAnnotations :: BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint: NoBlankSrcSpan :: BlankSrcSpan
- Language.Haskell.GHC.ExactPrint: data BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint: data BlankSrcSpan
- Language.Haskell.GHC.ExactPrint: showAst :: Data a => a -> String
- Language.Haskell.GHC.ExactPrint: showAstData :: Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
- Language.Haskell.GHC.ExactPrint.Dump: BlankEpAnnotations :: BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint.Dump: BlankSrcSpan :: BlankSrcSpan
- Language.Haskell.GHC.ExactPrint.Dump: BlankSrcSpanFile :: BlankSrcSpan
- Language.Haskell.GHC.ExactPrint.Dump: NoBlankEpAnnotations :: BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint.Dump: NoBlankSrcSpan :: BlankSrcSpan
- Language.Haskell.GHC.ExactPrint.Dump: data BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint.Dump: data BlankSrcSpan
- Language.Haskell.GHC.ExactPrint.Dump: instance GHC.Classes.Eq Language.Haskell.GHC.ExactPrint.Dump.BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint.Dump: instance GHC.Classes.Eq Language.Haskell.GHC.ExactPrint.Dump.BlankSrcSpan
- Language.Haskell.GHC.ExactPrint.Dump: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.Dump.BlankEpAnnotations
- Language.Haskell.GHC.ExactPrint.Dump: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.Dump.BlankSrcSpan
- Language.Haskell.GHC.ExactPrint.Dump: showAstData :: Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Base.Monoid w => GHC.Base.Monoid (Language.Haskell.GHC.ExactPrint.ExactPrint.EPWriter w)
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Base.Monoid w => GHC.Base.Semigroup (Language.Haskell.GHC.ExactPrint.ExactPrint.EPWriter w)
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.ExactPrint.CanUpdateAnchor
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.ExactPrint.FlushComments
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (GHC.Parser.Annotation.LocatedA body) => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (Language.Haskell.Syntax.Pat.HsFieldBind (GHC.Parser.Annotation.LocatedAn GHC.Parser.Annotation.NoEpAnns (Language.Haskell.Syntax.Type.AmbiguousFieldOcc GHC.Hs.Extension.GhcPs)) (GHC.Parser.Annotation.LocatedA body))
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint GHC.Base.Void
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint a => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (GHC.Maybe.Maybe a)
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint body => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (Language.Haskell.Syntax.Pat.HsFieldBind (GHC.Parser.Annotation.LocatedAn GHC.Parser.Annotation.NoEpAnns (Language.Haskell.Syntax.Type.FieldOcc GHC.Hs.Extension.GhcPs)) body)
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasEntry (GHC.Parser.Annotation.EpAnn a)
- Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasEntry (GHC.Parser.Annotation.SrcSpanAnn' (GHC.Parser.Annotation.EpAnn an))
- Language.Haskell.GHC.ExactPrint.ExactPrint: showAst :: Data a => a -> String
- Language.Haskell.GHC.ExactPrint.Lookup: [commentAnchor] :: Comment -> !Anchor
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.AnnsModule
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Binds.AnnSig
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Decls.HsRuleAnn
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.AnnExplicitSum
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.AnnFieldLabel
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.AnnProjection
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.AnnsIf
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.EpAnnHsCase
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.EpAnnUnboundVar
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Expr.GrhsAnn
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.ImpExp.EpAnnImportDecl
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Hs.Pat.EpAnnSumPat
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AddEpAnn
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AnnContext
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AnnKeywordId
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AnnList
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AnnListItem
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AnnParen
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.AnnPragma
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.EpaLocation
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.NameAnn
- Language.Haskell.GHC.ExactPrint.Orphans: instance Data.Default.Class.Default GHC.Parser.Annotation.NoEpAnns
- Language.Haskell.GHC.ExactPrint.Orphans: instance GHC.Base.Semigroup GHC.Hs.ImpExp.EpAnnImportDecl
- Language.Haskell.GHC.ExactPrint.Orphans: instance GHC.Base.Semigroup GHC.Types.SrcLoc.RealSrcSpan
- Language.Haskell.GHC.ExactPrint.Preprocess: showErrorMessages :: Diagnostic a => Messages a -> String
- Language.Haskell.GHC.ExactPrint.Transform: balanceCommentsList' :: forall (m :: Type -> Type) a. Monad m => [LocatedA a] -> TransformT m [LocatedA a]
- Language.Haskell.GHC.ExactPrint.Transform: captureOrder :: [LocatedA b] -> AnnSortKey
- Language.Haskell.GHC.ExactPrint.Transform: instance Control.Monad.Fail.MonadFail m => Control.Monad.Fail.MonadFail (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Functor m => GHC.Base.Functor (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Monad m => Control.Monad.Reader.Class.MonadReader () (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Monad m => Control.Monad.State.Class.MonadState GHC.Types.Int (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Monad m => Control.Monad.Writer.Class.MonadWriter [GHC.Base.String] (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Monad m => GHC.Base.Applicative (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Monad m => GHC.Base.Monad (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Base.Monad m => Language.Haskell.GHC.ExactPrint.Transform.HasTransform (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
- Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.Transform.WithWhere
- Language.Haskell.GHC.ExactPrint.Transform: m0 :: AnchorOperation
- Language.Haskell.GHC.ExactPrint.Transform: m1 :: AnchorOperation
- Language.Haskell.GHC.ExactPrint.Transform: mn :: Int -> AnchorOperation
- Language.Haskell.GHC.ExactPrint.Types: [commentAnchor] :: Comment -> !Anchor
- Language.Haskell.GHC.ExactPrint.Types: instance Data.Data.Data Language.Haskell.GHC.ExactPrint.Types.Comment
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Num.Num Language.Haskell.GHC.ExactPrint.Types.LayoutStartCol
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.Types.Comment
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.Types.LayoutStartCol
- Language.Haskell.GHC.ExactPrint.Types: instance GHC.Show.Show Language.Haskell.GHC.ExactPrint.Types.Rigidity
- Language.Haskell.GHC.ExactPrint.Utils: anchorToEpaLocation :: Anchor -> EpaLocation
- Language.Haskell.GHC.ExactPrint.Utils: hackAnchorToSrcSpan :: Anchor -> SrcSpan
- Language.Haskell.GHC.ExactPrint.Utils: hackSrcSpanToAnchor :: SrcSpan -> Anchor
- Language.Haskell.GHC.ExactPrint.Utils: isKWComment :: Comment -> Bool
- Language.Haskell.GHC.ExactPrint.Utils: isListComp :: HsDoFlavour -> Bool
- Language.Haskell.GHC.ExactPrint.Utils: locatedAnAnchor :: LocatedAn a t -> RealSrcSpan
- Language.Haskell.GHC.ExactPrint.Utils: moveAnchor :: Monoid b => SrcAnn a -> SrcAnn b
- Language.Haskell.GHC.ExactPrint.Utils: noKWComments :: [Comment] -> [Comment]
- Language.Haskell.GHC.ExactPrint.Utils: orderByKey :: [(RealSrcSpan, a)] -> [RealSrcSpan] -> [(RealSrcSpan, a)]
- Language.Haskell.GHC.ExactPrint.Utils: printDecorator :: HsDocStringDecorator -> String
- Language.Haskell.GHC.ExactPrint.Utils: setAnchorAn :: Default an => LocatedAn an a -> Anchor -> EpAnnComments -> LocatedAn an a
- Language.Haskell.GHC.ExactPrint.Utils: setAnchorEpa :: Default an => EpAnn an -> Anchor -> EpAnnComments -> EpAnn an
- Language.Haskell.GHC.ExactPrint.Utils: setAnchorEpaL :: EpAnn AnnList -> Anchor -> EpAnnComments -> EpAnn AnnList
- Language.Haskell.GHC.ExactPrint.Utils: setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs
- Language.Haskell.GHC.ExactPrint.Utils: tweakDelta :: DeltaPos -> DeltaPos
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Internal.Base.Monoid w => GHC.Internal.Base.Monoid (Language.Haskell.GHC.ExactPrint.ExactPrint.EPWriter w)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Internal.Base.Monoid w => GHC.Internal.Base.Semigroup (Language.Haskell.GHC.ExactPrint.ExactPrint.EPWriter w)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Internal.Data.Data.Data Language.Haskell.GHC.ExactPrint.ExactPrint.CanUpdateAnchor
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Internal.Data.Data.Data Language.Haskell.GHC.ExactPrint.ExactPrint.HsModuleImpDecls
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.ExactPrint.CanUpdateAnchor
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.ExactPrint.FlushComments
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (GHC.Parser.Annotation.LocatedA body) => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (Language.Haskell.Syntax.Pat.HsFieldBind (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Type.AmbiguousFieldOcc GHC.Hs.Extension.GhcPs)) (GHC.Parser.Annotation.LocatedA body))
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (Language.Haskell.Syntax.Binds.HsMultAnn GHC.Hs.Extension.GhcPs)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (Language.Haskell.Syntax.Type.HsTyPat GHC.Hs.Extension.GhcPs)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint GHC.Hs.Binds.NamespaceSpecifier
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint GHC.Internal.Base.Void
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint Language.Haskell.GHC.ExactPrint.ExactPrint.HsModuleImpDecls
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint a => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (GHC.Internal.Maybe.Maybe a)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint a => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (GHC.Parser.Annotation.LocatedE a)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint body => Language.Haskell.GHC.ExactPrint.ExactPrint.ExactPrint (Language.Haskell.Syntax.Pat.HsFieldBind (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Type.FieldOcc GHC.Hs.Extension.GhcPs)) body)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing (GHC.Internal.Maybe.Maybe GHC.Hs.Expr.EpAnnUnboundVar)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing (GHC.Parser.Annotation.AddEpAnn, GHC.Parser.Annotation.AddEpAnn)
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.AnnsModule
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Binds.AnnSig
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Decls.HsRuleAnn
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Expr.AnnExplicitSum
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Expr.AnnFieldLabel
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Expr.AnnProjection
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Expr.AnnsIf
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Expr.EpAnnHsCase
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Expr.GrhsAnn
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.ImpExp.EpAnnImportDecl
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Hs.Pat.EpAnnSumPat
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.AddEpAnn
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.AnnContext
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.AnnList
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.AnnListItem
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.AnnParen
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.AnnPragma
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.EpaLocation
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.NameAnn
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Parser.Annotation.NoEpAnns
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing GHC.Types.Bool
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing [GHC.Parser.Annotation.AddEpAnn]
+ Language.Haskell.GHC.ExactPrint.ExactPrint: instance Language.Haskell.GHC.ExactPrint.ExactPrint.HasTrailing a => Language.Haskell.GHC.ExactPrint.ExactPrint.HasEntry (GHC.Parser.Annotation.EpAnn a)
+ Language.Haskell.GHC.ExactPrint.Lookup: [commentLoc] :: Comment -> !NoCommentsLocation
+ Language.Haskell.GHC.ExactPrint.Transform: balanceCommentsListA :: forall (m :: Type -> Type) a. Monad m => [LocatedA a] -> TransformT m [LocatedA a]
+ Language.Haskell.GHC.ExactPrint.Transform: captureOrderBinds :: [LHsDecl GhcPs] -> AnnSortKey BindTag
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Monad m => Control.Monad.Reader.Class.MonadReader () (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Monad m => Control.Monad.State.Class.MonadState GHC.Types.Int (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Monad m => Control.Monad.Writer.Class.MonadWriter [GHC.Internal.Base.String] (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Monad m => GHC.Internal.Base.Applicative (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Base.Monad m => Language.Haskell.GHC.ExactPrint.Transform.HasTransform (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Control.Monad.Fail.MonadFail m => GHC.Internal.Control.Monad.Fail.MonadFail (Language.Haskell.GHC.ExactPrint.Transform.TransformT m)
+ Language.Haskell.GHC.ExactPrint.Transform: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.Transform.WithWhere
+ Language.Haskell.GHC.ExactPrint.Transform: instance Language.Haskell.GHC.ExactPrint.Transform.HasDecls (GHC.Parser.Annotation.LocatedA (Language.Haskell.Syntax.Decls.HsDecl GHC.Hs.Extension.GhcPs))
+ Language.Haskell.GHC.ExactPrint.Transform: setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs
+ Language.Haskell.GHC.ExactPrint.Types: [commentLoc] :: Comment -> !NoCommentsLocation
+ Language.Haskell.GHC.ExactPrint.Types: instance GHC.Internal.Data.Data.Data Language.Haskell.GHC.ExactPrint.Types.Comment
+ Language.Haskell.GHC.ExactPrint.Types: instance GHC.Internal.Num.Num Language.Haskell.GHC.ExactPrint.Types.LayoutStartCol
+ Language.Haskell.GHC.ExactPrint.Types: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.Types.Comment
+ Language.Haskell.GHC.ExactPrint.Types: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.Types.LayoutStartCol
+ Language.Haskell.GHC.ExactPrint.Types: instance GHC.Internal.Show.Show Language.Haskell.GHC.ExactPrint.Types.Rigidity
+ Language.Haskell.GHC.ExactPrint.Utils: After :: SplitWhere
+ Language.Haskell.GHC.ExactPrint.Utils: Before :: SplitWhere
+ Language.Haskell.GHC.ExactPrint.Utils: allocatePriorComments :: Pos -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
+ Language.Haskell.GHC.ExactPrint.Utils: balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment])
+ Language.Haskell.GHC.ExactPrint.Utils: captureOrderBinds :: [LHsDecl GhcPs] -> AnnSortKey BindTag
+ Language.Haskell.GHC.ExactPrint.Utils: commentOrigDelta :: LEpaComment -> LEpaComment
+ Language.Haskell.GHC.ExactPrint.Utils: data SplitWhere
+ Language.Haskell.GHC.ExactPrint.Utils: decl2Bind :: LHsDecl GhcPs -> [LHsBind GhcPs]
+ Language.Haskell.GHC.ExactPrint.Utils: decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]
+ Language.Haskell.GHC.ExactPrint.Utils: eloc2str :: EpaLocation -> String
+ Language.Haskell.GHC.ExactPrint.Utils: epaCommentsBalanced :: [LEpaComment] -> [LEpaComment] -> EpAnnComments
+ Language.Haskell.GHC.ExactPrint.Utils: hsDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Utils: hsDeclsLocalBinds :: HsLocalBinds GhcPs -> [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Utils: hsDeclsValBinds :: HsValBindsLR GhcPs GhcPs -> [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Utils: insertRemainingCppComments :: ParsedSource -> [LEpaComment] -> ParsedSource
+ Language.Haskell.GHC.ExactPrint.Utils: insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])
+ Language.Haskell.GHC.ExactPrint.Utils: notDocDecl :: LHsDecl GhcPs -> Bool
+ Language.Haskell.GHC.ExactPrint.Utils: notIEDoc :: LIE GhcPs -> Bool
+ Language.Haskell.GHC.ExactPrint.Utils: orderedDecls :: AnnSortKey DeclTag -> DeclsByTag a -> [(RealSrcSpan, a)]
+ Language.Haskell.GHC.ExactPrint.Utils: orderedDeclsBinds :: AnnSortKey BindTag -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Utils: partitionWithSortKey :: [LHsDecl GhcPs] -> ([DeclTag], LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs], [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
+ Language.Haskell.GHC.ExactPrint.Utils: priorCommentsDeltas' :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
+ Language.Haskell.GHC.ExactPrint.Utils: replaceDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs
+ Language.Haskell.GHC.ExactPrint.Utils: showAst :: Data a => a -> String
+ Language.Haskell.GHC.ExactPrint.Utils: splitOnWhere :: SplitWhere -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
+ Language.Haskell.GHC.ExactPrint.Utils: type DeclsByTag a = Map DeclTag [(RealSrcSpan, a)]
+ Language.Haskell.GHC.ExactPrint.Utils: workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
+ Language.Haskell.GHC.ExactPrint.Utils: wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs
+ Language.Haskell.GHC.ExactPrint.Utils: wrapSig :: LSig GhcPs -> LHsDecl GhcPs
- Language.Haskell.GHC.ExactPrint: setAnnotationAnchor :: ExactPrint a => a -> Anchor -> EpAnnComments -> a
+ Language.Haskell.GHC.ExactPrint: setAnnotationAnchor :: ExactPrint a => a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
- Language.Haskell.GHC.ExactPrint.ExactPrint: setAnnotationAnchor :: ExactPrint a => a -> Anchor -> EpAnnComments -> a
+ Language.Haskell.GHC.ExactPrint.ExactPrint: setAnnotationAnchor :: ExactPrint a => a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a
- Language.Haskell.GHC.ExactPrint.Lookup: Comment :: !String -> !Anchor -> !RealSrcSpan -> !Maybe AnnKeywordId -> Comment
+ Language.Haskell.GHC.ExactPrint.Lookup: Comment :: !String -> !NoCommentsLocation -> !RealSrcSpan -> !Maybe AnnKeywordId -> Comment
- Language.Haskell.GHC.ExactPrint.Transform: captureLineSpacing :: Default t => [LocatedAn t e] -> [LocatedAn t e]
+ Language.Haskell.GHC.ExactPrint.Transform: captureLineSpacing :: [LocatedA e] -> [LocatedA e]
- Language.Haskell.GHC.ExactPrint.Transform: hsDeclsPatBind :: forall (m :: Type -> Type). Monad m => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Transform: hsDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
- Language.Haskell.GHC.ExactPrint.Transform: hsDeclsPatBindD :: forall (m :: Type -> Type). Monad m => LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Transform: hsDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs]
- Language.Haskell.GHC.ExactPrint.Transform: hsDeclsValBinds :: forall (m :: Type -> Type). Monad m => HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]
+ Language.Haskell.GHC.ExactPrint.Transform: hsDeclsValBinds :: HsValBindsLR GhcPs GhcPs -> [LHsDecl GhcPs]
- Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDP :: Monoid ann => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
+ Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDP :: NoAnn ann => DeltaPos -> EpAnn ann
- Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDP0 :: Monoid ann => SrcSpan -> SrcSpanAnn' (EpAnn ann)
+ Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDP0 :: NoAnn ann => EpAnn ann
- Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDP1 :: Monoid ann => SrcSpan -> SrcSpanAnn' (EpAnn ann)
+ Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDP1 :: NoAnn ann => EpAnn ann
- Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDPn :: Monoid ann => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann)
+ Language.Haskell.GHC.ExactPrint.Transform: noAnnSrcSpanDPn :: NoAnn ann => Int -> EpAnn ann
- Language.Haskell.GHC.ExactPrint.Transform: setEntryDP :: Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
+ Language.Haskell.GHC.ExactPrint.Transform: setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a
- Language.Haskell.GHC.ExactPrint.Transform: transferEntryDP :: forall (m :: Type -> Type) t2 t1 a b. (Monad m, Monoid t2, Typeable t1, Typeable t2) => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
+ Language.Haskell.GHC.ExactPrint.Transform: transferEntryDP :: forall (m :: Type -> Type) t1 t2 a b. (Monad m, Typeable t1, Typeable t2) => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
- Language.Haskell.GHC.ExactPrint.Types: Comment :: !String -> !Anchor -> !RealSrcSpan -> !Maybe AnnKeywordId -> Comment
+ Language.Haskell.GHC.ExactPrint.Types: Comment :: !String -> !NoCommentsLocation -> !RealSrcSpan -> !Maybe AnnKeywordId -> Comment
- Language.Haskell.GHC.ExactPrint.Utils: mkComment :: String -> Anchor -> RealSrcSpan -> Comment
+ Language.Haskell.GHC.ExactPrint.Utils: mkComment :: String -> NoCommentsLocation -> RealSrcSpan -> Comment
- Language.Haskell.GHC.ExactPrint.Utils: mkKWComment :: AnnKeywordId -> EpaLocation -> Comment
+ Language.Haskell.GHC.ExactPrint.Utils: mkKWComment :: AnnKeywordId -> NoCommentsLocation -> Comment
- Language.Haskell.GHC.ExactPrint.Utils: mkLEpaComment :: String -> Anchor -> RealSrcSpan -> LEpaComment
+ Language.Haskell.GHC.ExactPrint.Utils: mkLEpaComment :: String -> NoCommentsLocation -> RealSrcSpan -> LEpaComment

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

ChangeLog view
@@ -1,3 +1,5 @@+2024-05-16 v1.9.0.0+	* Support GHC 9.10.1 2022-12-19 v1.8.0.0 	* Support GHC 9.8.1 2022-12-19 v1.7.1.0
ghc-exactprint.cabal view
@@ -1,45 +1,30 @@+cabal-version:       2.4 name:                ghc-exactprint-version:             1.8.0.0+version:             1.9.0.0 synopsis:            ExactPrint for GHC description:         Using the API Annotations available from GHC 9.2.1, this                      library provides a means to round trip any code that can                      be compiled by GHC, currently excluding lhs files.                      .-                     Note: requires GHC 9.8.*. For earlier GHC+                     Note: requires GHC 9.10.*. For earlier GHC                      versions see lower version numbers.                      . -license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              Alan Zimmerman, Matthew Pickering maintainer:          alan.zimm@gmail.com category:            Development build-type:          Simple-tested-with:         GHC == 9.8.1-extra-source-files:  ChangeLog-                     tests/examples/failing/*.hs-                     tests/examples/ghc710-only/*.hs-                     tests/examples/ghc710/*.hs-                     tests/examples/ghc80/*.hs-                     tests/examples/ghc810/*.hs-                     tests/examples/ghc82/*.hs-                     tests/examples/ghc84/*.hs-                     tests/examples/ghc86/*.hs-                     tests/examples/ghc88/*.hs-                     tests/examples/ghc90/*.hs-                     tests/examples/ghc92/*.hs-                     tests/examples/ghc94/*.hs-                     tests/examples/ghc96/*.hs-                     tests/examples/ghc98/*.hs-                     tests/examples/pre-ghc810/*.hs-                     tests/examples/pre-ghc86/*.hs-                     tests/examples/pre-ghc90/*.hs-                     tests/examples/vect/*.hs-                     tests/examples/transform/*.hs+tested-with:         GHC == 9.10.1+extra-doc-files:     ChangeLog+extra-source-files:  tests/examples/failing/*.hs                      tests/examples/failing/*.hs.bad+                     tests/examples/ghc910/*.hs+                     tests/examples/pre-ghc910/*.hs+                     tests/examples/pre-ghc910/*.hs-boot+                     tests/examples/transform/*.hs                      tests/examples/transform/*.hs.expected-                     tests/examples/ghc710/*.hs-boot-cabal-version:       >=1.10  source-repository head   type:     git@@ -55,44 +40,34 @@   Default:     False } +common warnings+  GHC-options: -Wall -Wredundant-constraints -Wunused-packages  library+  import: warnings   exposed-modules:     Language.Haskell.GHC.ExactPrint-                     , Language.Haskell.GHC.ExactPrint.Dump                      , Language.Haskell.GHC.ExactPrint.ExactPrint                      , Language.Haskell.GHC.ExactPrint.Lookup-                     , Language.Haskell.GHC.ExactPrint.Orphans                      , Language.Haskell.GHC.ExactPrint.Parsers                      , Language.Haskell.GHC.ExactPrint.Preprocess                      , Language.Haskell.GHC.ExactPrint.Transform                      , Language.Haskell.GHC.ExactPrint.Types                      , Language.Haskell.GHC.ExactPrint.Utils -   hs-source-dirs:      src-  -- other-modules:-  -- other-extensions:-  GHC-Options:         -Wall -Wredundant-constraints-  -- GHC-Options:         -Weverything-  build-depends:       base >=4.19 && <4.20-                     , bytestring >= 0.10.6-                     , containers >= 0.5-                     , ordered-containers-                     , data-default-                     , directory >= 1.2-                     , filepath  >= 1.4-                     , ghc       >= 9.8.1-                     , mtl       >= 2.2.1-                     , syb       >= 0.5-                     , free      >= 4.12-                     , ghc-boot-+  build-depends:       base >=4.20 && <4.21+                     , containers >= 0.5  && < 0.8+                     , ghc       >= 9.10 && < 9.11+                     , ghc-boot  >= 9.10 && < 9.11+                     , mtl       >= 2.2.1 && < 2.5+                     , syb       >= 0.5 && < 0.8    default-language:    Haskell2010-  if impl (ghc < 9.8)-      buildable: False+  if impl (ghc < 9.10)+    buildable: False  Test-Suite test+  import: warnings   type:                exitcode-stdio-1.0   if flag (dev)     hs-source-dirs:      tests@@ -105,95 +80,89 @@                      , Test.CommonUtils                      , Test.NoAnnotations                      , Test.Transform-  GHC-Options:         -threaded -Wall -Wredundant-constraints+  GHC-Options:         -threaded   Default-language:    Haskell2010-  Build-depends:       HUnit >= 1.2-                     , base < 4.20-                     , bytestring+  Build-depends:       base < 4.21+                     , HUnit >= 1.2                      , containers >= 0.5-                     , ordered-containers-                     , data-default                      , Diff                      , directory >= 1.2                      , extra                      , filepath  >= 1.4-                     , ghc       >= 9.8.1+                     , ghc       >= 9.10                      , ghc-paths  >= 0.1-                     , mtl        >= 2.2.1                      , syb        >= 0.5                      , silently   >= 1.2                      , ghc-boot-                     , Cabal-syntax+                     -- , os-string >= 2.0.2   if flag (dev)-      build-depends: free+      build-depends:+                     mtl        >= 2.2.1   else       build-depends: ghc-exactprint-  if impl (ghc < 9.8)+  if impl (ghc < 9.10)       buildable: False  executable roundtrip+  import: warnings   main-is: Roundtrip.hs   hs-source-dirs: tests   other-modules: Test.Common                  Test.CommonUtils-                 -- Test.Consistency   default-language:    Haskell2010-  if impl (ghc >= 9.8) && flag (roundtrip)+  if impl (ghc >= 9.10) && flag (roundtrip)     build-depends:-                 HUnit-               , base-               , containers-               , directory-               , extra-               , filemanip-               , filepath-               , ghc+                 HUnit      < 1.7+               , base       < 4.21+               , containers < 0.8+               , directory  < 1.4+               , extra      < 1.8+               , filepath   < 1.6+               , ghc        >= 9.10 && < 9.11                , ghc-exactprint-               , ghc-paths-               , syb-               , temporary-               , time+               , ghc-paths  < 0.2+               , time       < 1.13                , ghc-boot     buildable: True   else     buildable: False-  GHC-Options:         -threaded -Wall -Wredundant-constraints+  GHC-Options: -threaded  executable static+  import: warnings   main-is: Static.hs   hs-source-dirs: tests+  other-modules: Test.CommonUtils   default-language:    Haskell2010   if flag (roundtrip)-    build-depends: base-                 , directory-                 , extra-                 , filemanip-                 , filepath-                 , ghc-                 , Diff-                 , ghc-boot+    build-depends: base < 4.21+                 , directory < 1.4+                 , extra     < 1.8+                 , filepath  < 1.6+                 , ghc       >= 9.10 && < 9.11+                 , Diff      < 0.6     buildable: True   else     buildable: False-  GHC-Options:         -threaded -Wall -Wredundant-constraints+  GHC-Options: -threaded -executable prepare-hackage-  main-is: PrepareHackage.hs-  hs-source-dirs: tests-  default-language:    Haskell2010-  if flag (roundtrip)-    build-depends: base-                 , containers-                 , directory-                 , extra-                 , filemanip-                 , filepath-                 , ghc       >= 9.8.1-                 , HUnit-                 , text   >= 1.2.2-                 , turtle >= 1.3.0-                 , ghc-boot-    buildable: True-  else-    buildable: False-  GHC-Options:         -threaded -Wall -Wredundant-constraints+-- executable prepare-hackage+--   import: warnings+--   main-is: PrepareHackage.hs+--   other-modules: Test.CommonUtils+--   hs-source-dirs: tests+--   default-language:    Haskell2010+--   if flag (roundtrip)+--     build-depends: base < 4.21+--                  , containers+--                  , directory+--                  , extra+--                  , filepath+--                  , ghc       >= 9.10+--                  , HUnit+--                  , text   >= 1.2.2+--                  , turtle >= 1.3.0+--     buildable: True+--   else+--     buildable: False+--   GHC-Options: -threaded
src/Language/Haskell/GHC/ExactPrint.hs view
@@ -16,17 +16,8 @@          -- * Relativising         , makeDeltaAst---        -- * Dumping ASTs-        , showAst-        -- ** Temporary copy from GHC, shows AnchorOps embedded in SrcSpan-        , showAstData-        , BlankSrcSpan(..)-        , BlankEpAnnotations(..)         ) where -import Language.Haskell.GHC.ExactPrint.Dump import Language.Haskell.GHC.ExactPrint.ExactPrint import Language.Haskell.GHC.ExactPrint.Transform import Language.Haskell.GHC.ExactPrint.Types
− src/Language/Haskell/GHC/ExactPrint/Dump.hs 
@@ -1,305 +0,0 @@--{--Temporary copy of the GHC.Hs.Dump module, modified to show DeltaPos-hacked into a SrcSpan.--}--{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Language.Haskell.GHC.ExactPrint.Dump (-        -- * Dumping ASTs-        showAstData,-        BlankSrcSpan(..),-        BlankEpAnnotations(..),-    ) where--import Prelude ()-import GHC.Prelude--import GHC.Hs hiding ( ann, anns, deltaPos, realSrcSpan )--import GHC.Core.DataCon--import GHC.Data.Bag-import GHC.Data.FastString-import GHC.Types.Name.Set-import GHC.Types.Name hiding ( occName )-import GHC.Types.SrcLoc-import GHC.Types.Var-import GHC.Types.SourceText-import GHC.Utils.Outputable--import Data.Data hiding (Fixity)-import qualified Data.ByteString as B--import Data.Generics (extQ, ext1Q, ext2Q)--data BlankSrcSpan = BlankSrcSpan | BlankSrcSpanFile | NoBlankSrcSpan-                  deriving (Eq,Show)--data BlankEpAnnotations = BlankEpAnnotations | NoBlankEpAnnotations-                  deriving (Eq,Show)---- | Show a GHC syntax tree. This parameterised because it is also used for--- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked--- out, to avoid comparing locations, only structure-showAstData :: Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc-showAstData bs ba a0 = blankLine $$ showAstData' a0-  where-    showAstData' :: Data a => a -> SDoc-    showAstData' =-      generic-              `ext1Q` list-              `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan-              `extQ` annotation-              `extQ` annotationModule-              `extQ` annotationAddEpAnn-              `extQ` annotationGrhsAnn-              `extQ` annotationEpAnnHsCase-              `extQ` annotationAnnList-              `extQ` annotationEpAnnImportDecl-              `extQ` annotationAnnParen-              `extQ` annotationTrailingAnn-              `extQ` annotationEpaLocation-              `extQ` annotationNoEpAnns-              `extQ` addEpAnn-              `extQ` lit `extQ` litr `extQ` litt-              `extQ` sourceText-              `extQ` deltaPos-              `extQ` epaAnchor-              `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-              `extQ` srcSpanAnnP-              `extQ` srcSpanAnnC-              `extQ` srcSpanAnnN--      where generic :: Data a => a -> SDoc-            generic t = parens $ text (showConstr (toConstr t))-                                  $$ vcat (gmapQ showAstData' t)--            string :: String -> SDoc-            string     = text . normalize_newlines . show--            fastString :: FastString -> SDoc-            fastString s = braces $-                            text "FastString:"-                        <+> text (normalize_newlines . show $ s)--            bytestring :: B.ByteString -> SDoc-            bytestring = text . normalize_newlines . show--            list []    = brackets empty-            list [x]   = brackets (showAstData' x)-            list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)-                                $$ go x2 xs-              where-                go y [] = text "," <> showAstData' y <> text "]"-                go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys--            -- Eliminate word-size dependence-            lit :: HsLit GhcPs -> SDoc-            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s-            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s-            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s-            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s-            lit l                  = generic l--            litr :: HsLit GhcRn -> SDoc-            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s-            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s-            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s-            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s-            litr l                  = generic l--            litt :: HsLit GhcTc -> SDoc-            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s-            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s-            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s-            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s-            litt l                  = generic l--            numericLit :: String -> Integer -> SourceText -> SDoc-            numericLit tag x s = braces $ hsep [ text tag-                                               , generic x-                                               , generic s ]--            sourceText :: SourceText -> SDoc-            sourceText NoSourceText = 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"--            epaAnchor :: EpaLocation -> SDoc-            epaAnchor (EpaSpan r _) = parens $ text "EpaSpan" <+> realSrcSpan r-            epaAnchor (EpaDelta d cs) = case ba of-              NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> showAstData' cs-              BlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> text "blanked"--            deltaPos :: DeltaPos -> SDoc-            deltaPos (SameLine c) = parens $ text "SameLine" <+> ppr c-            deltaPos (DifferentLine l c) = parens $ text "DifferentLine" <+> ppr l <+> ppr c--            name :: Name -> SDoc-            name nm    = braces $ text "Name:" <+> ppr nm--            occName n  =  braces $-                          text "OccName:"-                      <+> ftext (occNameFS n)--            moduleName :: ModuleName -> SDoc-            moduleName m = braces $ text "ModuleName:" <+> ppr m--            srcSpan :: SrcSpan -> SDoc-            srcSpan ss = case bs of-             BlankSrcSpan -> text "{ ss }"-             NoBlankSrcSpan -> braces $ char ' ' <>-                             (hang (ppr ss) 1-                                   -- TODO: show annotations here-                                   (text ""))-             BlankSrcSpanFile -> braces $ char ' ' <>-                             (hang (pprUserSpan False ss) 1-                                   -- TODO: show annotations here-                                   (text ""))--            realSrcSpan :: RealSrcSpan -> SDoc-            realSrcSpan ss = case bs of-             BlankSrcSpan -> text "{ ss }"-             NoBlankSrcSpan -> braces $ char ' ' <>-                             (hang (ppr ss) 1-                                   -- TODO: show annotations here-                                   (text ""))-             BlankSrcSpanFile -> braces $ char ' ' <>-                             (hang (pprUserRealSpan False ss) 1-                                   -- TODO: show annotations here-                                   (text ""))---            addEpAnn :: AddEpAnn -> SDoc-            addEpAnn (AddEpAnn a s) = case ba of-             BlankEpAnnotations -> parens-                                      $ text "blanked:" <+> text "AddEpAnn"-             NoBlankEpAnnotations ->-              parens $ text "AddEpAnn" <+> ppr a <+> epaAnchor s--            var  :: Var -> SDoc-            var v      = braces $ text "Var:" <+> ppr v--            dataCon :: DataCon -> SDoc-            dataCon c  = braces $ text "DataCon:" <+> ppr c--            bagRdrName:: Bag (LocatedA (HsBind GhcPs)) -> SDoc-            bagRdrName bg =  braces $-                             text "Bag(LocatedA (HsBind GhcPs)):"-                          $$ (list . bagToList $ bg)--            bagName   :: Bag (LocatedA (HsBind GhcRn)) -> SDoc-            bagName bg  =  braces $-                           text "Bag(LocatedA (HsBind Name)):"-                        $$ (list . bagToList $ bg)--            bagVar    :: Bag (LocatedA (HsBind GhcTc)) -> SDoc-            bagVar bg  =  braces $-                          text "Bag(LocatedA (HsBind Var)):"-                       $$ (list . bagToList $ bg)--            nameSet ns =  braces $-                          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"-                        $$ vcat [showAstData' ss, showAstData' a])---            -- ---------------------------            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")--            annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc-            annotationEpAnnImportDecl = annotation' (text "EpAnn EpAnnImportDecl")--            annotationAnnParen :: EpAnn AnnParen -> SDoc-            annotationAnnParen = annotation' (text "EpAnn AnnParen")--            annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc-            annotationTrailingAnn = annotation' (text "EpAnn TrailingAnn")--            annotationEpaLocation :: EpAnn EpaLocation -> SDoc-            annotationEpaLocation = annotation' (text "EpAnn EpaLocation")--            annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc-            annotationNoEpAnns = annotation' (text "EpAnn NoEpAnns")--            annotation' :: forall a .(Data a)-                       => SDoc -> EpAnn a -> SDoc-            annotation' tag anns = case ba of-             BlankEpAnnotations -> parens (text "blanked:" <+> tag)-             NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns))-                                               $$ vcat (gmapQ showAstData' anns)--            -- ---------------------------            srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc-            srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA")--            srcSpanAnnL :: SrcSpanAnn' (EpAnn AnnList) -> SDoc-            srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL")--            srcSpanAnnP :: SrcSpanAnn' (EpAnn AnnPragma) -> SDoc-            srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP")--            srcSpanAnnC :: SrcSpanAnn' (EpAnn AnnContext) -> SDoc-            srcSpanAnnC = locatedAnn'' (text "SrcSpanAnnC")--            srcSpanAnnN :: SrcSpanAnn' (EpAnn NameAnn) -> SDoc-            srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN")--            locatedAnn'' :: forall a. (Data a)-              => SDoc -> SrcSpanAnn' a -> SDoc-            locatedAnn'' tag ss = parens $-              case cast ss of-                Just ((SrcSpanAnn ann s) :: SrcSpanAnn' a) ->-                  case ba of-                    BlankEpAnnotations-                      -> parens (text "blanked:" <+> tag)-                    NoBlankEpAnnotations-                      -> text "SrcSpanAnn" <+> showAstData' ann-                              <+> srcSpan s-                Nothing -> text "locatedAnn:unmatched" <+> tag-                           <+> (parens $ text (showConstr (toConstr ss)))---normalize_newlines :: String -> String-normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs-normalize_newlines (x:xs)                 = x:normalize_newlines xs-normalize_newlines []                     = []
src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs view
@@ -1,5060 +1,5205 @@-{-# LANGUAGE DeriveDataTypeable   #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiWayIf           #-}-{-# LANGUAGE NamedFieldPuns       #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE StandaloneDeriving   #-}-{-# LANGUAGE TupleSections        #-}-{-# LANGUAGE TypeApplications     #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeOperators        #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE ViewPatterns         #-}-{-# LANGUAGE BlockArguments       #-}-{-# LANGUAGE UndecidableInstances  #-} -- For the (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ExactPrint instance-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}--module Language.Haskell.GHC.ExactPrint.ExactPrint-  (-    ExactPrint(..)-  , exactPrint-  , exactPrintWithOptions-  , makeDeltaAst--  -- * Configuration-  , EPOptions(epRigidity, epAstPrint, epTokenPrint, epWhitespacePrint, epUpdateAnchors)-  , stringOptions-  , epOptions-  , deltaOptions--  -- Temporary to avoid import loop problems-  , showAst-  ) where--import GHC-import GHC.Core.Coercion.Axiom (Role(..))-import GHC.Data.Bag-import qualified GHC.Data.BooleanFormula as BF-import GHC.Data.FastString-import GHC.TypeLits-import GHC.Types.Basic hiding (EP)-import GHC.Types.Fixity-import GHC.Types.ForeignCall-import GHC.Types.Name.Reader-import GHC.Types.PkgQual-import GHC.Types.SourceText-import GHC.Types.Var-import GHC.Utils.Outputable hiding ( (<>) )-import GHC.Unit.Module.Warnings-import GHC.Utils.Misc-import GHC.Utils.Panic-import GHC.Base (NonEmpty(..))--import Language.Haskell.Syntax.Basic (FieldLabelString(..))--import Control.Monad (forM, when, unless)-import Control.Monad.Identity (Identity(..))-import qualified Control.Monad.Reader as Reader-import Control.Monad.RWS (MonadReader, RWST, evalRWST, tell, modify, get, gets, ask)-import Control.Monad.Trans (lift)-import Data.Data ( Data )-import Data.Dynamic-import Data.Foldable-import Data.Functor.Const-import qualified Data.Set as Set-import Data.Typeable-import Data.List ( partition, sort, sortBy)-import Data.Maybe ( isJust, mapMaybe )-import Data.Void--import Language.Haskell.GHC.ExactPrint.Dump-import Language.Haskell.GHC.ExactPrint.Lookup-import Language.Haskell.GHC.ExactPrint.Utils-import Language.Haskell.GHC.ExactPrint.Types---- import Debug.Trace---- ------------------------------------------------------------------------- Note: moved from Language.Haskell.GHC.ExactPrint.Utils as a hack to--- avoid import loop problems while we have to use the local version--- of Dump-showAst :: (Data a) => a -> String-showAst ast-  = showSDocUnsafe-    $ showAstData NoBlankSrcSpan NoBlankEpAnnotations ast---- -----------------------------------------------------------------------exactPrint :: ExactPrint ast => ast -> String-exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast))---- | The additional option to specify the rigidity and printing--- configuration.-exactPrintWithOptions :: (ExactPrint ast, Monoid b, Monad m)-                      => EPOptions m b-                      -> ast-                      -> m (ast, b)-exactPrintWithOptions r ast =-    runEP r (markAnnotated ast)---- | Transform concrete annotations into relative annotations which--- are more useful when transforming an AST. This corresponds to the--- earlier 'relativiseApiAnns'.-makeDeltaAst :: ExactPrint ast => ast -> ast-makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast))----------------------------------------------------------type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a--runEP :: (Monad m)-      => EPOptions m w-      -> EP w m a -> m (a, w)-runEP epReader action = do-  (ast, w) <- evalRWST action epReader defaultEPState-  return (ast, output w)---- -----------------------------------------------------------------------defaultEPState :: EPState-defaultEPState = EPState-             { epPos      = (1,1)-             , dLHS       = 1-             , pMarkLayout = False-             , pLHS = 1-             , dMarkLayout = False-             , dPriorEndPosition = (1,1)-             , uAnchorSpan = badRealSrcSpan-             , uExtraDP = Nothing-             , epComments = []-             , epCommentsApplied = []-             , epEof = Nothing-             }----- ------------------------------------------------------------------------ The EP monad and basic combinators---- | The R part of RWS. The environment. Updated via 'local' as we--- enter a new AST element, having a different anchor point.-data EPOptions m a = EPOptions-            {-              epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a-            , epTokenPrint :: String -> m a-            , epWhitespacePrint :: String -> m a-            , epRigidity :: Rigidity-            , epUpdateAnchors :: Bool-            }---- | Helper to create a 'EPOptions'-epOptions ::-      (forall ast . Data ast => GHC.Located ast -> a -> m a)-      -> (String -> m a)-      -> (String -> m a)-      -> Rigidity-      -> Bool-      -> EPOptions m a-epOptions astPrint tokenPrint wsPrint rigidity delta = EPOptions-             {-               epAstPrint = astPrint-             , epWhitespacePrint = wsPrint-             , epTokenPrint = tokenPrint-             , epRigidity = rigidity-             , epUpdateAnchors = delta-             }---- | Options which can be used to print as a normal String.-stringOptions :: EPOptions Identity String-stringOptions = epOptions (\_ b -> return b) return return NormalLayout False---- | Options which can be used to simply update the AST to be in delta--- form, without generating output-deltaOptions :: EPOptions Identity ()-deltaOptions = epOptions (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ()) NormalLayout True--data EPWriter a = EPWriter-              { output :: !a }--instance Monoid w => Semigroup (EPWriter w) where-  (EPWriter a) <> (EPWriter b) = EPWriter (a <> b)--instance Monoid w => Monoid (EPWriter w) where-  mempty = EPWriter mempty--data EPState = EPState-             { uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST-                                          -- reference frame, from-                                          -- Annotation-             , uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a-                                             -- list--             -- Print phase-             , epPos        :: !Pos -- ^ Current output position-             , pMarkLayout  :: !Bool-             , pLHS   :: !LayoutStartCol--             -- Delta phase-             , dPriorEndPosition :: !Pos -- ^ End of Position reached-                                         -- when processing the-                                         -- preceding element-             , dMarkLayout :: !Bool-             , dLHS        :: !LayoutStartCol--             -- Shared-             , epComments :: ![Comment]-             , epCommentsApplied :: ![[Comment]]-             , epEof :: !(Maybe (RealSrcSpan, RealSrcSpan))-             }---- ------------------------------------------------------------------------- AZ:TODO: this can just be a function :: (EpAnn a) -> Entry-class HasEntry ast where-  fromAnn :: ast -> Entry---- ------------------------------------------------------------------------- | Key entry point.  Switches to an independent AST element with its--- own annotation, calculating new offsets, etc-markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a-markAnnotated a = enterAnn (getAnnotationEntry a) a---- | For HsModule, because we do not have a proper SrcSpan, we must--- indicate to flush trailing comments when done.-data FlushComments = FlushComments-                   | NoFlushComments-                   deriving (Eq, Show)---- | For GenLocated SrcSpan, we construct an entry location but cannot update it.-data CanUpdateAnchor = CanUpdateAnchor-                     | CanUpdateAnchorOnly-                     | NoCanUpdateAnchor-                   deriving (Eq, Show)--data Entry = Entry Anchor EpAnnComments FlushComments CanUpdateAnchor-           | NoEntryVal---- | For flagging whether to capture comments in an EpaDelta or not-data CaptureComments = CaptureComments-                     | NoCaptureComments--mkEntry :: Anchor -> EpAnnComments -> Entry-mkEntry anc cs = Entry anc cs NoFlushComments CanUpdateAnchor--instance HasEntry (SrcSpanAnn' (EpAnn an)) where-  fromAnn (SrcSpanAnn EpAnnNotUsed ss) = mkEntry (spanAsAnchor ss) emptyComments-  fromAnn (SrcSpanAnn an _) = fromAnn an--instance HasEntry (EpAnn a) where-  fromAnn (EpAnn anchor _ cs) = mkEntry anchor cs-  fromAnn EpAnnNotUsed = NoEntryVal---- -----------------------------------------------------------------------fromAnn' :: (HasEntry a) => a -> Entry-fromAnn' an = case fromAnn an of-  NoEntryVal -> NoEntryVal-  Entry a c _ u -> Entry a c FlushComments u---- -----------------------------------------------------------------------astId :: (Typeable a) => a -> String-astId a = show (typeOf a)--cua :: (Monad m, Monoid w) => CanUpdateAnchor -> EP w m [a] -> EP w m [a]-cua CanUpdateAnchor f = f-cua CanUpdateAnchorOnly _ = return []-cua NoCanUpdateAnchor _ = return []---- | "Enter" an annotation, by using the associated 'anchor' field as--- the new reference point for calculating all DeltaPos positions.------ This is combination of the ghc=exactprint Delta.withAST and--- Print.exactPC functions and effectively does the delta processing--- immediately followed by the print processing.  JIT ghc-exactprint.-enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a-enterAnn NoEntryVal a = do-  p <- getPosP-  debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a)-  r <- exact a-  debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a)-  return r-enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do-  p <- getPosP-  debugM $ "enterAnn:starting:(p,a) =" ++ show (p, astId a)-  -- debugM $ "enterAnn:(cs) =" ++ showGhc (cs)-  let curAnchor = anchor anchor' -- As a base for the current AST element-  debugM $ "enterAnn:(curAnchor):=" ++ show (rs2range curAnchor)-  case canUpdateAnchor of-    CanUpdateAnchor -> pushAppliedComments-    _ -> return ()-  addCommentsA (priorComments cs)-  debugM $ "enterAnn:Added comments"-  printComments curAnchor-  priorCs <- cua canUpdateAnchor takeAppliedComments -- no pop-  -- --------------------------  case anchor_op anchor' of-    MovedAnchor dp -> do-      debugM $ "enterAnn: MovedAnchor:" ++ show dp-      -- Set the original anchor as prior end, so the rest of this AST-      -- fragment has a reference-      setPriorEndNoLayoutD (ss2pos curAnchor)-    _ -> do-      return ()-  -- --------------------------  if ((fst $ fst $ rs2range curAnchor) >= 0)-    then-      setAnchorU curAnchor-    else-      debugM $ "enterAnn: not calling setAnchorU for : " ++ show (rs2range curAnchor)-  -- --------------------------------------------------------------------  -- Make sure the running dPriorEndPosition gets updated according to-  -- the change in the current anchor.--  -- Compute the distance from dPriorEndPosition to the start of the new span.--  -- While processing in the context of the prior anchor, we choose to-  -- enter a new Anchor, which has a defined position relative to the-  -- prior anchor, even if we do not actively output anything at that-  -- point.-  -- Is this edp?--  -- --------------------------------------------------------------------  -- The first part corresponds to the delta phase, so should only use-  -- delta phase variables ------------------------------------  -- Calculate offset required to get to the start of the SrcSPan-  off <- getLayoutOffsetD-  let spanStart = ss2pos curAnchor-  priorEndAfterComments <- getPriorEndD-  let edp' = adjustDeltaForOffset-               -- Use the propagated offset if one is set-               -- Note that we need to use the new offset if it has-               -- changed.-               off (ss2delta priorEndAfterComments curAnchor)-  debugM $ "enterAnn: (edp',off,priorEndAfterComments,curAnchor):" ++ show (edp',off,priorEndAfterComments,rs2range curAnchor)-  let edp'' = case anchor_op anchor' of-        MovedAnchor dp -> dp-        _ -> edp'-  -- ----------------------------------------------  -- let edp = edp''-  med <- getExtraDP-  setExtraDP Nothing-  let edp = case med of-        Nothing -> edp''-        Just (Anchor _ (MovedAnchor dp)) -> dp-                   -- Replace original with desired one. Allows all-                   -- list entry values to be DP (1,0)-        Just (Anchor r _) -> dp-          where-            dp = adjustDeltaForOffset-                   off (ss2delta priorEndAfterComments r)-  when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ show (med,edp)-  -- ----------------------------------------------  -- Preparation complete, perform the action-  when (priorEndAfterComments < spanStart) (do-    debugM $ "enterAnn.dPriorEndPosition:spanStart=" ++ show spanStart-    modify (\s -> s { dPriorEndPosition    = spanStart } ))--  debugM $ "enterAnn: (anchor_op, curAnchor):" ++ show (anchor_op anchor', rs2range curAnchor)-  debugM $ "enterAnn: (dLHS,spanStart,pec,edp)=" ++ show (off,spanStart,priorEndAfterComments,edp)-  p0 <- getPosP-  d <- getPriorEndD-  debugM $ "enterAnn: (posp, posd)=" ++ show (p0,d)--  -- end of delta phase processing-  -- --------------------------------------------------------------------  -- start of print phase processing--  let mflush = when (flush == FlushComments) $ do-        debugM $ "flushing comments in enterAnn:" ++ showAst cs-        flushComments (getFollowingComments cs)--  advance edp-  a' <- exact a-  mflush--  -- end of sub-Anchor processing, start of tail end processing-  postCs <- cua canUpdateAnchor takeAppliedCommentsPop-  when (flush == NoFlushComments) $ do-    when ((getFollowingComments cs) /= []) $ do-      debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs)-      mapM_ printOneComment (concatMap tokComment $ getFollowingComments cs)-      debugM $ "ending trailing comments"--  eof <- getEofPos-  case eof of-    Nothing -> return ()-    Just (pos, prior) -> do-       let dp = if pos == prior-             then (DifferentLine 1 0)-             else origDelta pos prior-       debugM $ "EOF:(pos,prior,dp) =" ++ showGhc (ss2pos pos, ss2pos prior, dp)-       printStringAtLsDelta dp ""-       setEofPos Nothing -- Only do this once--  let newAchor = anchor' { anchor_op = MovedAnchor edp }-  let r = case canUpdateAnchor of-            CanUpdateAnchor -> setAnnotationAnchor a' newAchor (mkEpaComments (priorCs++ postCs) [])-            CanUpdateAnchorOnly -> setAnnotationAnchor a' newAchor emptyComments-            NoCanUpdateAnchor -> a'-  -- debugM $ "calling setAnnotationAnchor:(curAnchor, newAchor,priorCs,postCs)=" ++ showAst (show (rs2range curAnchor), newAchor, priorCs, postCs)-  -- debugM $ "calling setAnnotationAnchor:(newAchor,postCs)=" ++ showAst (newAchor, postCs)-  debugM $ "enterAnn:done:(p,a) =" ++ show (p0, astId a')-  return r---- -----------------------------------------------------------------------addCommentsA :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()-addCommentsA csNew = addComments (concatMap tokComment csNew)--{--TODO: When we addComments, some may have an anchor that is no longer-valid, as it has been moved and has an anchor_op.--Does an Anchor even make sense for a comment, perhaps it should be an-EpaLocation?--How do we sort them? do we assign a location based on when we add them-to the list, based on the current output pos?  Except the offset is a-delta compared to a reference location.  Need to nail the concept of-the reference location.--By definition it is the current anchor, so work against that. And that-also means that the first entry comment that has moved should not have-a line offset.--}-addComments :: (Monad m, Monoid w) => [Comment] -> EP w m ()-addComments csNew = do-  -- debugM $ "addComments:" ++ show csNew-  cs <- getUnallocatedComments--  putUnallocatedComments (sort (cs ++ csNew))---- ------------------------------------------------------------------------- | Just before we print out the EOF comments, flush the remaining--- ones in the state.-flushComments :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()-flushComments trailing = do-  addCommentsA trailing-  cs <- getUnallocatedComments-  debugM $ "flushing comments starting"-  mapM_ printOneComment (sortComments cs)-  debugM $ "flushing comments done"---- ------------------------------------------------------------------------- |In order to interleave annotations into the stream, we turn them into--- comments. They are removed from the annotation to avoid duplication.-annotationsToComments :: (Monad m, Monoid w)-  => EpAnn a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m (EpAnn a)-annotationsToComments EpAnnNotUsed _ _kws = return EpAnnNotUsed-annotationsToComments (EpAnn anc a cs) l kws = do-  let (newComments, newAnns) = go ([],[]) (view l a)-  addComments newComments-  return (EpAnn anc (set l (reverse newAnns) a) cs)-  where-    keywords = Set.fromList kws--    go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])-    go acc [] = acc-    go (cs',ans) ((AddEpAnn k ss) : ls)-      | Set.member k keywords = go ((mkKWComment k ss):cs', ans) ls-      | otherwise             = go (cs', (AddEpAnn k ss):ans)    ls---- ------------------------------------------------------------------------- Temporary function to simply reproduce the "normal" pretty printer output-withPpr :: (Monad m, Monoid w, Outputable a) => a -> EP w m a-withPpr a = do-  ss <- getAnchorU-  debugM $ "withPpr: ss=" ++ show ss-  printStringAtRs' ss (showPprUnsafe a)-  return a---- ------------------------------------------------------------------------- | An AST fragment with an annotation must be able to return the--- requirements for nesting another one, captured in an 'Entry', and--- to be able to use the rest of the exactprint machinery to print the--- element.  In the analogy to Outputable, 'exact' plays the role of--- 'ppr'.-class (Typeable a) => ExactPrint a where-  getAnnotationEntry :: a -> Entry-  setAnnotationAnchor :: a -> Anchor -> EpAnnComments -> a-  exact :: (Monad m, Monoid w) => a -> EP w m a---- ------------------------------------------------------------------------ Start of utility functions--- -----------------------------------------------------------------------printSourceText :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()-printSourceText (NoSourceText) txt   =  printStringAdvance txt >> return ()-printSourceText (SourceText   txt) _ =  printStringAdvance (unpackFS txt) >> return ()---- -----------------------------------------------------------------------printStringAtSs :: (Monad m, Monoid w) => SrcSpan -> String -> EP w m ()-printStringAtSs ss str = printStringAtRs (realSrcSpan ss) str >> return ()--printStringAtRs :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m EpaLocation-printStringAtRs pa str = printStringAtRsC CaptureComments pa str--printStringAtRsC :: (Monad m, Monoid w)-  => CaptureComments -> RealSrcSpan -> String -> EP w m EpaLocation-printStringAtRsC capture pa str = do-  debugM $ "printStringAtRsC: pa=" ++ showAst pa-  printComments pa-  pe <- getPriorEndD-  debugM $ "printStringAtRsC:pe=" ++ show pe-  let p = ss2delta pe pa-  p' <- adjustDeltaForOffsetM p-  debugM $ "printStringAtRsC:(p,p')=" ++ show (p,p')-  printStringAtLsDelta p' str-  setPriorEndASTD pa-  cs' <- case capture of-    CaptureComments -> takeAppliedComments-    NoCaptureComments -> return []-  debugM $ "printStringAtRsC:cs'=" ++ show cs'-  debugM $ "printStringAtRsC:p'=" ++ showAst p'-  debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' [])-  debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta p' (map comment2LEpaComment cs'))-  return (EpaDelta p' (map comment2LEpaComment cs'))--printStringAtRs' :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m ()-printStringAtRs' pa str = printStringAtRsC NoCaptureComments pa str >> return ()---- -----------------------------------------------------------------------printStringAtMLoc' :: (Monad m, Monoid w)-  => Maybe EpaLocation -> String -> EP w m (Maybe EpaLocation)-printStringAtMLoc' (Just aa) s = Just <$> printStringAtAA aa s-printStringAtMLoc' Nothing s = do-  printStringAtLsDelta (SameLine 1) s-  return (Just (EpaDelta (SameLine 1) []))--printStringAtMLocL :: (Monad m, Monoid w)-  => EpAnn a -> Lens a (Maybe EpaLocation) -> String -> EP w m (EpAnn a)-printStringAtMLocL EpAnnNotUsed _ _ = return EpAnnNotUsed-printStringAtMLocL (EpAnn anc an cs) l s = do-  r <- go (view l an) s-  return (EpAnn anc (set l r an) cs)-  where-    go (Just aa) str = Just <$> printStringAtAA aa str-    go Nothing str = do-      printStringAtLsDelta (SameLine 1) str-      return (Just (EpaDelta (SameLine 1) []))--printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation-printStringAtAA el str = printStringAtAAC CaptureComments el str--printStringAtAAL :: (Monad m, Monoid w)-  => EpAnn a -> Lens a EpaLocation -> String -> EP w m (EpAnn a)-printStringAtAAL EpAnnNotUsed _ _ = return EpAnnNotUsed-printStringAtAAL (EpAnn anc an cs) l str = do-  r <- printStringAtAAC CaptureComments (view l an) str-  return (EpAnn anc (set l r an) cs)--printStringAtAAC :: (Monad m, Monoid w)-  => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation-printStringAtAAC capture (EpaSpan r _) s = printStringAtRsC capture r s-printStringAtAAC capture (EpaDelta d cs) s = do-  mapM_  printOneComment $ concatMap tokComment cs-  pe1 <- getPriorEndD-  p1 <- getPosP-  printStringAtLsDelta d s-  p2 <- getPosP-  pe2 <- getPriorEndD-  debugM $ "printStringAtAA:(pe1,pe2,p1,p2)=" ++ show (pe1,pe2,p1,p2)-  setPriorEndASTPD (pe1,pe2)-  cs' <- case capture of-    CaptureComments -> takeAppliedComments-    NoCaptureComments -> return []-  debugM $ "printStringAtAA:(pe1,pe2,p1,p2,cs')=" ++ show (pe1,pe2,p1,p2,cs')-  return (EpaDelta d (map comment2LEpaComment cs'))---- -----------------------------------------------------------------------markExternalSourceText :: (Monad m, Monoid w) => SrcSpan -> SourceText -> String -> EP w m ()-markExternalSourceText l NoSourceText txt   = printStringAtRs (realSrcSpan l) txt >> return ()-markExternalSourceText l (SourceText txt) _ = printStringAtRs (realSrcSpan l) (unpackFS txt) >> return ()---- -----------------------------------------------------------------------markLensMAA :: (Monad m, Monoid w) => EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)-markLensMAA EpAnnNotUsed  _  = return EpAnnNotUsed-markLensMAA (EpAnn anc a cs) l =-  case view l a of-    Nothing -> return (EpAnn anc a cs)-    Just aa -> do-      aa' <- markAddEpAnn aa-      return (EpAnn anc (set l (Just aa') a) cs)--markLensAA :: (Monad m, Monoid w) => EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)-markLensAA EpAnnNotUsed  _  = return EpAnnNotUsed-markLensAA (EpAnn anc a cs) l = do-  a' <- markKw (view l a)-  return (EpAnn anc (set l a' a) cs)---markEpAnnLMS :: (Monad m, Monoid w)-  => EpAnn a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)-markEpAnnLMS an l kw Nothing = markEpAnnL an l kw-markEpAnnLMS EpAnnNotUsed  _ _ _ = return EpAnnNotUsed-markEpAnnLMS (EpAnn anc a cs) l kw (Just str) = do-  anns <- mapM go (view l a)-  return (EpAnn anc (set l anns a) cs)-  where-    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn-    go (AddEpAnn kw' r)-      | kw' == kw = do-          r' <- printStringAtAA r str-          return (AddEpAnn kw' r')-      | otherwise = return (AddEpAnn kw' r)--markEpAnnLMS' :: (Monad m, Monoid w)-                => EpAnn a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)-markEpAnnLMS' an l _kw Nothing = markLensKwA an l-markEpAnnLMS' EpAnnNotUsed  _ _ _ = return EpAnnNotUsed-markEpAnnLMS' (EpAnn anc a cs) l kw (Just str) = do-  anns <- go (view l a)-  return (EpAnn anc (set l anns a) cs)-  where-    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn-    go (AddEpAnn kw' r)-      | kw' == kw = do-          r' <- printStringAtAA r str-          return (AddEpAnn kw' r')-      | otherwise = return (AddEpAnn kw' r)---- -----------------------------------------------------------------------markLToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)-  => Located (HsToken tok) -> EP w m (Located (HsToken tok))-markLToken (L (RealSrcSpan aa mb) t) = do-  epaLoc'<-  printStringAtAA (EpaSpan aa mb) (symbolVal (Proxy @tok))-  case epaLoc' of-    EpaSpan aa' mb' -> return (L (RealSrcSpan aa' mb') t)-    _               -> return (L (RealSrcSpan aa  mb ) t)-markLToken (L lt t) = return (L lt t)--markToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)-  => LHsToken tok GhcPs -> EP w m (LHsToken tok GhcPs)-markToken (L NoTokenLoc t) = return (L NoTokenLoc t)-markToken (L (TokenLoc aa) t) = do-  aa' <- printStringAtAA aa (symbolVal (Proxy @tok))-  return (L (TokenLoc aa') t)--markUniToken :: forall m w tok utok. (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)-  => LHsUniToken tok utok GhcPs -> EP w m (LHsUniToken tok utok GhcPs)-markUniToken (L l HsNormalTok)  = do-  (L l' _) <- markToken (L l (HsTok @tok))-  return (L l' HsNormalTok)-markUniToken (L l HsUnicodeTok) = do-  (L l' _) <- markToken (L l (HsTok @utok))-  return (L l' HsUnicodeTok)---- -----------------------------------------------------------------------markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)-markArrow (HsUnrestrictedArrow arr) = do-  arr' <- markUniToken arr-  return (HsUnrestrictedArrow arr')-markArrow (HsLinearArrow (HsPct1 pct1 arr)) = do-  pct1' <- markToken pct1-  arr' <- markUniToken arr-  return (HsLinearArrow (HsPct1 pct1' arr'))-markArrow (HsLinearArrow (HsLolly arr)) = do-  arr' <- markToken arr-  return (HsLinearArrow (HsLolly arr'))-markArrow (HsExplicitMult pct t arr) = do-  pct' <- markToken pct-  t' <- markAnnotated t-  arr' <- markUniToken arr-  return (HsExplicitMult pct' t' arr')---- -----------------------------------------------------------------------markAnnCloseP :: (Monad m, Monoid w) => EpAnn AnnPragma -> EP w m (EpAnn AnnPragma)-markAnnCloseP an = markEpAnnLMS' an lapr_close AnnClose (Just "#-}")--markAnnOpenP :: (Monad m, Monoid w) => EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)-markAnnOpenP an NoSourceText txt   = markEpAnnLMS' an lapr_open AnnOpen (Just txt)-markAnnOpenP an (SourceText txt) _ = markEpAnnLMS' an lapr_open AnnOpen (Just $ unpackFS txt)--markAnnOpen :: (Monad m, Monoid w) => EpAnn [AddEpAnn] -> SourceText -> String -> EP w m (EpAnn [AddEpAnn])-markAnnOpen an NoSourceText txt   = markEpAnnLMS an lidl AnnOpen (Just txt)-markAnnOpen an (SourceText txt) _ = markEpAnnLMS an lidl AnnOpen (Just $ unpackFS txt)--markAnnOpen' :: (Monad m, Monoid w)-  => Maybe EpaLocation -> SourceText -> String -> EP w m (Maybe EpaLocation)-markAnnOpen' ms NoSourceText txt   = printStringAtMLoc' ms txt-markAnnOpen' ms (SourceText txt) _ = printStringAtMLoc' ms $ unpackFS txt--markAnnOpen'' :: (Monad m, Monoid w)-  => EpaLocation -> SourceText -> String -> EP w m EpaLocation-markAnnOpen'' el NoSourceText txt   = printStringAtAA el txt-markAnnOpen'' el (SourceText txt) _ = printStringAtAA el $ unpackFS txt---- ----------------------------------------------------------------------{--data AnnParen-  = AnnParen {-      ap_adornment :: ParenType,-      ap_open      :: EpaLocation,-      ap_close     :: EpaLocation-      } deriving (Data)--}-markOpeningParen, markClosingParen :: (Monad m, Monoid w) => EpAnn AnnParen -> EP w m (EpAnn AnnParen)-markOpeningParen an = markParen an lfst-markClosingParen an = markParen an lsnd--markParen :: (Monad m, Monoid w) => EpAnn AnnParen -> (forall a. Lens (a,a) a) -> EP w m (EpAnn AnnParen)-markParen EpAnnNotUsed _ = return (EpAnnNotUsed)-markParen (EpAnn anc (AnnParen pt o c) cs) l = do-  loc' <- markKwA (view l $ kw pt) (view l (o, c))-  let (o',c') = set l loc' (o,c)-  return (EpAnn anc (AnnParen pt o' c') cs)-  where-    kw AnnParens       = (AnnOpenP,  AnnCloseP)-    kw AnnParensHash   = (AnnOpenPH, AnnClosePH)-    kw AnnParensSquare = (AnnOpenS, AnnCloseS)---- ------------------------------------------------------------------------ Bare bones Optics--- Base on From https://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html--type Lens    a b = forall f . Functor f => (b -> f        b) -> (a -> f        a)-type Getting a b =                         (b -> Const  b b) -> (a -> Const b  a)-type ASetter a b =                         (b -> Identity b) -> (a -> Identity a)--view :: MonadReader s m => Getting s a -> m a-view l = Reader.asks (getConst . l Const)-{-# INLINE view #-}--over :: ASetter a b -> (b -> b) -> (a -> a)-over l f = runIdentity . l (Identity . f)-{-# INLINE over #-}--set  :: Lens a b -> b -> a -> a-set lens b = over lens (\_ -> b)-{-# INLINE set #-}--{--Question: How do I combine lenses?--Answer: You compose them, using function composition (Yes, really!)--You can think of the function composition operator as having this type:--(.) :: Lens' a b -> Lens' b c -> Lens' a c--}---- ------------------------------------------------------------------------ Lenses---- data AnnsModule---   = AnnsModule {---     am_main :: [AddEpAnn],---     am_decls :: AnnList---     } deriving (Data, Eq)--lam_main :: Lens AnnsModule [AddEpAnn]-lam_main k annsModule = fmap (\newAnns -> annsModule { am_main = newAnns })-                             (k (am_main annsModule))---- lam_decls :: Lens AnnsModule AnnList--- lam_decls k annsModule = fmap (\newAnns -> annsModule { am_decls = newAnns })---                               (k (am_decls annsModule))----- data EpAnnImportDecl = EpAnnImportDecl---   { importDeclAnnImport    :: EpaLocation---   , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation)---   , importDeclAnnSafe      :: Maybe EpaLocation---   , importDeclAnnQualified :: Maybe EpaLocation---   , importDeclAnnPackage   :: Maybe EpaLocation---   , importDeclAnnAs        :: Maybe EpaLocation---   } deriving (Data)--limportDeclAnnImport :: Lens EpAnnImportDecl EpaLocation-limportDeclAnnImport k annImp = fmap (\new -> annImp { importDeclAnnImport = new })-                                     (k (importDeclAnnImport annImp))---- limportDeclAnnPragma :: Lens EpAnnImportDecl (Maybe (EpaLocation, EpaLocation))--- limportDeclAnnPragma k annImp = fmap (\new -> annImp { importDeclAnnPragma = new })---                                      (k (importDeclAnnPragma annImp))--limportDeclAnnSafe :: Lens EpAnnImportDecl (Maybe EpaLocation)-limportDeclAnnSafe k annImp = fmap (\new -> annImp { importDeclAnnSafe = new })-                                     (k (importDeclAnnSafe annImp))--limportDeclAnnQualified :: Lens EpAnnImportDecl (Maybe EpaLocation)-limportDeclAnnQualified k annImp = fmap (\new -> annImp { importDeclAnnQualified = new })-                                     (k (importDeclAnnQualified annImp))--limportDeclAnnPackage :: Lens EpAnnImportDecl (Maybe EpaLocation)-limportDeclAnnPackage k annImp = fmap (\new -> annImp { importDeclAnnPackage = new })-                                     (k (importDeclAnnPackage annImp))---- limportDeclAnnAs :: Lens EpAnnImportDecl (Maybe EpaLocation)--- limportDeclAnnAs k annImp = fmap (\new -> annImp { importDeclAnnAs = new })---                                      (k (importDeclAnnAs annImp))---- ----------------------------------------- data AnnList---   = 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---       } deriving (Data,Eq)--lal_open :: Lens AnnList (Maybe AddEpAnn)-lal_open k parent = fmap (\new -> parent { al_open = new })-                           (k (al_open parent))--lal_close :: Lens AnnList (Maybe AddEpAnn)-lal_close k parent = fmap (\new -> parent { al_close = new })-                           (k (al_close parent))--lal_rest :: Lens AnnList [AddEpAnn]-lal_rest k parent = fmap (\new -> parent { al_rest = new })-                           (k (al_rest parent))--lal_trailing :: Lens AnnList [TrailingAnn]-lal_trailing k parent = fmap (\new -> parent { al_trailing = new })-                           (k (al_trailing parent))---- ---------------------------------------lapr_rest :: Lens AnnPragma [AddEpAnn]-lapr_rest k parent = fmap (\newAnns -> parent { apr_rest = newAnns })-                          (k (apr_rest parent))--lapr_open :: Lens AnnPragma AddEpAnn-lapr_open k parent = fmap (\new -> parent { apr_open = new })-                          (k (apr_open parent))--lapr_close :: Lens AnnPragma AddEpAnn-lapr_close k parent = fmap (\new -> parent { apr_close = new })-                          (k (apr_close parent))--lidl :: Lens [AddEpAnn] [AddEpAnn]-lidl k parent = fmap (\new -> new)-                     (k parent)--lid :: Lens a a-lid k parent = fmap (\new -> new)-                    (k parent)--lfst :: Lens (a,a) a-lfst k parent = fmap (\new -> (new, snd parent))-                     (k (fst parent))--lsnd :: Lens (a,a) a-lsnd k parent = fmap (\new -> (fst parent, new))-                     (k (snd parent))---- ---------------------------------------- data AnnExplicitSum---   = AnnExplicitSum {---       aesOpen       :: EpaLocation,---       aesBarsBefore :: [EpaLocation],---       aesBarsAfter  :: [EpaLocation],---       aesClose      :: EpaLocation---       } deriving Data--laesOpen :: Lens AnnExplicitSum EpaLocation-laesOpen k parent = fmap (\new -> parent { aesOpen = new })-                         (k (aesOpen parent))--laesBarsBefore :: Lens AnnExplicitSum [EpaLocation]-laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })-                               (k (aesBarsBefore parent))--laesBarsAfter :: Lens AnnExplicitSum [EpaLocation]-laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })-                               (k (aesBarsAfter parent))--laesClose :: Lens AnnExplicitSum EpaLocation-laesClose k parent = fmap (\new -> parent { aesClose = new })-                               (k (aesClose parent))---- ---------------------------------------- data AnnFieldLabel---   = AnnFieldLabel {---       afDot :: Maybe EpaLocation---       } deriving Data--lafDot :: Lens AnnFieldLabel (Maybe EpaLocation)-lafDot k parent = fmap (\new -> parent { afDot = new })-                         (k (afDot parent))---- ---------------------------------------- data AnnProjection---   = AnnProjection {---       apOpen  :: EpaLocation, -- ^ '('---       apClose :: EpaLocation  -- ^ ')'---       } deriving Data--lapOpen :: Lens AnnProjection EpaLocation-lapOpen k parent = fmap (\new -> parent { apOpen = new })-                         (k (apOpen parent))--lapClose :: Lens AnnProjection EpaLocation-lapClose k parent = fmap (\new -> parent { apClose = new })-                         (k (apClose parent))---- ---------------------------------------- data AnnsIf---   = AnnsIf {---       aiIf       :: EpaLocation,---       aiThen     :: EpaLocation,---       aiElse     :: EpaLocation,---       aiThenSemi :: Maybe EpaLocation,---       aiElseSemi :: Maybe EpaLocation---       } deriving Data--laiIf :: Lens AnnsIf EpaLocation-laiIf k parent = fmap (\new -> parent { aiIf = new })-                      (k (aiIf parent))--laiThen :: Lens AnnsIf EpaLocation-laiThen k parent = fmap (\new -> parent { aiThen = new })-                        (k (aiThen parent))--laiElse :: Lens AnnsIf EpaLocation-laiElse k parent = fmap (\new -> parent { aiElse = new })-                        (k (aiElse parent))--laiThenSemi :: Lens AnnsIf (Maybe EpaLocation)-laiThenSemi k parent = fmap (\new -> parent { aiThenSemi = new })-                            (k (aiThenSemi parent))--laiElseSemi :: Lens AnnsIf (Maybe EpaLocation)-laiElseSemi k parent = fmap (\new -> parent { aiElseSemi = new })-                            (k (aiElseSemi parent))---- ----------------------------------------- data AnnParen---   = AnnParen {---       ap_adornment :: ParenType,---       ap_open      :: EpaLocation,---       ap_close     :: EpaLocation---       } deriving (Data)---- lap_open :: Lens AnnParen EpaLocation--- lap_open k parent = fmap (\new -> parent { ap_open = new })---                          (k (ap_open parent))---- lap_close :: Lens AnnParen EpaLocation--- lap_close k parent = fmap (\new -> parent { ap_close = new })---                           (k (ap_close parent))---- ---------------------------------------- data EpAnnHsCase = EpAnnHsCase---       { hsCaseAnnCase :: EpaLocation---       , hsCaseAnnOf   :: EpaLocation---       , hsCaseAnnsRest :: [AddEpAnn]---       } deriving Data--lhsCaseAnnCase :: Lens EpAnnHsCase EpaLocation-lhsCaseAnnCase k parent = fmap (\new -> parent { hsCaseAnnCase = new })-                               (k (hsCaseAnnCase parent))--lhsCaseAnnOf :: Lens EpAnnHsCase EpaLocation-lhsCaseAnnOf k parent = fmap (\new -> parent { hsCaseAnnOf = new })-                               (k (hsCaseAnnOf parent))--lhsCaseAnnsRest :: Lens EpAnnHsCase [AddEpAnn]-lhsCaseAnnsRest k parent = fmap (\new -> parent { hsCaseAnnsRest = new })-                                (k (hsCaseAnnsRest parent))---- ------------------------------------------------------------------------- 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]---        } deriving (Data, Eq)--lra_tyanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))-lra_tyanns k parent = fmap (\new -> parent { ra_tyanns = new })-                               (k (ra_tyanns parent))--ff :: Maybe (a,b) -> (Maybe a,Maybe b)-ff Nothing = (Nothing, Nothing)-ff (Just (a,b)) = (Just a, Just b)---gg :: (Maybe a,Maybe b) -> Maybe (a,b)-gg (Nothing, Nothing) = Nothing-gg (Just a, Just b) = Just (a,b)-gg _ = error "gg:expecting two Nothing or two Just"--lff :: Lens (Maybe (a,b)) (Maybe a,Maybe b)-lff k parent = fmap (\new -> gg new)-                    (k (ff parent))---- (.) :: Lens' a b -> Lens' b c -> Lens' a c-lra_tyanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)-lra_tyanns_fst = lra_tyanns . lff . lfst--lra_tyanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)-lra_tyanns_snd = lra_tyanns . lff . lsnd--lra_tmanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))-lra_tmanns k parent = fmap (\new -> parent { ra_tmanns = new })-                               (k (ra_tmanns parent))--lra_tmanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)-lra_tmanns_fst = lra_tmanns . lff . lfst--lra_tmanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)-lra_tmanns_snd = lra_tmanns . lff . lsnd--lra_rest :: Lens HsRuleAnn [AddEpAnn]-lra_rest k parent = fmap (\new -> parent { ra_rest = new })-                                (k (ra_rest parent))----- ------------------------------------------------------------------------ data GrhsAnn---   = GrhsAnn {---       ga_vbar :: Maybe EpaLocation, -- TODO:AZ do we need this?---       ga_sep  :: AddEpAnn -- ^ Match separator location---       } deriving (Data)--lga_vbar :: Lens GrhsAnn (Maybe EpaLocation)-lga_vbar k parent = fmap (\new -> parent { ga_vbar = new })-                                (k (ga_vbar parent))--lga_sep :: Lens GrhsAnn AddEpAnn-lga_sep k parent = fmap (\new -> parent { ga_sep = new })-                                (k (ga_sep parent))---- ------------------------------------------------------------------------ data AnnSig---   = AnnSig {---       asDcolon :: AddEpAnn, -- Not an EpaAnchor to capture unicode option---       asRest   :: [AddEpAnn]---       } deriving Data--lasDcolon :: Lens AnnSig AddEpAnn-lasDcolon k parent = fmap (\new -> parent { asDcolon = new })-                                (k (asDcolon parent))--lasRest :: Lens AnnSig [AddEpAnn]-lasRest k parent = fmap (\new -> parent { asRest = new })-                                (k (asRest parent))---- ------------------------------------------------------------------------ data EpAnnSumPat = EpAnnSumPat---       { sumPatParens      :: [AddEpAnn]---       , sumPatVbarsBefore :: [EpaLocation]---       , sumPatVbarsAfter  :: [EpaLocation]---       } deriving Data--lsumPatParens :: Lens EpAnnSumPat [AddEpAnn]-lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })-                              (k (sumPatParens parent))--lsumPatVbarsBefore :: Lens EpAnnSumPat [EpaLocation]-lsumPatVbarsBefore k parent = fmap (\new -> parent { sumPatVbarsBefore = new })-                              (k (sumPatVbarsBefore parent))--lsumPatVbarsAfter :: Lens EpAnnSumPat [EpaLocation]-lsumPatVbarsAfter k parent = fmap (\new -> parent { sumPatVbarsAfter = new })-                              (k (sumPatVbarsAfter parent))---- End of lenses--- -----------------------------------------------------------------------markLensKwA :: (Monad m, Monoid w)-  => EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)-markLensKwA EpAnnNotUsed  _    = return EpAnnNotUsed-markLensKwA (EpAnn anc a cs) l = do-  loc <- markKw (view l a)-  return (EpAnn anc (set l loc a) cs)--markLensKw :: (Monad m, Monoid w)-  => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)-markLensKw EpAnnNotUsed  _ _  = return EpAnnNotUsed-markLensKw (EpAnn anc a cs) l kw = do-  loc <- markKwA kw (view l a)-  return (EpAnn anc (set l loc a) cs)--markAnnKwL :: (Monad m, Monoid w)-  => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)-markAnnKwL = markLensKw--markAnnKwAllL :: (Monad m, Monoid w)-  => EpAnn a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m (EpAnn a)-markAnnKwAllL EpAnnNotUsed  _ _  = return EpAnnNotUsed-markAnnKwAllL (EpAnn anc a cs) l kw = do-  anns <- mapM (markKwA kw) (view l a)-  return (EpAnn anc (set l anns a) cs)--markLensKwM :: (Monad m, Monoid w)-  => EpAnn a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m (EpAnn a)-markLensKwM EpAnnNotUsed  _ _ = return EpAnnNotUsed-markLensKwM (EpAnn anc a cs) l kw = do-  new <- go (view l a)-  return (EpAnn anc (set l new a) cs)-  where-    go Nothing = return Nothing-    go (Just s) = Just <$> markKwA kw s---- -----------------------------------------------------------------------markALocatedA :: (Monad m, Monoid w) => EpAnn AnnListItem -> EP w m (EpAnn AnnListItem)-markALocatedA EpAnnNotUsed  = return EpAnnNotUsed-markALocatedA (EpAnn anc a cs) = do-  t <- markTrailing (lann_trailing a)-  return (EpAnn anc (a { lann_trailing = t }) cs)--markEpAnnL :: (Monad m, Monoid w)-  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)-markEpAnnL EpAnnNotUsed _ _ = return EpAnnNotUsed-markEpAnnL (EpAnn anc a cs) l kw = do-  anns <- mark' (view l a) kw-  return (EpAnn anc (set l anns a) cs)--markEpAnnAllL :: (Monad m, Monoid w)-  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)-markEpAnnAllL EpAnnNotUsed _ _ = return EpAnnNotUsed-markEpAnnAllL (EpAnn anc a cs) l kw = do-  anns <- mapM doit (view l a)-  return (EpAnn anc (set l anns a) cs)-  where-    doit an@(AddEpAnn ka _)-      = if ka == kw-          then markKw an-          else return an--markAddEpAnn :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn-markAddEpAnn a@(AddEpAnn kw _) = do-  r <- mark' [a] kw-  case r of-    [a'] -> return a'-    _ -> error "Should not happen: markAddEpAnn"--mark' :: (Monad m, Monoid w) => [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]-mark' anns kw = do-  case find' kw anns of-    (lead, Just aa, end) -> do-      aa' <- markKw aa-      return (lead ++ [aa'] ++ end)-    (_lead, Nothing, _end) -> case find' (unicodeAnn kw) anns of-      (leadu, Just aau, endu) -> do-        aau' <- markKw aau-        return (leadu ++ [aau'] ++ endu)-      (_,Nothing,_) -> return anns---- | Find for update, returning lead section of the list, item if--- found, and tail of the list-find' :: AnnKeywordId -> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])-find' kw anns = (lead, middle, end)-  where-    (lead, rest) = break (\(AddEpAnn k _) -> k == kw) anns-    (middle,end) = case rest of-      [] -> (Nothing, [])-      (x:xs) -> (Just x, xs)--markKw :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn-markKw an = markKwC CaptureComments an--markKwC :: (Monad m, Monoid w) => CaptureComments -> AddEpAnn -> EP w m AddEpAnn-markKwC capture (AddEpAnn kw ss) = do-  ss' <- markKwAC capture kw ss-  return (AddEpAnn kw ss')---- | This should be the main driver of the process, managing printing keywords.--- It returns the 'EpaDelta' variant of the passed in 'EpaLocation'-markKwA :: (Monad m, Monoid w) => AnnKeywordId -> EpaLocation -> EP w m EpaLocation-markKwA kw aa = markKwAC CaptureComments kw aa--markKwAC :: (Monad m, Monoid w)-  => CaptureComments -> AnnKeywordId -> EpaLocation -> EP w m EpaLocation-markKwAC capture kw aa = printStringAtAAC capture aa (keywordToString kw)---- | Print a keyword encoded in a 'TrailingAnn'-markKwT :: (Monad m, Monoid w) => TrailingAnn -> EP w m TrailingAnn-markKwT (AddSemiAnn ss)    = AddSemiAnn    <$> markKwA AnnSemi ss-markKwT (AddCommaAnn ss)   = AddCommaAnn   <$> markKwA AnnComma ss-markKwT (AddVbarAnn ss)    = AddVbarAnn    <$> markKwA AnnVbar ss---- -----------------------------------------------------------------------markAnnList :: (Monad m, Monoid w)-  => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)-markAnnList reallyTrail ann action = do-  markAnnListA reallyTrail ann $ \a -> do-    r <- action-    return (a,r)--markAnnListA :: (Monad m, Monoid w)-  => Bool -> EpAnn AnnList-  -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))-  -> EP w m (EpAnn AnnList, a)-markAnnListA _ EpAnnNotUsed action = do-  action EpAnnNotUsed-markAnnListA reallyTrail an action = do-  debugM $ "markAnnListA: an=" ++ showAst an-  an0 <- markLensMAA an lal_open-  an1 <- if (not reallyTrail)-           then markTrailingL an0 lal_trailing-           else return an0-  an2 <- markEpAnnAllL an1 lal_rest AnnSemi-  (an3, r) <- action an2-  an4 <- markLensMAA an3 lal_close-  an5 <- if reallyTrail-           then markTrailingL an4 lal_trailing-           else return an4-  debugM $ "markAnnListA: an5=" ++ showAst an-  return (an5, r)---- -----------------------------------------------------------------------printComments :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()-printComments ss = do-  cs <- commentAllocation ss-  debugM $ "printComments: (ss): " ++ showPprUnsafe (rs2range ss)-  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentAnchor cs)-  mapM_ printOneComment cs---- -----------------------------------------------------------------------printOneComment :: (Monad m, Monoid w) => Comment -> EP w m ()-printOneComment c@(Comment _str loc _r _mo) = do-  debugM $ "printOneComment:c=" ++ showGhc c-  dp <-case anchor_op loc of-    MovedAnchor dp -> return dp-    _ -> do-        pe <- getPriorEndD-        let dp = ss2delta pe (anchor loc)-        debugM $ "printOneComment:(dp,pe,anchor loc)=" ++ showGhc (dp,pe,ss2pos $ anchor loc)-        adjustDeltaForOffsetM dp-  mep <- getExtraDP-  dp' <- case mep of-    Just (Anchor _ (MovedAnchor edp)) -> do-      debugM $ "printOneComment:edp=" ++ show edp-      ddd <- fmap unTweakDelta $ adjustDeltaForOffsetM edp-      debugM $ "printOneComment:ddd=" ++ show ddd-      fmap unTweakDelta $ adjustDeltaForOffsetM edp-    _ -> return dp-  -- Start of debug printing-  -- LayoutStartCol dOff <- getLayoutOffsetD-  -- debugM $ "printOneComment:(dp,dp',dOff)=" ++ showGhc (dp,dp',dOff)-  -- End of debug printing-  -- setPriorEndD (ss2posEnd (anchor loc))-  updateAndApplyComment c dp'-  printQueuedComment (anchor loc) c dp'---- | For comment-related deltas starting on a new line we have an--- off-by-one problem. Adjust-unTweakDelta :: DeltaPos  -> DeltaPos-unTweakDelta (SameLine d) = SameLine d-unTweakDelta (DifferentLine l d) = DifferentLine l (d+1)---updateAndApplyComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()-updateAndApplyComment (Comment str anc pp mo) dp = do-  -- debugM $ "updateAndApplyComment: (dp,anc',co)=" ++ showAst (dp,anc',co)-  applyComment (Comment str anc' pp mo)-  where-    anc' = anc { anchor_op = op}--    (r,c) = ss2posEnd pp-    la = anchor anc-    dp'' = if r == 0-           then (ss2delta (r,c+0) la)-           else (ss2delta (r,c)   la)-    dp' = if pp == anchor anc-             then dp-             else dp''-    op' = case dp' of-            SameLine n -> if n >= 0-                            then MovedAnchor dp'-                            else MovedAnchor dp-            _ -> MovedAnchor dp'-    op = if str == "" && op' == MovedAnchor (SameLine 0) -- EOF comment-           then MovedAnchor dp-           -- else op'-           else MovedAnchor dp---- -----------------------------------------------------------------------commentAllocation :: (Monad m, Monoid w) => RealSrcSpan -> EP w m [Comment]-commentAllocation ss = do-  cs <- getUnallocatedComments-  -- Note: The CPP comment injection may change the file name in the-  -- RealSrcSpan, which affects comparison, as the Ord instance for-  -- RealSrcSpan compares the file first. So we sort via ss2pos-  -- TODO: this is inefficient, use Pos all the way through-  let (earlier,later) = partition (\(Comment _str loc _r _mo) -> (ss2pos $ anchor loc) <= (ss2pos ss)) cs-  putUnallocatedComments later-  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)-  return earlier---- -----------------------------------------------------------------------markAnnotatedWithLayout :: (Monad m, Monoid w) => ExactPrint ast => ast -> EP w m ast-markAnnotatedWithLayout a = setLayoutBoth $ markAnnotated a---- -----------------------------------------------------------------------markTopLevelList :: (Monad m, Monoid w) => ExactPrint ast => [ast] -> EP w m [ast]-markTopLevelList ls = mapM (\a -> setLayoutTopLevelP $ markAnnotated a) ls---- ------------------------------------------------------------------------ End of utility functions--- ------------------------------------------------------------------------ Start of ExactPrint instances--- ------------------------------------------------------------------------- | Bare Located elements are simply stripped off without further--- processing.-instance (ExactPrint a) => ExactPrint (Located a) where-  getAnnotationEntry (L l _) = case l of-    UnhelpfulSpan _ -> NoEntryVal-    _ -> Entry (hackSrcSpanToAnchor l) emptyComments NoFlushComments CanUpdateAnchorOnly--  setAnnotationAnchor (L _ a) anc _cs = (L (hackAnchorToSrcSpan anc) a)-                 `debug` ("setAnnotationAnchor(Located):" ++ showAst anc)--  exact (L l a) = L l <$> markAnnotated a--instance (ExactPrint a) => ExactPrint (LocatedA a) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor la anc cs = setAnchorAn la anc cs-  exact (L la a) = do-    debugM $ "LocatedA a:la loc=" ++ show (ss2range $ locA la)-    a' <- markAnnotated a-    ann' <- markALocatedA (ann la)-    return (L (la { ann = ann'}) a')--instance (ExactPrint a) => ExactPrint (LocatedAn NoEpAnns a) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor la anc cs = setAnchorAn la anc cs-  exact (L la a) = do-    a' <- markAnnotated a-    return (L la a')--instance (ExactPrint a) => ExactPrint [a] where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor ls _ _ = ls-  exact ls = mapM markAnnotated ls--instance (ExactPrint a) => ExactPrint (Maybe a) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor ma _ _ = ma-  exact ma = mapM markAnnotated ma---- ------------------------------------------------------------------------- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource'-instance ExactPrint (HsModule GhcPs) where-  getAnnotationEntry hsmod = fromAnn' (hsmodAnn $ hsmodExt hsmod)-  -- A bit pointless actually changing anything here-  setAnnotationAnchor hsmod anc cs = setAnchorHsModule hsmod anc cs-                   `debug` ("setAnnotationAnchor hsmod called" ++ showAst (anc,cs))--  exact hsmod@(HsModule {hsmodExt = XModulePs { hsmodAnn = EpAnnNotUsed }}) = withPpr hsmod >> return hsmod-  exact (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) = do--    let mbDoc' = mbDoc-    -- mbDoc' <- markAnnotated mbDoc--    (an0, mmn' , mdeprec', mexports') <--      case mmn of-        Nothing -> return (an, mmn, mdeprec, mexports)-        Just m -> do-          an0 <- markEpAnnL an lam_main AnnModule-          m' <- markAnnotated m--          mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec--          mexports' <- setLayoutTopLevelP $ markAnnotated mexports--          an1 <- setLayoutTopLevelP $ markEpAnnL an0 lam_main AnnWhere--          return (an1, Just m', mdeprec', mexports')--    lo0 <- case lo of-        ExplicitBraces open close -> do-          open' <- markToken open-          return (ExplicitBraces open' close)-        _ -> return lo--    am_decls' <- markTrailing (am_decls $ anns an0)-    imports' <- markTopLevelList imports-    decls' <- markTopLevelList (filter removeDocDecl decls)--    lo1 <- case lo0 of-        ExplicitBraces open close -> do-          close' <- markToken close-          return (ExplicitBraces open close')-        _ -> return lo--    -- Print EOF-    case am_eof $ anns an of-      Nothing -> return ()-      Just (pos, prior) -> do-        debugM $ "am_eof:" ++ showGhc (pos, prior)-        setEofPos (Just (pos, prior))--    let anf = an0 { anns = (anns an0) { am_decls = am_decls' }}-    -- debugM $ "HsModule, anf=" ++ showAst anf--    return (HsModule (XModulePs anf lo1 mdeprec' mbDoc') mmn' mexports' imports' decls')---removeDocDecl :: LHsDecl GhcPs -> Bool-removeDocDecl (L _ DocD{}) = False-removeDocDecl _ = True---- -----------------------------------------------------------------------instance ExactPrint ModuleName where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor n _anc cs = n-     `debug` ("ModuleName.setAnnotationAnchor:cs=" ++ showAst cs)-  exact n = do-    debugM $ "ModuleName: " ++ showPprUnsafe n-    withPpr n---- -----------------------------------------------------------------------instance ExactPrint (LocatedP (WarningTxt GhcPs)) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn--  exact (L (SrcSpanAnn an l) (WarningTxt mb_cat (L la src) ws)) = do-    an0 <- markAnnOpenP an src "{-# WARNING"-    mb_cat' <- markAnnotated mb_cat-    an1 <- markEpAnnL an0 lapr_rest AnnOpenS-    ws' <- markAnnotated ws-    an2 <- markEpAnnL an1 lapr_rest AnnCloseS-    an3 <- markAnnCloseP an2-    return (L (SrcSpanAnn an3 l) (WarningTxt mb_cat' (L la src) ws'))--  exact (L (SrcSpanAnn an l) (DeprecatedTxt (L ls src) ws)) = do-    an0 <- markAnnOpenP an src "{-# DEPRECATED"-    an1 <- markEpAnnL an0 lapr_rest AnnOpenS-    ws' <- markAnnotated ws-    an2 <- markEpAnnL an1 lapr_rest AnnCloseS-    an3 <- markAnnCloseP an2-    return (L (SrcSpanAnn an3 l) (DeprecatedTxt (L ls src) ws'))--instance ExactPrint InWarningCategory where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (InWarningCategory tkIn source (L l wc)) = do-      tkIn' <- markLToken tkIn-      L _ (_,wc') <- markAnnotated (L l (source, wc))-      return (InWarningCategory tkIn' source (L l wc'))--instance ExactPrint (SourceText, WarningCategory) where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (st, WarningCategory wc) = do-      case st of-          NoSourceText -> printStringAdvance $ "\"" ++ (unpackFS wc) ++ "\""-          SourceText src -> printStringAdvance $ (unpackFS src)-      return (st, WarningCategory wc)---- -----------------------------------------------------------------------instance ExactPrint (ImportDecl GhcPs) where-  getAnnotationEntry idecl = fromAnn (ideclAnn $ ideclExt idecl)-  setAnnotationAnchor idecl anc cs = idecl { ideclExt-                    = (ideclExt idecl) { ideclAnn = setAnchorEpa (ideclAnn $ ideclExt idecl) anc cs} }--  exact x@(ImportDecl{ ideclExt = XImportDeclPass{ ideclAnn = EpAnnNotUsed } }) = withPpr x-  exact (ImportDecl (XImportDeclPass ann msrc impl)-                     modname mpkg src safeflag qualFlag mAs hiding) = do--    ann0 <- markLensKw ann limportDeclAnnImport AnnImport-    let (EpAnn _anc an _cs) = ann0--    -- "{-# SOURCE" and "#-}"-    importDeclAnnPragma' <--      case msrc of-        SourceText _txt -> do-          debugM $ "ImportDecl sourcetext"-          case importDeclAnnPragma an of-            Just (mo, mc) -> do-              mo' <- markAnnOpen'' mo msrc "{-# SOURCE"-              mc' <- printStringAtAA mc "#-}"-              return $ Just (mo', mc')-            Nothing ->  do-              _ <- markAnnOpen' Nothing msrc "{-# SOURCE"-              printStringAtLsDelta (SameLine 1) "#-}"-              return Nothing-        NoSourceText -> return (importDeclAnnPragma an)-    ann1 <- if safeflag-      then (markLensKwM ann0 limportDeclAnnSafe AnnSafe)-      else return ann0-    ann2 <--      case qualFlag of-        QualifiedPre  -- 'qualified' appears in prepositive position.-          -> printStringAtMLocL ann1 limportDeclAnnQualified "qualified"-        _ -> return ann1-    ann3 <--      case mpkg of-       RawPkgQual (StringLiteral src' v _) ->-         printStringAtMLocL ann2 limportDeclAnnPackage (sourceTextToString src' (show v))-       _ -> return ann2-    modname' <- markAnnotated modname--    ann4 <--      case qualFlag of-        QualifiedPost  -- 'qualified' appears in postpositive position.-          -> printStringAtMLocL ann3 limportDeclAnnQualified "qualified"-        _ -> return ann3--    (importDeclAnnAs', mAs') <--      case mAs of-        Nothing -> return (importDeclAnnAs an, Nothing)-        Just m0 -> do-          a <- printStringAtMLoc' (importDeclAnnAs an) "as"-          m'' <- markAnnotated m0-          return (a, Just m'')--    hiding' <--      case hiding of-        Nothing -> return hiding-        Just (isHiding,lie) -> do-          lie' <- markAnnotated lie-          return (Just (isHiding, lie'))--    let (EpAnn anc' an' cs') = ann4-    let an2 = an' { importDeclAnnAs = importDeclAnnAs'-                  , importDeclAnnPragma = importDeclAnnPragma'-                  }--    return (ImportDecl (XImportDeclPass (EpAnn anc' an2 cs') msrc impl)-                     modname' mpkg src safeflag qualFlag mAs' hiding')----- -----------------------------------------------------------------------instance ExactPrint HsDocString where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a--  -- exact ds = do-  --   (printStringAdvance . exactPrintHsDocString) ds-  --   return ds-  exact (MultiLineDocString decorator (x :| xs)) = do-    printStringAdvance ("-- " ++ printDecorator decorator)-    pe <- getPriorEndD-    debugM $ "MultiLineDocString: (pe,x)=" ++ showAst (pe,x)-    x' <- markAnnotated x-    xs' <- markAnnotated (map dedentDocChunk xs)-    return (MultiLineDocString decorator (x' :| xs'))-  exact x = do-    -- TODO: can this happen?-    debugM $ "Not exact printing:" ++ showAst x-    return x---instance ExactPrint HsDocStringChunk where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact chunk = do-    printStringAdvance ("--" ++ unpackHDSC chunk)-    return chunk---instance ExactPrint a => ExactPrint (WithHsDocIdentifiers a GhcPs) where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (WithHsDocIdentifiers ds ids) = do-    ds' <- exact ds-    return (WithHsDocIdentifiers ds' ids)---- -----------------------------------------------------------------------instance ExactPrint (HsDecl GhcPs) where-  getAnnotationEntry (TyClD      _ _) = NoEntryVal-  getAnnotationEntry (InstD      _ _) = NoEntryVal-  getAnnotationEntry (DerivD     _ _) = NoEntryVal-  getAnnotationEntry (ValD       _ _) = NoEntryVal-  getAnnotationEntry (SigD       _ _) = NoEntryVal-  getAnnotationEntry (KindSigD   _ _) = NoEntryVal-  getAnnotationEntry (DefD       _ _) = NoEntryVal-  getAnnotationEntry (ForD       _ _) = NoEntryVal-  getAnnotationEntry (WarningD   _ _) = NoEntryVal-  getAnnotationEntry (AnnD       _ _) = NoEntryVal-  getAnnotationEntry (RuleD      _ _) = NoEntryVal-  getAnnotationEntry (SpliceD    _ _) = NoEntryVal-  getAnnotationEntry (DocD       _ _) = NoEntryVal-  getAnnotationEntry (RoleAnnotD _ _) = NoEntryVal--  -- We do not recurse, the generic traversal using this feature-  -- should do that for us.-  setAnnotationAnchor d _ _ = d--  exact (TyClD       x d) = TyClD       x <$> markAnnotated d-  exact (InstD       x d) = InstD       x <$> markAnnotated d-  exact (DerivD      x d) = DerivD      x <$> markAnnotated d-  exact (ValD        x d) = ValD        x <$> markAnnotated d-  exact (SigD        x d) = SigD        x <$> markAnnotated d-  exact (KindSigD    x d) = KindSigD    x <$> markAnnotated d-  exact (DefD        x d) = DefD        x <$> markAnnotated d-  exact (ForD        x d) = ForD        x <$> markAnnotated d-  exact (WarningD    x d) = WarningD    x <$> markAnnotated d-  exact (AnnD        x d) = AnnD        x <$> markAnnotated d-  exact (RuleD       x d) = RuleD       x <$> markAnnotated d-  exact (SpliceD     x d) = SpliceD     x <$> markAnnotated d-  exact (DocD        x d) = DocD        x <$> markAnnotated d-  exact (RoleAnnotD  x d) = RoleAnnotD  x <$> markAnnotated d---- -----------------------------------------------------------------------instance ExactPrint (InstDecl GhcPs) where-  getAnnotationEntry (ClsInstD     _ _) = NoEntryVal-  getAnnotationEntry (DataFamInstD _ _) = NoEntryVal-  getAnnotationEntry (TyFamInstD   _ _) = NoEntryVal--  setAnnotationAnchor d _ _ = d---  exact (ClsInstD     a  cid) = do-    cid' <- markAnnotated cid-    return (ClsInstD     a  cid')-  exact (DataFamInstD a decl) = do-    d' <- markAnnotated (DataFamInstDeclWithContext noAnn TopLevel decl)-    return (DataFamInstD a (dc_d d'))-  exact (TyFamInstD a eqn) = do-    eqn' <- markAnnotated eqn-    return (TyFamInstD a eqn')---- -----------------------------------------------------------------------data DataFamInstDeclWithContext-  = DataFamInstDeclWithContext-    { _dc_a :: EpAnn [AddEpAnn]-    , _dc_f :: TopLevelFlag-    , dc_d :: DataFamInstDecl GhcPs-    }--instance ExactPrint DataFamInstDeclWithContext where-  getAnnotationEntry (DataFamInstDeclWithContext _ _ (DataFamInstDecl (FamEqn { feqn_ext = an})))-    = fromAnn an-  setAnnotationAnchor (DataFamInstDeclWithContext a c (DataFamInstDecl fe)) anc cs-    = (DataFamInstDeclWithContext a c (DataFamInstDecl (fe { feqn_ext = (setAnchorEpa (feqn_ext fe) anc cs)})))-  exact (DataFamInstDeclWithContext an c d) = do-    debugM $ "starting DataFamInstDeclWithContext:an=" ++ showAst an-    (an', d') <- exactDataFamInstDecl an c d-    return (DataFamInstDeclWithContext an' c d')---- -----------------------------------------------------------------------exactDataFamInstDecl :: (Monad m, Monoid w)-                     => EpAnn [AddEpAnn] -> TopLevelFlag -> DataFamInstDecl GhcPs-                     -> EP w m (EpAnn [AddEpAnn], DataFamInstDecl GhcPs)-exactDataFamInstDecl an top_lvl-  (DataFamInstDecl (FamEqn { feqn_ext    = an2-                           , feqn_tycon  = tycon-                           , feqn_bndrs  = bndrs-                           , feqn_pats   = pats-                           , feqn_fixity = fixity-                           , feqn_rhs    = defn })) = do-    (an', an2', tycon', bndrs', _,  _mc, defn') <- exactDataDefn an2 pp_hdr defn-                                                 -- See Note [an and an2 in exactDataFamInstDecl]-    return-      (an',-       DataFamInstDecl ( FamEqn { feqn_ext    = an2'-                                , feqn_tycon  = tycon'-                                , feqn_bndrs  = bndrs'-                                , feqn_pats   = pats-                                , feqn_fixity = fixity-                                , feqn_rhs    = defn' }))-                    `debug` ("exactDataFamInstDecl: defn' derivs:" ++ showAst (dd_derivs defn'))-  where-    pp_hdr :: (Monad m, Monoid w)-           => Maybe (LHsContext GhcPs)-           -> EP w m ( EpAnn [AddEpAnn]-                     , LocatedN RdrName-                     , HsOuterTyVarBndrs () GhcPs-                     , HsTyPats GhcPs-                     , Maybe (LHsContext GhcPs))-    pp_hdr mctxt = do-      an0 <- case top_lvl of-               TopLevel -> markEpAnnL an lidl AnnInstance -- TODO: maybe in toplevel-               NotTopLevel -> return an-      exactHsFamInstLHS an0 tycon bndrs pats fixity mctxt--{--Note [an and an2 in exactDataFamInstDecl]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The exactDataFamInstDecl function is called to render a-DataFamInstDecl within its surrounding context. This context is-rendered via the 'pp_hdr' function, which uses the exact print-annotations from that context, named 'an'.  The EPAs used for-rendering the DataDefn are contained in the FamEqn, and are called-'an2'.---}---- -----------------------------------------------------------------------instance ExactPrint (DerivDecl GhcPs) where-  getAnnotationEntry (DerivDecl {deriv_ext = an} ) = fromAnn an-  setAnnotationAnchor dd anc cs = dd { deriv_ext = setAnchorEpa (deriv_ext dd) anc cs }-  exact (DerivDecl an typ ms mov) = do-    an0 <- markEpAnnL an lidl AnnDeriving-    ms' <- mapM markAnnotated ms-    an1 <- markEpAnnL an0 lidl AnnInstance-    mov' <- mapM markAnnotated mov-    typ' <- markAnnotated typ-    return (DerivDecl an1 typ' ms' mov')---- -----------------------------------------------------------------------instance ExactPrint (ForeignDecl GhcPs) where-  getAnnotationEntry (ForeignImport an _ _  _) = fromAnn an-  getAnnotationEntry (ForeignExport an _ _  _) = fromAnn an--  setAnnotationAnchor (ForeignImport an a b c) anc cs = ForeignImport (setAnchorEpa an anc cs) a b c-  setAnnotationAnchor (ForeignExport an a b c) anc cs = ForeignExport (setAnchorEpa an anc cs) a b c--  exact (ForeignImport an n ty fimport) = do-    an0 <- markEpAnnL an lidl AnnForeign-    an1 <- markEpAnnL an0 lidl AnnImport--    fimport' <- markAnnotated fimport--    n' <- markAnnotated n-    an2 <- markEpAnnL an1 lidl AnnDcolon-    ty' <- markAnnotated ty-    return (ForeignImport an2 n' ty' fimport')--  exact (ForeignExport an n ty fexport) = do-    an0 <- markEpAnnL an lidl AnnForeign-    an1 <- markEpAnnL an0 lidl AnnExport-    fexport' <- markAnnotated fexport-    n' <- markAnnotated n-    an2 <- markEpAnnL an1 lidl AnnDcolon-    ty' <- markAnnotated ty-    return (ForeignExport an2 n' ty' fexport')---- -----------------------------------------------------------------------instance ExactPrint (ForeignImport GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (CImport (L ls src) cconv safety@(L ll _) mh imp) = do-    cconv' <- markAnnotated cconv-    unless (ll == noSrcSpan) $ markAnnotated safety >> return ()-    unless (ls == noSrcSpan) $ markExternalSourceText ls src "" >> return ()-    return (CImport (L ls src) cconv' safety mh imp)---- -----------------------------------------------------------------------instance ExactPrint (ForeignExport GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (CExport (L ls src) spec) = do-    debugM $ "CExport starting"-    spec' <- markAnnotated spec-    unless (ls == noSrcSpan) $ markExternalSourceText ls src ""-    return (CExport (L ls src) spec')---- -----------------------------------------------------------------------instance ExactPrint CExportSpec where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (CExportStatic st lbl cconv) = do-    debugM $ "CExportStatic starting"-    cconv' <- markAnnotated cconv-    return (CExportStatic st lbl cconv')---- -----------------------------------------------------------------------instance ExactPrint Safety where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact = withPpr---- -----------------------------------------------------------------------instance ExactPrint CCallConv where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact = withPpr---- -----------------------------------------------------------------------instance ExactPrint (WarnDecls GhcPs) where-  getAnnotationEntry (Warnings (an,_) _) = fromAnn an-  setAnnotationAnchor (Warnings (an,a) b) anc cs = Warnings ((setAnchorEpa an anc cs),a) b--  exact (Warnings (an,src) warns) = do-    an0 <- markAnnOpen an src "{-# WARNING" -- Note: might be {-# DEPRECATED-    warns' <- markAnnotated warns-    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")-    return (Warnings (an1,src) warns')---- -----------------------------------------------------------------------instance ExactPrint (WarnDecl GhcPs) where-  getAnnotationEntry (Warning an _ _) = fromAnn an-  setAnnotationAnchor (Warning an a b) anc cs = Warning (setAnchorEpa an anc cs) a b--  exact (Warning an lns  (WarningTxt mb_cat src ls )) = do-    mb_cat' <- markAnnotated mb_cat-    lns' <- markAnnotated lns-    an0 <- markEpAnnL an lidl AnnOpenS -- "["-    ls' <- markAnnotated ls-    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"-    return (Warning an1 lns'  (WarningTxt mb_cat' src ls'))--  exact (Warning an lns (DeprecatedTxt src ls)) = do-    lns' <- markAnnotated lns-    an0 <- markEpAnnL an lidl AnnOpenS -- "["-    ls' <- markAnnotated ls-    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"-    return (Warning an1 lns' (DeprecatedTxt src ls'))---- -----------------------------------------------------------------------instance ExactPrint StringLiteral where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact l@(StringLiteral src fs mcomma) = do-    printSourceText src (show (unpackFS fs))-    mapM_ (\r -> printStringAtRs r ",") mcomma-    return l---- -----------------------------------------------------------------------instance ExactPrint FastString where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.-  -- exact fs = printStringAdvance (show (unpackFS fs))-  exact fs = printStringAdvance (unpackFS fs) >> return fs---- -----------------------------------------------------------------------instance ExactPrint (RuleDecls GhcPs) where-  getAnnotationEntry (HsRules (an,_) _) = fromAnn an-  setAnnotationAnchor (HsRules (an,a) b) anc cs = HsRules ((setAnchorEpa an anc cs),a) b-  exact (HsRules (an, src) rules) = do-    an0 <--      case src of-        NoSourceText      -> markEpAnnLMS an lidl AnnOpen  (Just "{-# RULES")-        SourceText srcTxt -> markEpAnnLMS an lidl AnnOpen  (Just $ unpackFS srcTxt)-    rules' <- markAnnotated rules-    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")-    return (HsRules (an1,src) rules')---- -----------------------------------------------------------------------instance ExactPrint (RuleDecl GhcPs) where-  getAnnotationEntry (HsRule {rd_ext = (an,_)}) = fromAnn an-  setAnnotationAnchor r@(HsRule {rd_ext = (an,a)}) anc cs-    = r { rd_ext = (setAnchorEpa an anc cs, a)}-  exact (HsRule (an,nsrc) (L ln n) act mtybndrs termbndrs lhs rhs) = do-    debugM "HsRule entered"-    (L ln' _) <- markAnnotated (L ln (nsrc, n))-    debugM "HsRule after ln"-    an0 <- markActivation an lra_rest act-    debugM "HsRule after act"-    (an1, mtybndrs') <--      case mtybndrs of-        Nothing -> return (an0, Nothing)-        Just bndrs -> do-          an1 <-  markLensMAA an0 lra_tyanns_fst  -- AnnForall-          bndrs' <- mapM markAnnotated bndrs-          an2 <- markLensMAA an1 lra_tyanns_snd  -- AnnDot-          return (an2, Just bndrs')--    an2 <- markLensMAA an1 lra_tmanns_fst  -- AnnForall-    termbndrs' <- mapM markAnnotated termbndrs-    an3 <- markLensMAA an2 lra_tmanns_snd  -- AnnDot--    lhs' <- markAnnotated lhs-    an4 <- markEpAnnL an3 lra_rest AnnEqual-    rhs' <- markAnnotated rhs-    return (HsRule (an4,nsrc) (L ln' n) act mtybndrs' termbndrs' lhs' rhs')--markActivation :: (Monad m, Monoid w)-  => EpAnn a -> Lens a [AddEpAnn] -> Activation -> EP w m (EpAnn a)-markActivation an l act = do-  case act of-    ActiveBefore src phase -> do-      an0 <- markEpAnnL an l AnnOpenS --  '['-      an1 <- markEpAnnL an0 l AnnTilde -- ~-      an2 <- markEpAnnLMS an1 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))-      an3 <- markEpAnnL an2 l AnnCloseS -- ']'-      return an3-    ActiveAfter src phase -> do-      an0 <- markEpAnnL an l AnnOpenS --  '['-      an1 <- markEpAnnLMS an0 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))-      an2 <- markEpAnnL an1 l AnnCloseS -- ']'-      return an2-    NeverActive -> do-      an0 <- markEpAnnL an l AnnOpenS --  '['-      an1 <- markEpAnnL an0 l AnnTilde -- ~-      an2 <- markEpAnnL an1 l AnnCloseS -- ']'-      return an2-    _ -> return an---- -----------------------------------------------------------------------instance ExactPrint (SpliceDecl GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (SpliceDecl x splice flag) = do-    splice' <- markAnnotated splice-    return (SpliceDecl x splice' flag)---- -----------------------------------------------------------------------instance ExactPrint (DocDecl GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact v = return v-  -- exact v = case v of-  --   (DocCommentNext ds)    -> DocCommentNext <$> exact ds-  --   (DocCommentPrev ds)    -> DocCommentPrev <$> exact ds-  --   (DocCommentNamed s ds) -> DocCommentNamed s <$> exact ds-  --   (DocGroup i ds)        -> DocGroup i <$> exact ds---- -----------------------------------------------------------------------instance ExactPrint (RoleAnnotDecl GhcPs) where-  getAnnotationEntry (RoleAnnotDecl an _ _) = fromAnn an-  setAnnotationAnchor (RoleAnnotDecl an a b) anc cs = RoleAnnotDecl (setAnchorEpa an anc cs) a b-  exact (RoleAnnotDecl an ltycon roles) = do-    an0 <- markEpAnnL an lidl AnnType-    an1 <- markEpAnnL an0 lidl AnnRole-    ltycon' <- markAnnotated ltycon-    let markRole (L l (Just r)) = do-          (L _ r') <- markAnnotated (L l r)-          return (L l (Just r'))-        markRole (L l Nothing) = do-          printStringAtSs (locA l) "_"-          return (L l Nothing)-    roles' <- mapM markRole roles-    return (RoleAnnotDecl an1 ltycon' roles')---- -----------------------------------------------------------------------instance ExactPrint Role where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact = withPpr---- -----------------------------------------------------------------------instance ExactPrint (RuleBndr GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (RuleBndr x ln) = do-    ln' <- markAnnotated ln-    return (RuleBndr x ln')-  exact (RuleBndrSig an ln (HsPS x ty)) = do-    an0 <- markEpAnnL an lidl AnnOpenP -- "("-    ln' <- markAnnotated ln-    an1 <- markEpAnnL an0 lidl AnnDcolon-    ty' <- markAnnotated ty-    an2 <- markEpAnnL an1 lidl AnnCloseP -- ")"-    return (RuleBndrSig an2 ln' (HsPS x ty'))---- -----------------------------------------------------------------------instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where-  getAnnotationEntry (FamEqn { feqn_ext = an}) = fromAnn an-  setAnnotationAnchor fe anc cs = fe {feqn_ext = setAnchorEpa (feqn_ext fe) anc cs}-  exact (FamEqn { feqn_ext = an-                , feqn_tycon  = tycon-                , feqn_bndrs  = bndrs-                , feqn_pats   = pats-                , feqn_fixity = fixity-                , feqn_rhs    = rhs }) = do-    (an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS an tycon bndrs pats fixity Nothing-    an1 <- markEpAnnL an0 lidl AnnEqual-    rhs' <- markAnnotated rhs-    return (FamEqn { feqn_ext = an1-                   , feqn_tycon  = tycon'-                   , feqn_bndrs  = bndrs'-                   , feqn_pats   = pats'-                   , feqn_fixity = fixity-                   , feqn_rhs    = rhs' })---- -----------------------------------------------------------------------exactHsFamInstLHS ::-      (Monad m, Monoid w)-   => EpAnn [AddEpAnn]-   -> LocatedN RdrName-   -> HsOuterTyVarBndrs () GhcPs-   -> HsTyPats GhcPs-   -> LexicalFixity-   -> Maybe (LHsContext GhcPs)-   -> EP w m ( EpAnn [AddEpAnn]-             , LocatedN RdrName-             , HsOuterTyVarBndrs () GhcPs-             , HsTyPats GhcPs, Maybe (LHsContext GhcPs))-exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do-  an0 <- markEpAnnL an lidl AnnForall-  bndrs' <- markAnnotated bndrs-  an1 <- markEpAnnL an0 lidl AnnDot-  mb_ctxt' <- mapM markAnnotated mb_ctxt-  (an2, thing', typats') <- exact_pats an1 typats-  return (an2, thing', bndrs', typats', mb_ctxt')-  where-    exact_pats :: (Monad m, Monoid w)-      => EpAnn [AddEpAnn] -> HsTyPats GhcPs -> EP w m (EpAnn [AddEpAnn], LocatedN RdrName, HsTyPats GhcPs)-    exact_pats an' (patl:patr:pats)-      | Infix <- fixity-      = let exact_op_app = do-              an0 <- markEpAnnAllL an' lidl AnnOpenP-              patl' <- markAnnotated patl-              thing' <- markAnnotated thing-              patr' <- markAnnotated patr-              an1 <- markEpAnnAllL an0 lidl AnnCloseP-              return (an1, thing', [patl',patr'])-        in case pats of-             [] -> exact_op_app-             _  -> do-               (an0, thing', p) <- exact_op_app-               pats' <- mapM markAnnotated pats-               return (an0, thing', p++pats')--    exact_pats an' pats = do-      an0 <- markEpAnnAllL an' lidl AnnOpenP-      thing' <- markAnnotated thing-      pats' <- markAnnotated pats-      an1 <- markEpAnnAllL an0 lidl AnnCloseP-      return (an1, thing', pats')---- -----------------------------------------------------------------------instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)-     =>  ExactPrint (HsArg GhcPs tm ty) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact a@(HsValArg tm)    = markAnnotated tm >> return a-  exact a@(HsTypeArg at ty) = markToken at >> markAnnotated ty >> return a-  exact x@(HsArgPar _sp)   = withPpr x -- Does not appear in original source---- -----------------------------------------------------------------------instance ExactPrint (ClsInstDecl GhcPs) where-  getAnnotationEntry cid = fromAnn (fst $ cid_ext cid)-  setAnnotationAnchor cid anc cs-    = cid { cid_ext = (setAnchorEpa (fst $ cid_ext cid) anc cs, (snd $ cid_ext cid)) }--  exact (ClsInstDecl { cid_ext = (an, sortKey)-                     , cid_poly_ty = inst_ty, cid_binds = binds-                     , cid_sigs = sigs, cid_tyfam_insts = ats-                     , cid_overlap_mode = mbOverlap-                     , cid_datafam_insts = adts })-      = do-          (an0, mbOverlap', inst_ty') <- top_matter-          an1 <- markEpAnnL an0 lidl AnnOpenC-          an2 <- markEpAnnAllL an1 lid AnnSemi-          ds <- withSortKey sortKey-                               (prepareListAnnotationA ats-                             ++ prepareListAnnotationF an adts-                             ++ prepareListAnnotationA (bagToList binds)-                             ++ prepareListAnnotationA sigs-                               )-          an3 <- markEpAnnL an2 lidl AnnCloseC -- '}'-          let-            ats'   = undynamic ds-            adts'  = undynamic ds-            binds' = listToBag $ undynamic ds-            sigs'  = undynamic ds-          return (ClsInstDecl { cid_ext = (an3, sortKey)-                              , cid_poly_ty = inst_ty', cid_binds = binds'-                              , cid_sigs = sigs', cid_tyfam_insts = ats'-                              , cid_overlap_mode = mbOverlap'-                              , cid_datafam_insts = adts' })--      where-        top_matter = do-          an0 <- markEpAnnL an lidl AnnInstance-          mo <- mapM markAnnotated mbOverlap-          it <- markAnnotated inst_ty-          an1 <- markEpAnnL an0 lidl AnnWhere -- Optional-          return (an1, mo,it)---- -----------------------------------------------------------------------instance ExactPrint (TyFamInstDecl GhcPs) where-  getAnnotationEntry (TyFamInstDecl an _) = fromAnn an-  setAnnotationAnchor (TyFamInstDecl an a) anc cs = TyFamInstDecl (setAnchorEpa an anc cs) a--  exact d@(TyFamInstDecl { tfid_xtn = an, tfid_eqn = eqn }) = do-    an0 <- markEpAnnL an lidl AnnType-    an1 <- markEpAnnL an0 lidl AnnInstance-    eqn' <- markAnnotated eqn-    return (d { tfid_xtn = an1, tfid_eqn = eqn' })---- -----------------------------------------------------------------------instance ExactPrint (LocatedP OverlapMode) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn--  -- NOTE: NoOverlap is only used in the typechecker-  exact (L (SrcSpanAnn an l) (NoOverlap src)) = do-    an0 <- markAnnOpenP an src "{-# NO_OVERLAP"-    an1 <- markAnnCloseP an0-    return (L (SrcSpanAnn an1 l) (NoOverlap src))--  exact (L (SrcSpanAnn an l) (Overlappable src)) = do-    an0 <- markAnnOpenP an src "{-# OVERLAPPABLE"-    an1 <- markAnnCloseP an0-    return (L (SrcSpanAnn an1 l) (Overlappable src))--  exact (L (SrcSpanAnn an l) (Overlapping src)) = do-    an0 <- markAnnOpenP an src "{-# OVERLAPPING"-    an1 <- markAnnCloseP an0-    return (L (SrcSpanAnn an1 l) (Overlapping src))--  exact (L (SrcSpanAnn an l) (Overlaps src)) = do-    an0 <- markAnnOpenP an src "{-# OVERLAPS"-    an1 <- markAnnCloseP an0-    return (L (SrcSpanAnn an1 l) (Overlaps src))--  exact (L (SrcSpanAnn an l) (Incoherent src)) = do-    an0 <- markAnnOpenP an src "{-# INCOHERENT"-    an1 <- markAnnCloseP an0-    return (L (SrcSpanAnn an1 l) (Incoherent src))--  exact (L (SrcSpanAnn an l) (NonCanonical src)) = do-    an0 <- markAnnOpenP an src "{-# INCOHERENT"-    an1 <- markAnnCloseP an0-    return (L (SrcSpanAnn an1 l) (Incoherent src))---- -----------------------------------------------------------------------instance ExactPrint (HsBind GhcPs) where-  getAnnotationEntry FunBind{} = NoEntryVal-  getAnnotationEntry PatBind{pat_ext=an} = fromAnn an-  getAnnotationEntry VarBind{} = NoEntryVal-  getAnnotationEntry PatSynBind{} = NoEntryVal--  setAnnotationAnchor pb@PatBind{} anc cs = pb { pat_ext = setAnchorEpa (pat_ext pb) anc cs}-  setAnnotationAnchor a _ _ = a--  exact (FunBind x fid matches) = do-    matches' <- markAnnotated matches-    let-      fun_id' = case unLoc (mg_alts matches') of-        [] -> fid-        (L _ m:_) -> case m_ctxt m of-          FunRhs f _ _ -> f-          _ -> fid-    return (FunBind x fun_id' matches')--  exact (PatBind x pat grhss) = do-    pat' <- markAnnotated pat-    grhss' <- markAnnotated grhss-    return (PatBind x pat' grhss')-  exact (PatSynBind x bind) = do-    bind' <- markAnnotated bind-    return (PatSynBind x bind')--  exact x = error $ "HsBind: exact for " ++ showAst x---- -----------------------------------------------------------------------instance ExactPrint (PatSynBind GhcPs GhcPs) where-  getAnnotationEntry (PSB { psb_ext = an}) = fromAnn an-  setAnnotationAnchor p anc cs = p { psb_ext = setAnchorEpa (psb_ext p) anc cs}--  exact (PSB{ psb_ext = an-            , psb_id = psyn, psb_args = details-            , psb_def = pat-            , psb_dir = dir }) = do-    an0 <- markEpAnnL an lidl AnnPattern-    (an1, psyn', details') <--      case details of-        InfixCon v1 v2 -> do-          v1' <- markAnnotated v1-          psyn' <- markAnnotated psyn-          v2' <- markAnnotated v2-          return (an0, psyn',InfixCon v1' v2')-        PrefixCon tvs vs -> do-          psyn' <- markAnnotated psyn-          tvs' <- markAnnotated tvs-          vs' <- markAnnotated vs-          return (an0, psyn', PrefixCon tvs' vs')-        RecCon vs -> do-          psyn' <- markAnnotated psyn-          an1 <- markEpAnnL an0 lidl AnnOpenC  -- '{'-          vs' <- markAnnotated vs-          an2 <- markEpAnnL an1 lidl AnnCloseC -- '}'-          return (an2, psyn', RecCon vs')--    (an2, pat', dir') <--      case dir of-        Unidirectional           -> do-          an2 <- markEpAnnL an1 lidl AnnLarrow-          pat' <- markAnnotated pat-          return (an2, pat', dir)-        ImplicitBidirectional    -> do-          an2 <- markEpAnnL an1 lidl AnnEqual-          pat' <- markAnnotated pat-          return (an2, pat', dir)-        ExplicitBidirectional mg -> do-          an2 <- markEpAnnL an1 lidl AnnLarrow-          pat' <- markAnnotated pat-          an3 <- markEpAnnL an2 lidl  AnnWhere-          mg' <- markAnnotated mg-          return (an3, pat', ExplicitBidirectional mg')--    return (PSB{ psb_ext = an2-               , psb_id = psyn', psb_args = details'-               , psb_def = pat'-               , psb_dir = dir' })----- -----------------------------------------------------------------------instance ExactPrint (RecordPatSynField GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact r@(RecordPatSynField { recordPatSynField = v }) = markAnnotated v-        >> return r---- -----------------------------------------------------------------------instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry (Match ann _ _ _) = fromAnn ann-  setAnnotationAnchor (Match an a b c) anc cs = Match (setAnchorEpa an anc cs) a b c--  exact (Match an mctxt pats grhss) =-    exactMatch (Match an mctxt pats grhss)---- ---------------------------------------instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry (Match ann _ _ _) = fromAnn ann-  setAnnotationAnchor (Match an a b c) anc cs = Match (setAnchorEpa an anc cs) a b c--  exact (Match an mctxt pats grhss) =-    exactMatch (Match an mctxt pats grhss)---- -----------------------------------------------------------------------exactMatch :: (Monad m, Monoid w) => (ExactPrint (GRHSs GhcPs body)) => (Match GhcPs body) -> EP w m (Match GhcPs body)-exactMatch (Match an mctxt pats grhss) = do--  debugM $ "exact Match entered"--  (an0, mctxt', pats') <--    case mctxt of-      FunRhs fun fixity strictness -> do-        debugM $ "exact Match FunRhs:" ++ showPprUnsafe fun-        an0' <--          case strictness of-            SrcStrict -> markEpAnnL an lidl AnnBang-            _ -> pure an-        case fixity of-          Prefix -> do-            an' <- annotationsToComments an0' lidl [AnnOpenP,AnnCloseP]-            fun' <- markAnnotated fun-            pats' <- markAnnotated pats-            return (an', FunRhs fun' fixity strictness, pats')-          Infix ->-            case pats of-              (p1:p2:rest)-                | null rest -> do-                    p1'  <- markAnnotated p1-                    fun' <- markAnnotated fun-                    p2'  <- markAnnotated p2-                    return (an0', FunRhs fun' fixity strictness, [p1',p2'])-                | otherwise -> do-                    an0  <- markEpAnnL an0' lidl AnnOpenP-                    p1'  <- markAnnotated p1-                    fun' <- markAnnotated fun-                    p2'  <- markAnnotated p2-                    an1  <- markEpAnnL an0 lidl AnnCloseP-                    rest' <- mapM markAnnotated rest-                    return (an1, FunRhs fun' fixity strictness, p1':p2':rest')-              _ -> panic "FunRhs"-      LambdaExpr -> do-        an0' <- markEpAnnL an lidl AnnLam-        pats' <- markAnnotated pats-        return (an0', LambdaExpr, pats')-      CaseAlt -> do-        pats' <- markAnnotated pats-        return (an, CaseAlt, pats')-      LamCaseAlt v -> do-        pats' <- markAnnotated pats-        return (an, LamCaseAlt v, pats')-      _ -> do-        mctxt' <- withPpr mctxt-        return (an, mctxt', pats)--  grhss' <- markAnnotated grhss--  return (Match an0 mctxt' pats' grhss')---- -----------------------------------------------------------------------instance ExactPrint (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (GRHSs cs grhss binds) = do-    addCommentsA $ priorComments cs-    addCommentsA $ getFollowingComments cs-    grhss' <- markAnnotated grhss-    binds' <- markAnnotated binds-    -- The comments will be added back as they are printed-    return (GRHSs emptyComments grhss' binds')---instance ExactPrint (GRHSs GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (GRHSs cs grhss binds) = do-    addCommentsA $ priorComments cs-    addCommentsA $ getFollowingComments cs-    grhss' <- markAnnotated grhss-    binds' <- markAnnotated binds-    -- The comments will be added back as they are printed-    return (GRHSs emptyComments grhss' binds')---- -----------------------------------------------------------------------instance ExactPrint (HsLocalBinds GhcPs) where-  getAnnotationEntry (HsValBinds an _) = fromAnn an-  getAnnotationEntry (HsIPBinds{}) = NoEntryVal-  getAnnotationEntry (EmptyLocalBinds{}) = NoEntryVal--  setAnnotationAnchor (HsValBinds an a) anc cs = HsValBinds (setAnchorEpaL an anc cs) a-  setAnnotationAnchor a _ _ = a--  exact (HsValBinds an valbinds) = do-    debugM $ "exact HsValBinds: an=" ++ showAst an-    an0 <- markEpAnnL an lal_rest AnnWhere--    let manc = case an of-                 EpAnnNotUsed -> Nothing-                 _ -> al_anchor $ anns an--    case manc of-      Just anc -> do-        when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)-      _ -> return ()--    (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds-    debugM $ "exact HsValBinds: an1=" ++ showAst an1-    return (HsValBinds an1 valbinds')--  exact (HsIPBinds an bs) = do-    (as, ipb) <- markAnnList True an (markEpAnnL an lal_rest AnnWhere-                           >> markAnnotated bs-                           >>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs))-    case ipb of-      HsIPBinds _ bs' -> return (HsIPBinds as bs'::HsLocalBinds GhcPs)-      _ -> error "should not happen HsIPBinds"-  exact b@(EmptyLocalBinds _) = return b----- ----------------------------------------------------------------------instance ExactPrint (HsValBindsLR GhcPs GhcPs) where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (ValBinds sortKey binds sigs) = do-    ds <- setLayoutBoth $ withSortKey sortKey-       (prepareListAnnotationA (bagToList binds)-     ++ prepareListAnnotationA sigs-       )-    let-      binds' = listToBag $ undynamic ds-      sigs'  = undynamic ds-    return (ValBinds sortKey binds' sigs')-  exact (XValBindsLR _) = panic "XValBindsLR"--undynamic :: Typeable a => [Dynamic] -> [a]-undynamic ds = mapMaybe fromDynamic ds---- -----------------------------------------------------------------------instance ExactPrint (HsIPBinds GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact b@(IPBinds _ binds) = setLayoutBoth $ markAnnotated binds >> return b---- -----------------------------------------------------------------------instance ExactPrint (IPBind GhcPs) where-  getAnnotationEntry (IPBind an _ _) = fromAnn an-  setAnnotationAnchor (IPBind an a b) anc cs = IPBind (setAnchorEpa an anc cs) a b--  exact (IPBind an lr rhs) = do-    lr' <- markAnnotated lr-    an0 <- markEpAnnL an lidl AnnEqual-    rhs' <- markAnnotated rhs-    return (IPBind an0 lr' rhs')----- -----------------------------------------------------------------------instance ExactPrint HsIPName where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact i@(HsIPName fs) = printStringAdvance ("?" ++ (unpackFS fs)) >> return i---- ------------------------------------------------------------------------ Managing lists which have been separated, e.g. Sigs and Binds--prepareListAnnotationF :: (Monad m, Monoid w) =>-  EpAnn [AddEpAnn] -> [LDataFamInstDecl GhcPs] -> [(RealSrcSpan,EP w m Dynamic)]-prepareListAnnotationF an ls = map (\b -> (realSrcSpan $ getLocA b, go b)) ls-  where-    go (L l a) = do-      d' <- markAnnotated (DataFamInstDeclWithContext an NotTopLevel a)-      return (toDyn (L l (dc_d d')))--prepareListAnnotationA :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))-  => [LocatedAn an a] -> [(RealSrcSpan,EP w m Dynamic)]-prepareListAnnotationA ls = map (\b -> (realSrcSpan $ getLocA b,go b)) ls-  where-    go b = do-      b' <- markAnnotated b-      return (toDyn b')--withSortKey :: (Monad m, Monoid w) => AnnSortKey -> [(RealSrcSpan, EP w m Dynamic)] -> EP w m [Dynamic]-withSortKey annSortKey xs = do-  debugM $ "withSortKey:annSortKey=" ++ showAst annSortKey-  let ordered = case annSortKey of-                  NoAnnSortKey -> sortBy orderByFst xs-                  -- Just keys -> error $ "withSortKey: keys" ++ show keys-                  AnnSortKey keys -> orderByKey xs keys-                                -- `debug` ("withSortKey:" ++-                                --          showPprUnsafe (map fst (sortBy (comparing (flip elemIndex keys . fst)) xs),-                                --                  map fst xs,-                                --                  keys)-                                --          )-  mapM snd ordered--orderByFst :: Ord a => (a, b1) -> (a, b2) -> Ordering-orderByFst (a,_) (b,_) = compare a b---- -----------------------------------------------------------------------instance ExactPrint (Sig GhcPs) where-  getAnnotationEntry (TypeSig a _ _)  = fromAnn a-  getAnnotationEntry (PatSynSig a _ _) = fromAnn a-  getAnnotationEntry (ClassOpSig a _ _ _) = fromAnn a-  getAnnotationEntry (FixSig a _) = fromAnn a-  getAnnotationEntry (InlineSig a _ _) = fromAnn a-  getAnnotationEntry (SpecSig a _ _ _) = fromAnn a-  getAnnotationEntry (SpecInstSig (a, _) _) = fromAnn a-  getAnnotationEntry (MinimalSig (a, _) _) = fromAnn a-  getAnnotationEntry (SCCFunSig (a, _) _ _) = fromAnn a-  getAnnotationEntry (CompleteMatchSig (a, _) _ _) = fromAnn a--  setAnnotationAnchor (TypeSig a x y)  anc           cs = (TypeSig (setAnchorEpa a anc cs) x y)-  setAnnotationAnchor (PatSynSig a x y) anc          cs = (PatSynSig (setAnchorEpa a anc cs) x y)-  setAnnotationAnchor (ClassOpSig a x y z) anc       cs = (ClassOpSig (setAnchorEpa a anc cs) x y z)-  setAnnotationAnchor (FixSig a x) anc               cs = (FixSig (setAnchorEpa a anc cs) x)-  setAnnotationAnchor (InlineSig a x y) anc          cs = (InlineSig (setAnchorEpa a anc cs) x y)-  setAnnotationAnchor (SpecSig a x y z) anc          cs = (SpecSig (setAnchorEpa a anc cs) x y z)-  setAnnotationAnchor (SpecInstSig (a,x) y) anc      cs = (SpecInstSig ((setAnchorEpa a anc cs),x) y)-  setAnnotationAnchor (MinimalSig (a,x) y) anc       cs = (MinimalSig ((setAnchorEpa a anc cs),x) y)-  setAnnotationAnchor (SCCFunSig (a,x) y z) anc      cs = (SCCFunSig ((setAnchorEpa a anc cs),x) y z)-  setAnnotationAnchor (CompleteMatchSig (a,x) y z) anc cs = (CompleteMatchSig ((setAnchorEpa a anc cs),x) y z)--  exact (TypeSig an vars ty)  = do-    (an', vars', ty') <- exactVarSig an vars ty-    return (TypeSig an' vars' ty')--  exact (PatSynSig an lns typ) = do-    an0 <- markEpAnnL an lasRest AnnPattern-    lns' <- markAnnotated lns-    an1 <- markLensAA an0 lasDcolon-    typ' <- markAnnotated typ-    return (PatSynSig an1 lns' typ')--  exact (ClassOpSig an is_deflt vars ty)-    | is_deflt  = do-        an0 <- markEpAnnL an lasRest AnnDefault-        (an1, vars',ty') <- exactVarSig an0 vars ty-        return (ClassOpSig an1 is_deflt vars' ty')-    | otherwise = do-        (an0, vars',ty') <- exactVarSig an vars ty-        return (ClassOpSig an0 is_deflt vars' ty')--  exact (FixSig an (FixitySig x names (Fixity src v fdir))) = do-    let fixstr = case fdir of-         InfixL -> "infixl"-         InfixR -> "infixr"-         InfixN -> "infix"-    an0 <- markEpAnnLMS an  lidl AnnInfix (Just fixstr)-    an1 <- markEpAnnLMS an0 lidl AnnVal (Just (sourceTextToString src (show v)))-    names' <- markAnnotated names-    return (FixSig an1 (FixitySig x names' (Fixity src v fdir)))--  exact (InlineSig an ln inl) = do-    an0 <- markAnnOpen an (inl_src inl) "{-# INLINE"-    an1 <- markActivation an0 id (inl_act inl)-    ln' <- markAnnotated ln-    debugM $ "InlineSig:an=" ++ showAst an-    p <- getPosP-    debugM $ "InlineSig: p=" ++ show p-    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "#-}")-    debugM $ "InlineSig:done"-    return (InlineSig an2 ln' inl)--  exact (SpecSig an ln typs inl) = do-    an0 <- markAnnOpen an (inl_src inl) "{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE-    an1 <- markActivation an0 lidl (inl_act inl)-    ln' <- markAnnotated ln-    an2 <- markEpAnnL an1 lidl AnnDcolon-    typs' <- markAnnotated typs-    an3 <- markEpAnnLMS an2 lidl AnnClose (Just "#-}")-    return (SpecSig an3 ln' typs' inl)--  exact (SpecInstSig (an,src) typ) = do-    an0 <- markAnnOpen an src "{-# SPECIALISE"-    an1 <- markEpAnnL an0 lidl AnnInstance-    typ' <- markAnnotated typ-    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "#-}")-    return (SpecInstSig (an2,src) typ')--  exact (MinimalSig (an,src) formula) = do-    an0 <- markAnnOpen an src "{-# MINIMAL"-    formula' <- markAnnotated formula-    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")-    return (MinimalSig (an1,src) formula')--  exact (SCCFunSig (an,src) ln ml) = do-    an0 <- markAnnOpen an src "{-# SCC"-    ln' <- markAnnotated ln-    ml' <- markAnnotated ml-    an1 <- markEpAnnLMS an0 lidl AnnClose (Just "#-}")-    return (SCCFunSig (an1,src) ln' ml')--  exact (CompleteMatchSig (an,src) cs mty) = do-    an0 <- markAnnOpen an src "{-# COMPLETE"-    cs' <- markAnnotated cs-    (an1, mty') <--      case mty of-        Nothing -> return (an0, mty)-        Just ty -> do-          an1 <- markEpAnnL an0 lidl AnnDcolon-          ty' <- markAnnotated ty-          return (an1, Just ty')-    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "#-}")-    return (CompleteMatchSig (an2,src) cs' mty')---- -----------------------------------------------------------------------exactVarSig :: (Monad m, Monoid w, ExactPrint a)-  => EpAnn AnnSig -> [LocatedN RdrName] -> a -> EP w m (EpAnn AnnSig, [LocatedN RdrName], a)-exactVarSig an vars ty = do-  vars' <- mapM markAnnotated vars-  an0 <- markLensAA an lasDcolon-  ty' <- markAnnotated ty-  return (an0, vars', ty')---- -----------------------------------------------------------------------instance ExactPrint (StandaloneKindSig GhcPs) where-  getAnnotationEntry (StandaloneKindSig an _ _) = fromAnn an-  setAnnotationAnchor (StandaloneKindSig an a b) anc cs = StandaloneKindSig (setAnchorEpa an anc cs) a b--  exact (StandaloneKindSig an vars sig) = do-    an0 <- markEpAnnL an lidl AnnType-    vars' <- markAnnotated vars-    an1 <- markEpAnnL an0 lidl AnnDcolon-    sig' <- markAnnotated sig-    return (StandaloneKindSig an1 vars' sig')---- -----------------------------------------------------------------------instance ExactPrint (DefaultDecl GhcPs) where-  getAnnotationEntry (DefaultDecl an _) = fromAnn an-  setAnnotationAnchor (DefaultDecl an a) anc cs = DefaultDecl (setAnchorEpa an anc cs) a--  exact (DefaultDecl an tys) = do-    an0 <- markEpAnnL an lidl AnnDefault-    an1 <- markEpAnnL an0 lidl AnnOpenP-    tys' <- markAnnotated tys-    an2 <- markEpAnnL an1 lidl AnnCloseP-    return (DefaultDecl an2 tys')---- -----------------------------------------------------------------------instance ExactPrint (AnnDecl GhcPs) where-  getAnnotationEntry (HsAnnotation (an, _) _ _) = fromAnn an-  setAnnotationAnchor (HsAnnotation (an,a) b c) anc cs = HsAnnotation ((setAnchorEpa an anc cs),a) b c--  exact (HsAnnotation (an, src) prov e) = do-    an0 <- markAnnOpenP an src "{-# ANN"-    (an1, prov') <--      case prov of-        (ValueAnnProvenance n) -> do-          n' <- markAnnotated n-          return (an0, ValueAnnProvenance n')-        (TypeAnnProvenance n) -> do-          an1 <- markEpAnnL an0 lapr_rest AnnType-          n' <- markAnnotated n-          return (an1, TypeAnnProvenance n')-        ModuleAnnProvenance -> do-          an1 <- markEpAnnL an lapr_rest AnnModule-          return (an1, prov)--    e' <- markAnnotated e-    an2 <- markAnnCloseP an1-    return (HsAnnotation (an2,src) prov' e')---- -----------------------------------------------------------------------instance ExactPrint (BF.BooleanFormula (LocatedN RdrName)) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (BF.Var x)  = do-    x' <- markAnnotated x-    return (BF.Var x')-  exact (BF.Or ls)  = do-    ls' <- markAnnotated ls-    return (BF.Or ls')-  exact (BF.And ls) = do-    ls' <- markAnnotated ls-    return (BF.And ls')-  exact (BF.Parens x)  = do-    x' <- markAnnotated x-    return (BF.Parens x')---- -----------------------------------------------------------------------instance (ExactPrint body) => ExactPrint (HsWildCardBndrs GhcPs body) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (HsWC x ty) = do-    ty' <- markAnnotated ty-    return (HsWC x ty')---- -----------------------------------------------------------------------instance ExactPrint (GRHS GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry (GRHS an _ _) = fromAnn an-  setAnnotationAnchor (GRHS an a b) anc cs = GRHS (setAnchorEpa an anc cs) a b--  exact (GRHS an guards expr) = do-    debugM $ "GRHS comments:" ++ showGhc (comments an)-    an0 <- if null guards-             then return an-             else markLensKwM an lga_vbar AnnVbar-    guards' <- markAnnotated guards-    debugM $ "GRHS before matchSeparator"-    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs-    debugM $ "GRHS after matchSeparator"-    expr' <- markAnnotated expr-    return (GRHS an1 guards' expr')--instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry (GRHS ann _ _) = fromAnn ann-  setAnnotationAnchor (GRHS an a b) anc cs = GRHS (setAnchorEpa an anc cs) a b--  exact (GRHS an guards expr) = do-    an0 <- markLensKwM an lga_vbar AnnVbar-    guards' <- markAnnotated guards-    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs-    expr' <- markAnnotated expr-    return (GRHS an1 guards' expr')---- -----------------------------------------------------------------------instance ExactPrint (HsExpr GhcPs) where-  getAnnotationEntry (HsVar{})                    = NoEntryVal-  getAnnotationEntry (HsUnboundVar an _)          = fromAnn an-  getAnnotationEntry (HsRecSel{})                 = NoEntryVal-  getAnnotationEntry (HsOverLabel an _ _)         = fromAnn an-  getAnnotationEntry (HsIPVar an _)               = fromAnn an-  getAnnotationEntry (HsOverLit an _)             = fromAnn an-  getAnnotationEntry (HsLit an _)                 = fromAnn an-  getAnnotationEntry (HsLam _ _)                  = NoEntryVal-  getAnnotationEntry (HsLamCase an _ _)           = fromAnn an-  getAnnotationEntry (HsApp an _ _)               = fromAnn an-  getAnnotationEntry (HsAppType _ _ _ _)          = NoEntryVal-  getAnnotationEntry (OpApp an _ _ _)             = fromAnn an-  getAnnotationEntry (NegApp an _ _)              = fromAnn an-  getAnnotationEntry (HsPar an _ _ _)             = fromAnn an-  getAnnotationEntry (SectionL an _ _)            = fromAnn an-  getAnnotationEntry (SectionR an _ _)            = fromAnn an-  getAnnotationEntry (ExplicitTuple an _ _)       = fromAnn an-  getAnnotationEntry (ExplicitSum an _ _ _)       = fromAnn an-  getAnnotationEntry (HsCase an _ _)              = fromAnn an-  getAnnotationEntry (HsIf an _ _ _)              = fromAnn an-  getAnnotationEntry (HsMultiIf an _)             = fromAnn an-  getAnnotationEntry (HsLet an _ _ _ _)           = fromAnn an-  getAnnotationEntry (HsDo an _ _)                = fromAnn an-  getAnnotationEntry (ExplicitList an _)          = fromAnn an-  getAnnotationEntry (RecordCon an _ _)           = fromAnn an-  getAnnotationEntry (RecordUpd an _ _)           = fromAnn an-  getAnnotationEntry (HsGetField an _ _)          = fromAnn an-  getAnnotationEntry (HsProjection an _)          = fromAnn an-  getAnnotationEntry (ExprWithTySig an _ _)       = fromAnn an-  getAnnotationEntry (ArithSeq an _ _)            = fromAnn an-  getAnnotationEntry (HsTypedBracket an _)        = fromAnn an-  getAnnotationEntry (HsUntypedBracket an _)      = fromAnn an-  getAnnotationEntry (HsTypedSplice (_, an) _)    = fromAnn an-  getAnnotationEntry (HsUntypedSplice an _)       = fromAnn an-  getAnnotationEntry (HsProc an _ _)              = fromAnn an-  getAnnotationEntry (HsStatic an _)              = fromAnn an-  getAnnotationEntry (HsPragE{})                  = NoEntryVal--  setAnnotationAnchor a@(HsVar{})              _ _s = a-  setAnnotationAnchor (HsUnboundVar an a)    anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(HsRecSel{})           _ _s  = a-  setAnnotationAnchor (HsOverLabel an s a)   anc cs = (HsOverLabel (setAnchorEpa an anc cs) s a)-  setAnnotationAnchor (HsIPVar an a)         anc cs = (HsIPVar (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsOverLit an a)       anc cs = (HsOverLit (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsLit an a)           anc cs = (HsLit (setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(HsLam _ _)            _ _s = a-  setAnnotationAnchor (HsLamCase an a b)     anc cs = (HsLamCase (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsApp an a b)         anc cs = (HsApp (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor a@(HsAppType {})      _ _s = a-  setAnnotationAnchor (OpApp an a b c)       anc cs = (OpApp (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (NegApp an a b)        anc cs = (NegApp (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsPar an a b c)       anc cs = (HsPar (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (SectionL an a b)      anc cs = (SectionL (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (SectionR an a b)      anc cs = (SectionR (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (ExplicitTuple an a b) anc cs = (ExplicitTuple (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (ExplicitSum an a b c) anc cs = (ExplicitSum (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (HsCase an a b)        anc cs = (HsCase (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsIf an a b c)        anc cs = (HsIf (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (HsMultiIf an a)       anc cs = (HsMultiIf (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsLet an a b c d)     anc cs = (HsLet (setAnchorEpa an anc cs) a b c d)-  setAnnotationAnchor (HsDo an a b)          anc cs = (HsDo (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (ExplicitList an a)    anc cs = (ExplicitList (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (RecordCon an a b)     anc cs = (RecordCon (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (RecordUpd an a b)     anc cs = (RecordUpd (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsGetField an a b)    anc cs = (HsGetField (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsProjection an a)    anc cs = (HsProjection (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (ExprWithTySig an a b) anc cs = (ExprWithTySig (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (ArithSeq an a b)      anc cs = (ArithSeq (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsTypedBracket an a)   anc cs = (HsTypedBracket (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsUntypedBracket an a) anc cs = (HsUntypedBracket (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsTypedSplice (x,an) e) anc cs = (HsTypedSplice (x,(setAnchorEpa an anc cs)) e)-  setAnnotationAnchor (HsUntypedSplice an e)  anc cs = (HsUntypedSplice (setAnchorEpa an anc cs) e)-  setAnnotationAnchor (HsProc an a b)         anc cs = (HsProc (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsStatic an a)         anc cs = (HsStatic (setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(HsPragE{})            _ _s = a--  exact (HsVar x n) = do-    n' <- markAnnotated n-    return (HsVar x n')-  exact x@(HsUnboundVar an _) = do-    case an of-      EpAnnNotUsed -> withPpr x-      EpAnn _ (EpAnnUnboundVar (ob,cb) l) _ -> do-        printStringAtAA ob "`" >> return ()-        printStringAtAA l  "_" >> return ()-        printStringAtAA cb "`" >> return ()-        return x-  exact x@(HsOverLabel _ src l) = do-    printStringAtLsDelta (SameLine 0) "#"-    case src of-      NoSourceText   -> printStringAtLsDelta (SameLine 0) (unpackFS l)-      SourceText txt -> printStringAtLsDelta (SameLine 0) (unpackFS txt)-    return x--  exact x@(HsIPVar _ (HsIPName n))-    = printStringAdvance ("?" ++ unpackFS n) >> return x--  exact x@(HsOverLit _an ol) = do-    let str = case ol_val ol of-                HsIntegral   (IL src _ _) -> src-                HsFractional (FL { fl_text = src }) -> src-                HsIsString src _          -> src-    case str of-      SourceText s -> printStringAdvance (unpackFS s) >> return ()-      NoSourceText -> withPpr x >> return ()-    return x--  exact (HsLit an lit) = do-    lit' <- withPpr lit-    return (HsLit an lit')-  exact (HsLam x mg) = do-    mg' <- markAnnotated mg-    return (HsLam x mg')--  exact (HsLamCase an lc_variant mg) = do-    an0 <- markEpAnnL an lidl AnnLam-    an1 <- markEpAnnL an0 lidl (case lc_variant of LamCase -> AnnCase-                                                   LamCases -> AnnCases)-    mg' <- markAnnotated mg-    return (HsLamCase an1 lc_variant mg')--  exact (HsApp an e1 e2) = do-    p <- getPosP-    debugM $ "HsApp entered. p=" ++ show p-    e1' <- markAnnotated e1-    e2' <- markAnnotated e2-    return (HsApp an e1' e2')-  exact (HsAppType ss fun at arg) = do-    fun' <- markAnnotated fun-    at' <- markToken at-    arg' <- markAnnotated arg-    return (HsAppType ss fun' at' arg')-  exact (OpApp an e1 e2 e3) = do-    e1' <- markAnnotated e1-    e2' <- markAnnotated e2-    e3' <- markAnnotated e3-    return (OpApp an e1' e2' e3')--  exact (NegApp an e s) = do-    an0 <- markEpAnnL an lidl AnnMinus-    e' <- markAnnotated e-    return (NegApp an0 e' s)--  exact (HsPar an lpar e rpar) = do-    lpar' <- markToken lpar-    e' <- markAnnotated e-    debugM $ "HsPar closing paren"-    rpar' <- markToken rpar-    debugM $ "HsPar done"-    return (HsPar an lpar' e' rpar')--  exact (SectionL an expr op) = do-    expr' <- markAnnotated expr-    op' <- markAnnotated op-    return (SectionL an expr' op')--  exact (SectionR an op expr) = do-    op' <- markAnnotated op-    expr' <- markAnnotated expr-    return (SectionR an op' expr')--  exact (ExplicitTuple an args b) = do-    an0 <- if b == Boxed then markEpAnnL an lidl AnnOpenP-                         else markEpAnnL an lidl AnnOpenPH--    args' <- mapM markAnnotated args--    an1 <- if b == Boxed then markEpAnnL an0 lidl AnnCloseP-                         else markEpAnnL an0 lidl AnnClosePH-    debugM $ "ExplicitTuple done"-    return (ExplicitTuple an1 args' b)--  exact (ExplicitSum an alt arity expr) = do-    an0 <- markLensKw an laesOpen AnnOpenPH-    an1 <- markAnnKwAllL an0 laesBarsBefore AnnVbar-    expr' <- markAnnotated expr-    an2 <- markAnnKwAllL an1 laesBarsAfter AnnVbar-    an3 <- markLensKw an2 laesClose AnnClosePH-    return (ExplicitSum an3 alt arity expr')--  exact (HsCase an e alts) = do-    an0 <- markAnnKwL an lhsCaseAnnCase AnnCase-    e' <- markAnnotated e-    an1 <- markAnnKwL an0 lhsCaseAnnOf AnnOf-    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC-    an3 <- markEpAnnAllL an2 lhsCaseAnnsRest AnnSemi-    alts' <- setLayoutBoth $ markAnnotated alts-    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC-    return (HsCase an4 e' alts')--  exact (HsIf an e1 e2 e3) = do-    an0 <- markAnnKwL an laiIf AnnIf-    e1' <- markAnnotated e1-    an1 <- markLensKwM an0 laiThenSemi AnnSemi-    an2 <- markAnnKwL an1 laiThen AnnThen-    e2' <- markAnnotated e2-    an3 <- markLensKwM an2 laiElseSemi AnnSemi-    an4 <- markAnnKwL an3 laiElse AnnElse-    e3' <- markAnnotated e3-    return (HsIf an4 e1' e2' e3')--  exact (HsMultiIf an mg) = do-    an0 <- markEpAnnL an lidl AnnIf-    an1 <- markEpAnnL an0 lidl AnnOpenC -- optional-    mg' <- markAnnotated mg-    an2 <- markEpAnnL an1 lidl AnnCloseC -- optional-    return (HsMultiIf an2 mg')--  exact (HsLet an tkLet binds tkIn e) = do-    setLayoutBoth $ do -- Make sure the 'in' gets indented too-      tkLet' <- markToken tkLet-      debugM $ "HSlet:binds coming"-      binds' <- setLayoutBoth $ markAnnotated binds-      debugM $ "HSlet:binds done"-      tkIn' <- markToken tkIn-      debugM $ "HSlet:expr coming"-      e' <- markAnnotated e-      return (HsLet an tkLet' binds' tkIn' e')--  exact (HsDo an do_or_list_comp stmts) = do-    debugM $ "HsDo"-    (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts-    return (HsDo an' do_or_list_comp stmts')--  exact (ExplicitList an es) = do-    debugM $ "ExplicitList start"-    an0 <- markLensMAA an lal_open-    es' <- markAnnotated es-    an1 <- markLensMAA an0 lal_close-    debugM $ "ExplicitList end"-    return (ExplicitList an1 es')-  exact (RecordCon an con_id binds) = do-    con_id' <- markAnnotated con_id-    an0 <- markEpAnnL an lidl AnnOpenC-    binds' <- markAnnotated binds-    an1 <- markEpAnnL an0 lidl AnnCloseC-    return (RecordCon an1 con_id' binds')-  exact (RecordUpd an expr fields) = do-    expr' <- markAnnotated expr-    an0 <- markEpAnnL an lidl AnnOpenC-    fields' <- markAnnotated fields-    an1 <- markEpAnnL an0 lidl AnnCloseC-    return (RecordUpd an1 expr' fields')-  exact (HsGetField an expr field) = do-    expr' <- markAnnotated expr-    field' <- markAnnotated field-    return (HsGetField an expr' field')-  exact (HsProjection an flds) = do-    an0 <- markAnnKwL an lapOpen AnnOpenP-    flds' <- mapM markAnnotated flds-    an1 <- markAnnKwL an0 lapClose AnnCloseP-    return (HsProjection an1 flds')-  exact (ExprWithTySig an expr sig) = do-    expr' <- markAnnotated expr-    an0 <- markEpAnnL an lidl AnnDcolon-    sig' <- markAnnotated sig-    return (ExprWithTySig an0 expr' sig')-  exact (ArithSeq an s seqInfo) = do-    an0 <- markEpAnnL an lidl AnnOpenS -- '['-    (an1, seqInfo') <--      case seqInfo of-        From e -> do-          e' <- markAnnotated e-          an' <- markEpAnnL an0 lidl AnnDotdot-          return (an', From e')-        FromTo e1 e2 -> do-          e1' <- markAnnotated e1-          an' <- markEpAnnL an0 lidl AnnDotdot-          e2' <- markAnnotated e2-          return (an', FromTo e1' e2')-        FromThen e1 e2 -> do-          e1' <- markAnnotated e1-          an' <- markEpAnnL an0 lidl AnnComma-          e2' <- markAnnotated e2-          an'' <- markEpAnnL an' lidl AnnDotdot-          return (an'', FromThen e1' e2')-        FromThenTo e1 e2 e3 -> do-          e1' <- markAnnotated e1-          an' <- markEpAnnL an0 lidl AnnComma-          e2' <- markAnnotated e2-          an'' <- markEpAnnL an' lidl AnnDotdot-          e3' <- markAnnotated e3-          return (an'', FromThenTo e1' e2' e3')-    an2 <- markEpAnnL an1 lidl AnnCloseS -- ']'-    return (ArithSeq an2 s seqInfo')---  exact (HsTypedBracket an e) = do-    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[||")-    an1 <- markEpAnnLMS an0 lidl AnnOpenE (Just "[e||")-    e' <- markAnnotated e-    an2 <- markEpAnnLMS an1 lidl AnnClose (Just "||]")-    return (HsTypedBracket an2 e')--  exact (HsUntypedBracket an (ExpBr a e)) = do-    an0 <- markEpAnnL an  lidl AnnOpenEQ -- "[|"-    an1 <- markEpAnnL an0 lidl AnnOpenE  -- "[e|" -- optional-    e' <- markAnnotated e-    an2 <- markEpAnnL an1 lidl AnnCloseQ -- "|]"-    return (HsUntypedBracket an2 (ExpBr a e'))--  exact (HsUntypedBracket an (PatBr a e)) = do-    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[p|")-    e' <- markAnnotated e-    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"-    return (HsUntypedBracket an1 (PatBr a e'))--  exact (HsUntypedBracket an (DecBrL a e)) = do-    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[d|")-    an1 <- markEpAnnL an0 lidl AnnOpenC-    e' <- markAnnotated e-    an2 <- markEpAnnL an1 lidl AnnCloseC-    an3 <- markEpAnnL an2 lidl AnnCloseQ -- "|]"-    return (HsUntypedBracket an3 (DecBrL a e'))--  exact (HsUntypedBracket an (TypBr a e)) = do-    an0 <- markEpAnnLMS an lidl AnnOpen (Just "[t|")-    e' <- markAnnotated e-    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"-    return (HsUntypedBracket an1 (TypBr a e'))--  exact (HsUntypedBracket an (VarBr a b e)) = do-    (an0, e') <- if b-      then do-        an' <- markEpAnnL an lidl AnnSimpleQuote-        e' <- markAnnotated e-        return (an', e')-      else do-        an' <- markEpAnnL an lidl AnnThTyQuote-        e' <- markAnnotated e-        return (an', e')-    return (HsUntypedBracket an0 (VarBr a b e'))--  exact (HsTypedSplice (x,an) s)   = do-    an0 <- markEpAnnL an lidl AnnDollarDollar-    s' <- exact s-    return (HsTypedSplice (x,an0) s')-  exact (HsUntypedSplice an s) = do-    s' <- exact s-    return (HsUntypedSplice an s')--  exact (HsProc an p c) = do-    debugM $ "HsProc start"-    an0 <- markEpAnnL an lidl AnnProc-    p' <- markAnnotated p-    an1 <- markEpAnnL an0 lidl AnnRarrow-    debugM $ "HsProc after AnnRarrow"-    c' <- markAnnotated c-    return (HsProc an1 p' c')--  exact (HsStatic an e) = do-    an0 <- markEpAnnL an lidl AnnStatic-    e' <- markAnnotated e-    return (HsStatic an0 e')--  exact (HsPragE a prag e) = do-    prag' <- markAnnotated prag-    e' <- markAnnotated e-    return (HsPragE a prag' e')-  exact x = error $ "exact HsExpr for:" ++ showAst x---- -----------------------------------------------------------------------exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))-        => EpAnn AnnList -> HsDoFlavour -> LocatedAn an a-        -> EP w m (EpAnn AnnList, LocatedAn an a)-exactDo an (DoExpr m)    stmts = exactMdo an m AnnDo          >>= \an0 -> markMaybeDodgyStmts an0 stmts-exactDo an GhciStmtCtxt  stmts = markEpAnnL an lal_rest AnnDo >>= \an0 -> markMaybeDodgyStmts an0 stmts-exactDo an (MDoExpr m)   stmts = exactMdo an m AnnMdo         >>= \an0 -> markMaybeDodgyStmts an0 stmts-exactDo an ListComp      stmts = markMaybeDodgyStmts an stmts-exactDo an MonadComp     stmts = markMaybeDodgyStmts an stmts--exactMdo :: (Monad m, Monoid w)-  => EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m (EpAnn AnnList)-exactMdo an Nothing            kw = markEpAnnL   an lal_rest kw-exactMdo an (Just module_name) kw = markEpAnnLMS an lal_rest kw (Just n)-    where-      n = (moduleNameString module_name) ++ "." ++ (keywordToString kw)--markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))-  => EpAnn AnnList -> LocatedAn an a -> EP w m (EpAnn AnnList, LocatedAn an a)-markMaybeDodgyStmts an stmts =-  if isGoodSrcSpan (getLocA stmts)-    then do-      r <- markAnnotatedWithLayout stmts-      return (an, r)-    else return (an, stmts)---- ----------------------------------------------------------------------instance ExactPrint (HsPragE GhcPs) where-  getAnnotationEntry HsPragSCC{}  = NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (HsPragSCC (an,st) sl) = do-    an0 <- markAnnOpenP an st "{-# SCC"-    let txt = sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl)-    an1 <- markEpAnnLMS an0 lapr_rest AnnVal    (Just txt) -- optional-    an2 <- markEpAnnLMS an1 lapr_rest AnnValStr (Just txt) -- optional-    an3 <- markAnnCloseP an2-    return (HsPragSCC (an3,st) sl)----- -----------------------------------------------------------------------instance ExactPrint (HsUntypedSplice GhcPs) where-  getAnnotationEntry (HsUntypedSpliceExpr an _) = fromAnn an-  getAnnotationEntry (HsQuasiQuote _ _ _)       = NoEntryVal--  setAnnotationAnchor (HsUntypedSpliceExpr an e) anc cs = HsUntypedSpliceExpr (setAnchorEpa an anc cs) e-  setAnnotationAnchor a@HsQuasiQuote {}         _ _ = a--  exact (HsUntypedSpliceExpr an e) = do-    an0 <- markEpAnnL an lidl AnnDollar-    e' <- markAnnotated e-    return (HsUntypedSpliceExpr an0 e')--  exact (HsQuasiQuote an q (L l fs)) = do-    -- The quasiquote string does not honour layout offsets. Store-    -- the colOffset for now.-    -- TODO: use local?-    oldOffset <- getLayoutOffsetP-    EPState{pMarkLayout} <- get-    unless pMarkLayout $ setLayoutOffsetP 0-    printStringAdvance-            -- Note: Lexer.x does not provide unicode alternative. 2017-02-26-            ("[" ++ (showPprUnsafe q) ++ "|" ++ (unpackFS fs) ++ "|]")-    unless pMarkLayout $ setLayoutOffsetP oldOffset-    return (HsQuasiQuote an q (L l fs))---- ------------------------------------------------------------------------- TODO:AZ: combine these instances-instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (MG x matches) = do-    -- TODO:AZ use SortKey, in MG ann.-    matches' <- if isGoodSrcSpan (getLocA matches)-      then markAnnotated matches-      else return matches-    return (MG x matches')--instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (MG x matches) = do-    -- TODO:AZ use SortKey, in MG ann.-    matches' <- if isGoodSrcSpan (getLocA matches)-      then markAnnotated matches-      else return matches-    return (MG x matches')---- -----------------------------------------------------------------------instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (HsRecFields fields mdot) = do-    fields' <- markAnnotated fields-    case mdot of-      Nothing -> return ()-      Just (L ss _) ->-        printStringAtSs ss ".." >> return ()-      -- Note: mdot contains the SrcSpan where the ".." appears, if present-    return (HsRecFields fields' mdot)---- -----------------------------------------------------------------------instance (ExactPrint body)-    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldOcc GhcPs)) body) where-  getAnnotationEntry x = fromAnn (hfbAnn x)-  setAnnotationAnchor (HsFieldBind an f arg isPun) anc cs = (HsFieldBind (setAnchorEpa an anc cs) f arg isPun)-  exact (HsFieldBind an f arg isPun) = do-    debugM $ "HsFieldBind"-    f' <- markAnnotated f-    (an0, arg') <- if isPun then return (an, arg)-             else do-      an0 <- markEpAnnL an lidl AnnEqual-      arg' <- markAnnotated arg-      return (an0, arg')-    return (HsFieldBind an0 f' arg' isPun)---- -----------------------------------------------------------------------instance (ExactPrint body)-    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body) where-  getAnnotationEntry x = fromAnn (hfbAnn x)-  setAnnotationAnchor (HsFieldBind an f arg isPun) anc cs = (HsFieldBind (setAnchorEpa an anc cs) f arg isPun)--  exact (HsFieldBind an f arg isPun) = do-    debugM $ "HsFieldBind FieldLabelStrings"-    f' <- markAnnotated f-    (an0, arg') <- if isPun then return (an, arg)-             else do-      an0 <- markEpAnnL an lidl AnnEqual-      arg' <- markAnnotated arg-      return (an0, arg')-    return (HsFieldBind an0 f' arg' isPun)---- -----------------------------------------------------------------------instance (ExactPrint (LocatedA body))-    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs)) (LocatedA body)) where-  getAnnotationEntry x = fromAnn (hfbAnn x)-  setAnnotationAnchor (HsFieldBind an f arg isPun) anc cs = (HsFieldBind (setAnchorEpa an anc cs) f arg isPun)-  exact (HsFieldBind an f arg isPun) = do-    debugM $ "HsRecUpdField"-    f' <- markAnnotated f-    an0 <- if isPun then return an-             else markEpAnnL an lidl AnnEqual-    arg' <- if ((locA $ getLoc arg) == noSrcSpan )-              then return arg-              else markAnnotated arg-    return (HsFieldBind an0 f' arg' isPun)---- ----------------------------------------------------------------------instance ExactPrint (LHsRecUpdFields GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact flds@(RegularRecUpdFields    { recUpdFields  = rbinds }) = do-    debugM $ "RegularRecUpdFields"-    rbinds' <- markAnnotated rbinds-    return $ flds { recUpdFields = rbinds' }-  exact flds@(OverloadedRecUpdFields { olRecUpdFields = pbinds }) = do-    debugM $ "OverloadedRecUpdFields"-    pbinds' <- markAnnotated pbinds-    return $ flds { olRecUpdFields = pbinds' }---- -----------------------------------------------------------------------instance ExactPrint (FieldLabelStrings GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (FieldLabelStrings fs) = FieldLabelStrings <$> markAnnotated fs---- -----------------------------------------------------------------------instance ExactPrint (DotFieldOcc GhcPs) where-  getAnnotationEntry (DotFieldOcc an _) = fromAnn an--  setAnnotationAnchor (DotFieldOcc an a) anc cs = DotFieldOcc (setAnchorEpa an anc cs) a--  exact (DotFieldOcc an (L loc (FieldLabelString fs))) = do-    an0 <- markLensKwM an lafDot  AnnDot-    -- The field name has a SrcSpanAnnN, print it as a-    -- LocatedN RdrName-    L loc' _ <- markAnnotated (L loc (mkVarUnqual fs))-    return (DotFieldOcc an0 (L loc' (FieldLabelString fs)))---- -----------------------------------------------------------------------instance ExactPrint (HsTupArg GhcPs) where-  getAnnotationEntry (Present an _) = fromAnn an-  getAnnotationEntry (Missing an)   = fromAnn an--  setAnnotationAnchor (Present an a) anc cs = Present (setAnchorEpa an anc cs) a-  setAnnotationAnchor (Missing an)   anc cs = Missing (setAnchorEpa an anc cs)--  exact (Present a e) = Present a <$> markAnnotated e--  exact a@(Missing EpAnnNotUsed) = return a-  exact a@(Missing _) = printStringAdvance "," >> return a---- -----------------------------------------------------------------------instance ExactPrint (HsCmdTop GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (HsCmdTop a cmd) = HsCmdTop a <$> markAnnotated cmd---- -----------------------------------------------------------------------instance ExactPrint (HsCmd GhcPs) where-  getAnnotationEntry (HsCmdArrApp an _ _ _ _)   = fromAnn an-  getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an-  getAnnotationEntry (HsCmdApp an _ _ )         = fromAnn an-  getAnnotationEntry (HsCmdLam {})              = NoEntryVal-  getAnnotationEntry (HsCmdPar an _ _ _)        = fromAnn an-  getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an-  getAnnotationEntry (HsCmdLamCase an _ _)      = fromAnn an-  getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an-  getAnnotationEntry (HsCmdLet an _ _ _ _)      = fromAnn an-  getAnnotationEntry (HsCmdDo an _)             = fromAnn an--  setAnnotationAnchor (HsCmdArrApp an a b c d)   anc cs = (HsCmdArrApp (setAnchorEpa an anc cs) a b c d)-  setAnnotationAnchor (HsCmdArrForm an a b c d ) anc cs = (HsCmdArrForm (setAnchorEpa an anc cs) a b c d )-  setAnnotationAnchor (HsCmdApp an a b )         anc cs = (HsCmdApp (setAnchorEpa an anc cs) a b )-  setAnnotationAnchor a@(HsCmdLam {})              _ _s = a-  setAnnotationAnchor (HsCmdPar an a b c)        anc cs = (HsCmdPar (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (HsCmdCase an a b)         anc cs = (HsCmdCase (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsCmdLamCase an a b)      anc cs = (HsCmdLamCase (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsCmdIf an a b c d)       anc cs = (HsCmdIf (setAnchorEpa an anc cs) a b c d)-  setAnnotationAnchor (HsCmdLet an a b c d)      anc cs = (HsCmdLet (setAnchorEpa an anc cs) a b c d)-  setAnnotationAnchor (HsCmdDo an a)             anc cs = (HsCmdDo (setAnchorEpa an anc cs) a)--  exact (HsCmdArrApp an arr arg o isRightToLeft) = do-    if isRightToLeft-      then do-        arr' <- markAnnotated arr-        an0 <- markKw (anns an)-        arg' <- markAnnotated arg-        let an1 = an{anns = an0}-        return (HsCmdArrApp an1 arr' arg' o isRightToLeft)-      else do-        arg' <- markAnnotated arg-        an0 <- markKw (anns an)-        arr' <- markAnnotated arr-        let an1 = an {anns = an0}-        return (HsCmdArrApp an1 arr' arg' o isRightToLeft)--  exact (HsCmdArrForm an e fixity mf cs) = do-    an0 <- markLensMAA an lal_open-    (e',cs') <- case (fixity, cs) of-      (Infix, (arg1:argrest)) -> do-        arg1' <- markAnnotated arg1-        e' <- markAnnotated e-        argrest' <- markAnnotated argrest-        return (e', arg1':argrest')-      (Prefix, _) -> do-        e' <- markAnnotated e-        cs' <- markAnnotated cs-        return (e', cs')-      (Infix, []) -> error "Not possible"-    an1 <- markLensMAA an0 lal_close-    return (HsCmdArrForm an1 e' fixity mf cs')--  exact (HsCmdApp an e1 e2) = do-    e1' <- markAnnotated e1-    e2' <- markAnnotated e2-    return (HsCmdApp an e1' e2')--  exact (HsCmdLam a match) = do-    match' <- markAnnotated match-    return (HsCmdLam a match')--  exact (HsCmdPar an lpar e rpar) = do-    lpar' <- markToken lpar-    e' <- markAnnotated e-    rpar' <- markToken rpar-    return (HsCmdPar an lpar' e' rpar')--  exact (HsCmdCase an e alts) = do-    an0 <- markLensKw an lhsCaseAnnCase AnnCase-    e' <- markAnnotated e-    an1 <- markLensKw an0 lhsCaseAnnOf AnnOf-    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC-    an3 <- markEpAnnAllL an2 lhsCaseAnnsRest AnnSemi-    alts' <- markAnnotated alts-    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC-    return (HsCmdCase an4 e' alts')--  exact (HsCmdLamCase an lc_variant matches) = do-    an0 <- markEpAnnL an lidl AnnLam-    an1 <- markEpAnnL an0 lidl (case lc_variant of LamCase -> AnnCase-                                                   LamCases -> AnnCases)-    matches' <- markAnnotated matches-    return (HsCmdLamCase an1 lc_variant matches')--  exact (HsCmdIf an a e1 e2 e3) = do-    an0 <- markLensKw an laiIf AnnIf-    e1' <- markAnnotated e1-    an1 <- markLensKwM an0 laiThenSemi AnnSemi-    an2 <- markLensKw an1 laiThen AnnThen-    e2' <- markAnnotated e2-    an3 <- markLensKwM an2 laiElseSemi AnnSemi-    an4 <- markLensKw an3 laiElse AnnElse-    e3' <- markAnnotated e3-    return (HsCmdIf an4 a e1' e2' e3')--  exact (HsCmdLet an tkLet binds tkIn e) = do-    setLayoutBoth $ do -- Make sure the 'in' gets indented too-      tkLet' <- markToken tkLet-      binds' <- setLayoutBoth $ markAnnotated binds-      tkIn' <- markToken tkIn-      e' <- markAnnotated e-      return (HsCmdLet an tkLet' binds' tkIn' e')--  exact (HsCmdDo an es) = do-    debugM $ "HsCmdDo"-    an0 <- markEpAnnL an lal_rest AnnDo-    es' <- markAnnotated es-    return (HsCmdDo an0 es')---- -----------------------------------------------------------------------instance (-  ExactPrint (LocatedA (body GhcPs)),-                 Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,-           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnL,-           (ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))-   => ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where-  getAnnotationEntry (LastStmt _ _ _ _)             = NoEntryVal-  getAnnotationEntry (BindStmt an _ _)              = fromAnn an-  getAnnotationEntry (ApplicativeStmt _ _ _)        = NoEntryVal-  getAnnotationEntry (BodyStmt _ _ _ _)             = NoEntryVal-  getAnnotationEntry (LetStmt an _)                 = fromAnn an-  getAnnotationEntry (ParStmt _ _ _ _)              = NoEntryVal-  getAnnotationEntry (TransStmt an _ _ _ _ _ _ _ _) = fromAnn an-  getAnnotationEntry (RecStmt an _ _ _ _ _ _)       = fromAnn an--  -------------------------------------------------------------------  setAnnotationAnchor a@(LastStmt _ _ _ _)             _ _s = a-  setAnnotationAnchor (BindStmt an a b)              anc cs = (BindStmt (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor a@(ApplicativeStmt _ _ _)        _ _s = a-  setAnnotationAnchor a@(BodyStmt _ _ _ _)             _ _s = a-  setAnnotationAnchor (LetStmt an a)                 anc cs = (LetStmt (setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(ParStmt _ _ _ _)              _ _s = a-  setAnnotationAnchor (TransStmt an a b c d e f g h) anc cs = (TransStmt (setAnchorEpa an anc cs) a b c d e f g h)-  setAnnotationAnchor (RecStmt an a b c d e f)       anc cs = (RecStmt (setAnchorEpa an anc cs) a b c d e f)--  -------------------------------------------------------------------  exact (LastStmt a body b c) = do-    debugM $ "LastStmt"-    body' <- markAnnotated body-    return (LastStmt a body' b c)--  exact (BindStmt an pat body) = do-    debugM $ "BindStmt"-    pat' <- markAnnotated pat-    an0 <- markEpAnnL an lidl AnnLarrow-    body' <- markAnnotated body-    return (BindStmt an0 pat' body')--  exact (ApplicativeStmt _ _body _) = do-    error $ "ApplicativeStmt is introduced in the renamer"--  exact (BodyStmt a body b c) = do-    debugM $ "BodyStmt"-    body' <- markAnnotated body-    return (BodyStmt a body' b c)--  exact (LetStmt an binds) = do-    debugM $ "LetStmt"-    an0 <- markEpAnnL an lidl AnnLet-    binds' <- markAnnotated binds-    return (LetStmt an0 binds')--  exact (ParStmt a pbs b c) = do-    debugM $ "ParStmt"-    pbs' <- markAnnotated pbs-    return (ParStmt a pbs' b c)--  exact (TransStmt an form stmts b using by c d e) = do-    debugM $ "TransStmt"-    stmts' <- markAnnotated stmts-    (an', by', using') <- exactTransStmt an by using form-    return (TransStmt an' form stmts' b using' by' c d e)--  exact (RecStmt an stmts a b c d e) = do-    debugM $ "RecStmt"-    an0 <- markEpAnnL an lal_rest AnnRec-    (an1, stmts') <- markAnnList True an0 (markAnnotated stmts)-    return (RecStmt an1 stmts' a b c d e)---- -----------------------------------------------------------------------instance ExactPrint (ParStmtBlock GhcPs GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (ParStmtBlock a stmts b c) = do-    stmts' <- markAnnotated stmts-    return (ParStmtBlock a stmts' b c)--exactTransStmt :: (Monad m, Monoid w)-  => EpAnn [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm-  -> EP w m (EpAnn [AddEpAnn], Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))-exactTransStmt an by using ThenForm = do-  debugM $ "exactTransStmt:ThenForm"-  an0 <- markEpAnnL an lidl AnnThen-  using' <- markAnnotated using-  case by of-    Nothing -> return (an0, by, using')-    Just b -> do-      an1 <- markEpAnnL an0 lidl AnnBy-      b' <- markAnnotated b-      return (an1, Just b', using')-exactTransStmt an by using GroupForm = do-  debugM $ "exactTransStmt:GroupForm"-  an0 <- markEpAnnL an lidl AnnThen-  an1 <- markEpAnnL an0 lidl AnnGroup-  (an2, by') <- case by of-    Nothing -> return (an1, by)-    Just b -> do-      an2 <- markEpAnnL an1 lidl AnnBy-      b' <- markAnnotated b-      return (an2, Just b')-  an3 <- markEpAnnL an2 lidl AnnUsing-  using' <- markAnnotated using-  return (an3, by', using')---- -----------------------------------------------------------------------instance ExactPrint (TyClDecl GhcPs) where-  getAnnotationEntry (FamDecl   { })                   = NoEntryVal-  getAnnotationEntry (SynDecl   { tcdSExt = an })      = fromAnn an-  getAnnotationEntry (DataDecl  { tcdDExt = an })      = fromAnn an-  getAnnotationEntry (ClassDecl { tcdCExt = (an, _) }) = fromAnn an--  setAnnotationAnchor a@FamDecl{}     _ _s = a-  setAnnotationAnchor x@SynDecl{}   anc cs = x { tcdSExt = setAnchorEpa (tcdSExt x) anc cs }-  setAnnotationAnchor x@DataDecl{}  anc cs = x { tcdDExt = setAnchorEpa (tcdDExt x) anc cs }-  setAnnotationAnchor x@ClassDecl{} anc cs = x { tcdCExt = (setAnchorEpa an anc cs, a) }-    where-      (an,a) = tcdCExt x--  exact (FamDecl a decl) = do-    decl' <- markAnnotated decl-    return (FamDecl a decl')--  exact (SynDecl { tcdSExt = an-                 , tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity-                 , tcdRhs = rhs }) = do-    -- There may be arbitrary parens around parts of the constructor-    -- that are infix.  Turn these into comments so that they feed-    -- into the right place automatically-    an0 <- annotationsToComments an lidl [AnnOpenP,AnnCloseP]-    an1 <- markEpAnnL an0 lidl AnnType--    (_anx, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing-    an2 <- markEpAnnL an1 lidl AnnEqual-    rhs' <- markAnnotated rhs-    return (SynDecl { tcdSExt = an2-                    , tcdLName = ltycon', tcdTyVars = tyvars', tcdFixity = fixity-                    , tcdRhs = rhs' })--  -- TODO: add a workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/20452-  exact (DataDecl { tcdDExt = an, tcdLName = ltycon, tcdTyVars = tyvars-                  , tcdFixity = fixity, tcdDataDefn = defn }) = do-    (_, an', ltycon', tyvars', _, _mctxt', defn') <--      exactDataDefn an (exactVanillaDeclHead ltycon tyvars fixity) defn-    return (DataDecl { tcdDExt = an', tcdLName = ltycon', tcdTyVars = tyvars'-                     , tcdFixity = fixity, tcdDataDefn = defn' })--  -- -------------------------------------  exact (ClassDecl {tcdCExt = (an, sortKey),-                    tcdLayout = lo,-                    tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,-                    tcdFixity = fixity,-                    tcdFDs  = fds,-                    tcdSigs = sigs, tcdMeths = methods,-                    tcdATs = ats, tcdATDefs = at_defs,-                    tcdDocs = _docs})-      -- TODO: add a test that demonstrates tcdDocs-      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part-      = do-          (an0, fds', lclas', tyvars',context') <- top_matter-          an1 <- markEpAnnL an0 lidl AnnOpenC-          an2 <- markEpAnnL an1 lidl AnnCloseC-          return (ClassDecl {tcdCExt = (an2, sortKey),-                             tcdLayout = lo,-                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',-                             tcdFixity = fixity,-                             tcdFDs  = fds',-                             tcdSigs = sigs, tcdMeths = methods,-                             tcdATs = ats, tcdATDefs = at_defs,-                             tcdDocs = _docs})--      | otherwise       -- Laid out-      = do-          (an0, fds', lclas', tyvars',context') <- top_matter-          an1 <- markEpAnnL    an0 lidl AnnOpenC-          an2 <- markEpAnnAllL an1 lidl AnnSemi-          ds <- withSortKey sortKey-                               (prepareListAnnotationA sigs-                             ++ prepareListAnnotationA (bagToList methods)-                             ++ prepareListAnnotationA ats-                             ++ prepareListAnnotationA at_defs-                             -- ++ prepareListAnnotation docs-                               )-          an3 <- markEpAnnL an2 lidl AnnCloseC-          let-            sigs'    = undynamic ds-            methods' = listToBag $ undynamic ds-            ats'     = undynamic ds-            at_defs' = undynamic ds-          return (ClassDecl {tcdCExt = (an3, sortKey),-                             tcdLayout = lo,-                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',-                             tcdFixity = fixity,-                             tcdFDs  = fds',-                             tcdSigs = sigs', tcdMeths = methods',-                             tcdATs = ats', tcdATDefs = at_defs',-                             tcdDocs = _docs})-      where-        top_matter = do-          an' <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]-          an0 <- markEpAnnL an' lidl AnnClass-          (_, lclas', tyvars',_,context') <-  exactVanillaDeclHead lclas tyvars fixity context-          (an1, fds') <- if (null fds)-            then return (an0, fds)-            else do-              an1 <- markEpAnnL an0 lidl AnnVbar-              fds' <- markAnnotated fds-              return (an1, fds')-          an2 <- markEpAnnL an1 lidl AnnWhere-          return (an2, fds', lclas', tyvars',context')----- -----------------------------------------------------------------------instance ExactPrint (FunDep GhcPs) where-  getAnnotationEntry (FunDep an _ _) = fromAnn an-  setAnnotationAnchor (FunDep an a b) anc cs = FunDep (setAnchorEpa an anc cs) a b--  exact (FunDep an ls rs') = do-    ls' <- markAnnotated ls-    an0 <- markEpAnnL an lidl AnnRarrow-    rs'' <- markAnnotated rs'-    return (FunDep an0 ls' rs'')---- -----------------------------------------------------------------------instance ExactPrint (FamilyDecl GhcPs) where-  getAnnotationEntry (FamilyDecl { fdExt = an }) = fromAnn an-  setAnnotationAnchor x anc cs = x { fdExt = setAnchorEpa (fdExt x) anc cs}--  exact (FamilyDecl { fdExt = an-                    , fdInfo = info-                    , fdTopLevel = top_level-                    , fdLName = ltycon-                    , fdTyVars = tyvars-                    , fdFixity = fixity-                    , fdResultSig = L lr result-                    , fdInjectivityAnn = mb_inj }) = do-    an0 <- exactFlavour an info-    an1 <- exact_top_level an0-    an2 <- annotationsToComments an1 lidl [AnnOpenP,AnnCloseP]-    (_, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing-    (an3, result') <- exact_kind an2-    (an4, mb_inj') <--      case mb_inj of-        Nothing -> return (an3, mb_inj)-        Just inj -> do-          an4 <- markEpAnnL an3 lidl AnnVbar-          inj' <- markAnnotated inj-          return (an4, Just inj')-    (an5, info') <--             case info of-               ClosedTypeFamily mb_eqns -> do-                 an5 <- markEpAnnL an4 lidl AnnWhere-                 an6 <- markEpAnnL an5 lidl AnnOpenC-                 (an7, mb_eqns') <--                   case mb_eqns of-                     Nothing -> do-                       an7 <- markEpAnnL an6 lidl AnnDotdot-                       return (an7, mb_eqns)-                     Just eqns -> do-                       eqns' <- markAnnotated eqns-                       return (an6, Just eqns')-                 an8 <- markEpAnnL an7 lidl AnnCloseC-                 return (an8, ClosedTypeFamily mb_eqns')-               _ -> return (an4, info)-    return (FamilyDecl { fdExt = an5-                       , fdInfo = info'-                       , fdTopLevel = top_level-                       , fdLName = ltycon'-                       , fdTyVars = tyvars'-                       , fdFixity = fixity-                       , fdResultSig = L lr result'-                       , fdInjectivityAnn = mb_inj' })-    where-      exact_top_level an' =-        case top_level of-          TopLevel    -> markEpAnnL an' lidl AnnFamily-          NotTopLevel -> do-            -- It seems that in some kind of legacy-            -- mode the 'family' keyword is still-            -- accepted.-            markEpAnnL an' lidl AnnFamily--      exact_kind an' =-        case result of-          NoSig    _         -> return (an', result)-          KindSig  x kind    -> do-            an0 <- markEpAnnL an' lidl AnnDcolon-            kind' <- markAnnotated kind-            return (an0, KindSig  x kind')-          TyVarSig x tv_bndr -> do-            an0 <- markEpAnnL an' lidl AnnEqual-            tv_bndr' <- markAnnotated tv_bndr-            return (an0, TyVarSig x tv_bndr')---exactFlavour :: (Monad m, Monoid w) => EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EP w m (EpAnn [AddEpAnn])-exactFlavour an DataFamily            = markEpAnnL an lidl AnnData-exactFlavour an OpenTypeFamily        = markEpAnnL an lidl AnnType-exactFlavour an (ClosedTypeFamily {}) = markEpAnnL an lidl AnnType---- -----------------------------------------------------------------------exactDataDefn-  :: (Monad m, Monoid w)-  => EpAnn [AddEpAnn]-  -> (Maybe (LHsContext GhcPs) -> EP w m (EpAnn [AddEpAnn]-                                         , LocatedN RdrName-                                         , a-                                         , b-                                         , Maybe (LHsContext GhcPs))) -- Printing the header-  -> HsDataDefn GhcPs-  -> EP w m ( EpAnn [AddEpAnn] -- ^ from exactHdr-            , EpAnn [AddEpAnn] -- ^ updated one passed in-            , LocatedN RdrName, a, b, Maybe (LHsContext GhcPs), HsDataDefn GhcPs)-exactDataDefn an exactHdr-                 (HsDataDefn { dd_ext = x, dd_ctxt = context-                             , dd_cType = mb_ct-                             , dd_kindSig = mb_sig-                             , dd_cons = condecls, dd_derivs = derivings }) = do--  an' <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]--  an0 <- case condecls of-    DataTypeCons is_type_data _ -> do-      an0' <- if is_type_data-                then markEpAnnL an' lidl AnnType-                else return an'-      markEpAnnL an0' lidl AnnData-    NewTypeCon   _ -> markEpAnnL an' lidl AnnNewtype--  an1 <- markEpAnnL an0 lidl AnnInstance -- optional-  mb_ct' <- mapM markAnnotated mb_ct-  (anx, ln', tvs', b, mctxt') <- exactHdr context-  (an2, mb_sig') <- case mb_sig of-    Nothing -> return (an1, Nothing)-    Just kind -> do-      an2 <- markEpAnnL an1 lidl AnnDcolon-      kind' <- markAnnotated kind-      return (an2, Just kind')-  an3 <- if (needsWhere condecls)-    then markEpAnnL an2 lidl AnnWhere-    else return an2-  an4 <- markEpAnnL an3 lidl AnnOpenC-  (an5, condecls') <- exact_condecls an4 (toList condecls)-  let condecls'' = case condecls of-        DataTypeCons d _ -> DataTypeCons d condecls'-        NewTypeCon _     -> case condecls' of-          [decl] -> NewTypeCon decl-          _ -> panic "exacprint NewTypeCon"-  an6 <- markEpAnnL an5 lidl AnnCloseC-  derivings' <- mapM markAnnotated derivings-  return (anx, an6, ln', tvs', b, mctxt',-                 (HsDataDefn { dd_ext = x, dd_ctxt = context-                             , dd_cType = mb_ct'-                             , dd_kindSig = mb_sig'-                             , dd_cons = condecls'', dd_derivs = derivings' }))---exactVanillaDeclHead :: (Monad m, Monoid w)-                     => LocatedN RdrName-                     -> LHsQTyVars GhcPs-                     -> LexicalFixity-                     -> Maybe (LHsContext GhcPs)-                     -> EP w m ( EpAnn [AddEpAnn]-                               , LocatedN RdrName-                               , LHsQTyVars GhcPs-                               , (), Maybe (LHsContext GhcPs))-exactVanillaDeclHead thing tvs@(HsQTvs { hsq_explicit = tyvars }) fixity context = do-  let-    exact_tyvars (varl:varsr)-      | hvarsr : tvarsr@(_ : _) <- varsr-      , fixity == Infix = do-          varl' <- markAnnotated varl-          thing' <- markAnnotated thing-          hvarsr' <- markAnnotated hvarsr-          tvarsr' <- markAnnotated tvarsr-          return (thing', varl':hvarsr':tvarsr')-      | fixity == Infix = do-          varl' <- markAnnotated varl-          thing' <- markAnnotated thing-          varsr' <- markAnnotated varsr-          return (thing', varl':varsr')-      | otherwise = do-          thing' <- markAnnotated thing-          vs <- mapM markAnnotated (varl:varsr)-          return (thing', vs)-    exact_tyvars [] = do-      thing' <- markAnnotated thing-      return (thing', [])-  context' <- mapM markAnnotated context-  (thing', tyvars') <- exact_tyvars tyvars-  return (EpAnnNotUsed, thing', tvs { hsq_explicit = tyvars' }, (), context')---- -----------------------------------------------------------------------instance ExactPrint (InjectivityAnn GhcPs) where-  getAnnotationEntry (InjectivityAnn an _ _) = fromAnn an-  setAnnotationAnchor (InjectivityAnn an a b) anc cs = InjectivityAnn (setAnchorEpa an anc cs) a b-  exact (InjectivityAnn an lhs rhs) = do-    an0 <- markEpAnnL an lidl AnnVbar-    lhs' <- markAnnotated lhs-    an1 <- markEpAnnL an0 lidl AnnRarrow-    rhs' <- mapM markAnnotated rhs-    return (InjectivityAnn an1 lhs' rhs')---- -----------------------------------------------------------------------class Typeable flag => ExactPrintTVFlag flag where-  exactTVDelimiters :: (Monad m, Monoid w)-    => EpAnn [AddEpAnn] -> flag -> EP w m (HsTyVarBndr flag GhcPs)-    -> EP w m (EpAnn [AddEpAnn], (HsTyVarBndr flag GhcPs))--instance ExactPrintTVFlag () where-  exactTVDelimiters an _ thing_inside = do-    an0 <- markEpAnnAllL an lid AnnOpenP-    r <- thing_inside-    an1 <- markEpAnnAllL an0 lid AnnCloseP-    return (an1, r)--instance ExactPrintTVFlag Specificity where-  exactTVDelimiters an s thing_inside = do-    an0 <- markEpAnnAllL an lid open-    r <- thing_inside-    an1 <- markEpAnnAllL an0 lid close-    return (an1, r)-    where-      (open, close) = case s of-        SpecifiedSpec -> (AnnOpenP, AnnCloseP)-        InferredSpec  -> (AnnOpenC, AnnCloseC)--instance ExactPrintTVFlag (HsBndrVis GhcPs) where-  exactTVDelimiters an0 bvis thing_inside = do-    case bvis of-      HsBndrRequired -> return ()-      HsBndrInvisible at -> markToken at >> return ()-    an1 <- markEpAnnAllL an0 lid AnnOpenP-    r <- thing_inside-    an2 <- markEpAnnAllL an1 lid AnnCloseP-    return (an2, r)--instance ExactPrintTVFlag flag => ExactPrint (HsTyVarBndr flag GhcPs) where-  getAnnotationEntry (UserTyVar an _ _)     = fromAnn an-  getAnnotationEntry (KindedTyVar an _ _ _) = fromAnn an--  setAnnotationAnchor (UserTyVar an a b)     anc cs = UserTyVar (setAnchorEpa an anc cs) a b-  setAnnotationAnchor (KindedTyVar an a b c) anc cs = KindedTyVar (setAnchorEpa an anc cs) a b c--  exact (UserTyVar an flag n) = do-    r <- exactTVDelimiters an flag $ do-           n' <- markAnnotated n-           return (UserTyVar an flag n')-    case r of-      (an', UserTyVar _ flag'' n'') -> return (UserTyVar an' flag'' n'')-      _ -> error "KindedTyVar should never happen here"-  exact (KindedTyVar an flag n k) = do-    r <- exactTVDelimiters an flag $ do-          n' <- markAnnotated n-          an0 <- markEpAnnL an lidl AnnDcolon-          k' <- markAnnotated k-          return (KindedTyVar an0 flag n' k')-    case r of-      (an',KindedTyVar _ flag'' n'' k'') -> return (KindedTyVar an' flag'' n'' k'')-      _ -> error "UserTyVar should never happen here"---- -----------------------------------------------------------------------instance ExactPrint (HsType GhcPs) where-  getAnnotationEntry (HsForAllTy _ _ _)        = NoEntryVal-  getAnnotationEntry (HsQualTy _ _ _)          = NoEntryVal-  getAnnotationEntry (HsTyVar an _ _)          = fromAnn an-  getAnnotationEntry (HsAppTy _ _ _)           = NoEntryVal-  getAnnotationEntry (HsAppKindTy _ _ _ _)     = NoEntryVal-  getAnnotationEntry (HsFunTy an _ _ _)        = fromAnn an-  getAnnotationEntry (HsListTy an _)           = fromAnn an-  getAnnotationEntry (HsTupleTy an _ _)        = fromAnn an-  getAnnotationEntry (HsSumTy an _)            = fromAnn an-  getAnnotationEntry (HsOpTy an _ _ _ _)       = fromAnn an-  getAnnotationEntry (HsParTy an _)            = fromAnn an-  getAnnotationEntry (HsIParamTy an _ _)       = fromAnn an-  getAnnotationEntry (HsStarTy _ _)            = NoEntryVal-  getAnnotationEntry (HsKindSig an _ _)        = fromAnn an-  getAnnotationEntry (HsSpliceTy _ _)          = NoEntryVal-  getAnnotationEntry (HsDocTy an _ _)          = fromAnn an-  getAnnotationEntry (HsBangTy an _ _)         = fromAnn an-  getAnnotationEntry (HsRecTy an _)            = fromAnn an-  getAnnotationEntry (HsExplicitListTy an _ _) = fromAnn an-  getAnnotationEntry (HsExplicitTupleTy an _)  = fromAnn an-  getAnnotationEntry (HsTyLit _ _)             = NoEntryVal-  getAnnotationEntry (HsWildCardTy _)          = NoEntryVal-  getAnnotationEntry (XHsType _)               = NoEntryVal--  setAnnotationAnchor a@(HsForAllTy _ _ _)        _ _s = a-  setAnnotationAnchor a@(HsQualTy _ _ _)          _ _s = a-  setAnnotationAnchor (HsTyVar an a b)          anc cs = (HsTyVar (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor a@(HsAppTy _ _ _)           _ _s = a-  setAnnotationAnchor a@(HsAppKindTy _ _ _ _)     _ _s = a-  setAnnotationAnchor (HsFunTy an a b c)        anc cs = (HsFunTy (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (HsListTy an a)           anc cs = (HsListTy (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsTupleTy an a b)        anc cs = (HsTupleTy (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsSumTy an a)            anc cs = (HsSumTy (setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(HsOpTy _ _ _ _ _)        _ _s = a-  setAnnotationAnchor (HsParTy an a)            anc cs = (HsParTy (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsIParamTy an a b)       anc cs = (HsIParamTy (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor a@(HsStarTy _ _)            _ _s = a-  setAnnotationAnchor (HsKindSig an a b)        anc cs = (HsKindSig (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor a@(HsSpliceTy _ _)          _ _s = a-  setAnnotationAnchor (HsDocTy an a b)          anc cs = (HsDocTy (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsBangTy an a b)         anc cs = (HsBangTy (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsRecTy an a)            anc cs = (HsRecTy (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (HsExplicitListTy an a b) anc cs = (HsExplicitListTy (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (HsExplicitTupleTy an a)  anc cs = (HsExplicitTupleTy (setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(HsTyLit _ _)             _ _s = a-  setAnnotationAnchor a@(HsWildCardTy _)          _ _s = a-  setAnnotationAnchor a@(XHsType _)               _ _s = a--  exact (HsForAllTy { hst_xforall = an-                    , hst_tele = tele, hst_body = ty }) = do-    tele' <- markAnnotated tele-    ty' <- markAnnotated ty-    return (HsForAllTy { hst_xforall = an-                       , hst_tele = tele', hst_body = ty' })--  exact (HsQualTy an ctxt ty) = do-    ctxt' <- markAnnotated ctxt-    ty' <- markAnnotated ty-    return (HsQualTy an ctxt' ty')-  exact (HsTyVar an promoted name) = do-    an0 <- if (promoted == IsPromoted)-             then markEpAnnL an lidl AnnSimpleQuote-             else return an-    name' <- markAnnotated name-    return (HsTyVar an0 promoted name')-  exact (HsAppTy an t1 t2) = do-    t1' <- markAnnotated t1-    t2' <- markAnnotated t2-    return (HsAppTy an t1' t2')-  exact (HsAppKindTy ss ty at ki) = do-    ty' <- markAnnotated ty-    at' <- markToken at-    ki' <- markAnnotated ki-    return (HsAppKindTy ss ty' at' ki')-  exact (HsFunTy an mult ty1 ty2) = do-    ty1' <- markAnnotated ty1-    mult' <- markArrow mult-    ty2' <- markAnnotated ty2-    return (HsFunTy an mult' ty1' ty2')-  exact (HsListTy an tys) = do-    an0 <- markOpeningParen an-    tys' <- markAnnotated tys-    an1 <- markClosingParen an0-    return (HsListTy an1 tys')-  exact (HsTupleTy an con tys) = do-    an0 <- markOpeningParen an-    tys' <- markAnnotated tys-    an1 <- markClosingParen an0-    return (HsTupleTy an1 con tys')-  exact (HsSumTy an tys) = do-    an0 <- markOpeningParen an-    tys' <- markAnnotated tys-    an1 <- markClosingParen an0-    return (HsSumTy an1 tys')-  exact (HsOpTy an promoted t1 lo t2) = do-    an0 <- if (isPromoted promoted)-        then markEpAnnL an lidl AnnSimpleQuote-        else return an-    t1' <- markAnnotated t1-    lo' <- markAnnotated lo-    t2' <- markAnnotated t2-    return (HsOpTy an0 promoted t1' lo' t2')-  exact (HsParTy an ty) = do-    an0 <- markOpeningParen an-    ty' <- markAnnotated ty-    an1 <- markClosingParen an0-    return (HsParTy an1 ty')-  exact (HsIParamTy an n t) = do-    n' <- markAnnotated n-    an0 <- markEpAnnL an lidl AnnDcolon-    t' <- markAnnotated t-    return (HsIParamTy an0 n' t')-  exact (HsStarTy an isUnicode) = do-    if isUnicode-        then printStringAdvance "\x2605" -- Unicode star-        else printStringAdvance "*"-    return (HsStarTy an isUnicode)-  exact (HsKindSig an ty k) = do-    ty' <- markAnnotated ty-    an0 <- markEpAnnL an lidl AnnDcolon-    k' <- markAnnotated k-    return (HsKindSig an0 ty' k')-  exact (HsSpliceTy a splice) = do-    splice' <- markAnnotated splice-    return (HsSpliceTy a splice')-  exact (HsDocTy an ty doc) = do-    ty' <- markAnnotated ty-    -- doc' <- markAnnotated doc-    return (HsDocTy an ty' doc)-  exact (HsBangTy an (HsSrcBang mt up str) ty) = do-    an0 <--      case mt of-        NoSourceText -> return an-        SourceText src -> do-          debugM $ "HsBangTy: src=" ++ showAst src-          an0 <- markEpAnnLMS an lid AnnOpen  (Just $ unpackFS src)-          an1 <- markEpAnnLMS an0 lid AnnClose (Just "#-}")-          debugM $ "HsBangTy: done unpackedness"-          return an1-    an1 <--      case str of-        SrcLazy     -> markEpAnnL an0 lidl AnnTilde-        SrcStrict   -> markEpAnnL an0 lidl AnnBang-        NoSrcStrict -> return an0-    ty' <- markAnnotated ty-    return (HsBangTy an1 (HsSrcBang mt up str) ty')-  exact (HsExplicitListTy an prom tys) = do-    an0 <- if (isPromoted prom)-             then markEpAnnL an lidl AnnSimpleQuote-             else return an-    an1 <- markEpAnnL an0 lidl AnnOpenS-    tys' <- markAnnotated tys-    an2 <- markEpAnnL an1 lidl AnnCloseS-    return (HsExplicitListTy an2 prom tys')-  exact (HsExplicitTupleTy an tys) = do-    an0 <- markEpAnnL an lidl AnnSimpleQuote-    an1 <- markEpAnnL an0 lidl AnnOpenP-    tys' <- markAnnotated tys-    an2 <- markEpAnnL an1 lidl AnnCloseP-    return (HsExplicitTupleTy an2 tys')-  exact (HsTyLit a lit) = do-    case lit of-      (HsNumTy src v) -> printSourceText src (show v)-      (HsStrTy src v) -> printSourceText src (show v)-      (HsCharTy src v) -> printSourceText src (show v)-    return (HsTyLit a lit)-  exact t@(HsWildCardTy _) = printStringAdvance "_" >> return t-  exact x@(HsRecTy _ _)    = error $ "missing match for HsType:" ++ showAst x-  exact x@(XHsType _)      = error $ "missing match for HsType:" ++ showAst x----- -----------------------------------------------------------------------instance ExactPrint (HsForAllTelescope GhcPs) where-  getAnnotationEntry (HsForAllVis an _)   = fromAnn an-  getAnnotationEntry (HsForAllInvis an _) = fromAnn an--  setAnnotationAnchor (HsForAllVis an a) anc cs = HsForAllVis (setAnchorEpa an anc cs) a-  setAnnotationAnchor (HsForAllInvis an a) anc cs = HsForAllInvis (setAnchorEpa an anc cs) a--  exact (HsForAllVis an bndrs)   = do-    an0 <- markLensAA an lfst -- AnnForall-    bndrs' <- markAnnotated bndrs-    an1 <- markLensAA an0 lsnd -- AnnRarrow-    return (HsForAllVis an1 bndrs')--  exact (HsForAllInvis an bndrs) = do-    an0 <- markLensAA an lfst -- AnnForall-    bndrs' <- markAnnotated bndrs-    an1 <- markLensAA an0 lsnd -- AnnDot-    return (HsForAllInvis an1 bndrs')---- -----------------------------------------------------------------------instance ExactPrint (HsDerivingClause GhcPs) where-  getAnnotationEntry d@(HsDerivingClause{}) = fromAnn (deriv_clause_ext d)-  setAnnotationAnchor x anc cs = (x { deriv_clause_ext = setAnchorEpa (deriv_clause_ext x) anc cs})-                                   `debug` ("setAnnotationAnchor HsDerivingClause: (anc,cs):" ++ showAst (anc,cs))--  exact (HsDerivingClause { deriv_clause_ext      = an-                          , deriv_clause_strategy = dcs-                          , deriv_clause_tys      = dct }) = do-    an0 <- markEpAnnL an lidl AnnDeriving-    exact_strat_before-    dct' <- markAnnotated dct-    exact_strat_after-    return (HsDerivingClause { deriv_clause_ext      = an0-                             , deriv_clause_strategy = dcs-                             , deriv_clause_tys      = dct' })-      where-        (exact_strat_before, exact_strat_after) =-          case dcs of-            Just v@(L _ ViaStrategy{}) -> (pure (), markAnnotated v >> pure ())-            _                          -> (mapM_ markAnnotated dcs, pure ())---- -----------------------------------------------------------------------instance ExactPrint (DerivStrategy GhcPs) where-  getAnnotationEntry (StockStrategy an)    = fromAnn an-  getAnnotationEntry (AnyclassStrategy an) = fromAnn an-  getAnnotationEntry (NewtypeStrategy an)  = fromAnn an-  getAnnotationEntry (ViaStrategy (XViaStrategyPs an  _)) = fromAnn an--  setAnnotationAnchor (StockStrategy an)    anc cs = (StockStrategy (setAnchorEpa an anc cs))-  setAnnotationAnchor (AnyclassStrategy an) anc cs = (AnyclassStrategy (setAnchorEpa an anc cs))-  setAnnotationAnchor (NewtypeStrategy an)  anc cs = (NewtypeStrategy (setAnchorEpa an anc cs))-  setAnnotationAnchor (ViaStrategy (XViaStrategyPs an  a)) anc cs = (ViaStrategy (XViaStrategyPs (setAnchorEpa an anc cs)  a))--  exact (StockStrategy an)    = do-    an0 <- markEpAnnL an lid AnnStock-    return (StockStrategy an0)-  exact (AnyclassStrategy an) = do-    an0 <- markEpAnnL an lid AnnAnyclass-    return (AnyclassStrategy an0)-  exact (NewtypeStrategy an)  = do-    an0 <- markEpAnnL an lid AnnNewtype-    return (NewtypeStrategy an0)-  exact (ViaStrategy (XViaStrategyPs an ty)) = do-    an0 <- markEpAnnL an lid AnnVia-    ty' <- markAnnotated ty-    return (ViaStrategy (XViaStrategyPs an0 ty'))---- -----------------------------------------------------------------------instance (ExactPrint a) => ExactPrint (LocatedC a) where-  getAnnotationEntry (L sann _) = fromAnn sann-  setAnnotationAnchor = setAnchorAn--  exact (L (SrcSpanAnn EpAnnNotUsed l) a) = do-    a' <- markAnnotated a-    return (L (SrcSpanAnn EpAnnNotUsed l) a')-  exact (L (SrcSpanAnn (EpAnn anc (AnnContext ma opens closes) cs) l) a) = do-    opens' <- mapM (markKwA AnnOpenP) opens-    a' <- markAnnotated a-    closes' <- mapM (markKwA AnnCloseP) closes-    ma' <- case ma of-      Just (UnicodeSyntax, r) -> Just . (UnicodeSyntax,) <$> markKwA AnnDarrowU r-      Just (NormalSyntax,  r) -> Just . (NormalSyntax,) <$> markKwA AnnDarrow  r-      Nothing -> pure Nothing-    return (L (SrcSpanAnn (EpAnn anc (AnnContext ma' opens' closes') cs) l) a')---- -----------------------------------------------------------------------instance ExactPrint (DerivClauseTys GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (DctSingle x ty) = do-    ty' <- markAnnotated ty-    return (DctSingle x ty')-  exact (DctMulti x tys) = do-    tys' <- markAnnotated tys-    return (DctMulti x tys')---- -----------------------------------------------------------------------instance ExactPrint (HsSigType GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (HsSig a bndrs ty) = do-    bndrs' <- markAnnotated bndrs-    ty' <- markAnnotated ty-    return (HsSig a bndrs' ty')---- -----------------------------------------------------------------------instance ExactPrint (LocatedN RdrName) where-  getAnnotationEntry (L sann _) = fromAnn sann-  setAnnotationAnchor = setAnchorAn--  exact x@(L (SrcSpanAnn EpAnnNotUsed l) n) = do-    _ <- printUnicode (spanAsAnchor l) n-    return x-  exact (L (SrcSpanAnn (EpAnn anc ann cs) ll) n) = do-    ann' <--      case ann of-        NameAnn a o l c t -> do-          mn <- markName a o (Just (l,n)) c-          case mn of-            (o', (Just (l',_n)), c') -> do -- (o', (Just (l',n')), c')-              t' <- markTrailing t-              return (NameAnn a o' l' c' t')-            _ -> error "ExactPrint (LocatedN RdrName)"-        NameAnnCommas a o commas c t -> do-          let (kwo,kwc) = adornments a-          (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn kwo o)-          commas' <- forM commas (\loc -> locFromAdd <$> markKwC NoCaptureComments (AddEpAnn AnnComma loc))-          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)-          t' <- markTrailing t-          return (NameAnnCommas a o' commas' c' t')-        NameAnnBars a o bars c t -> do-          let (kwo,kwc) = adornments a-          (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn kwo o)-          bars' <- forM bars (\loc -> locFromAdd <$> markKwC NoCaptureComments (AddEpAnn AnnVbar loc))-          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)-          t' <- markTrailing t-          return (NameAnnBars a o' bars' c' t')-        NameAnnOnly a o c t -> do-          (o',_,c') <- markName a o Nothing c-          t' <- markTrailing t-          return (NameAnnOnly a o' c' t')-        NameAnnRArrow unicode o nl c t -> do-          o' <- case o of-            Just o0 -> do-              (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn AnnOpenP o0)-              return (Just o')-            Nothing -> return Nothing-          (AddEpAnn _ nl') <--            if unicode-              then markKwC NoCaptureComments (AddEpAnn AnnRarrowU nl)-              else markKwC NoCaptureComments (AddEpAnn AnnRarrow nl)-          c' <- case c of-            Just c0 -> do-              (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn AnnCloseP c0)-              return (Just c')-            Nothing -> return Nothing-          t' <- markTrailing t-          return (NameAnnRArrow unicode o' nl' c' t')-        NameAnnQuote q name t -> do-          debugM $ "NameAnnQuote"-          (AddEpAnn _ q') <- markKwC NoCaptureComments (AddEpAnn AnnSimpleQuote q)-          (L name' _) <- markAnnotated (L name n)-          t' <- markTrailing t-          return (NameAnnQuote q' name' t')-        NameAnnTrailing t -> do-          _anc' <- printUnicode anc n-          t' <- markTrailing t-          return (NameAnnTrailing t')-    return (L (SrcSpanAnn (EpAnn anc ann' cs) ll) n)--locFromAdd :: AddEpAnn -> EpaLocation-locFromAdd (AddEpAnn _ loc) = loc--printUnicode :: (Monad m, Monoid w) => Anchor -> RdrName -> EP w m Anchor-printUnicode anc n = do-  let str = case (showPprUnsafe n) of-            -- TODO: unicode support?-              "forall" -> if spanLength (anchor anc) == 1 then "∀" else "forall"-              s -> s-  loc <- printStringAtAAC NoCaptureComments (EpaDelta (SameLine 0) []) str-  case loc of-    EpaSpan _ _ -> return anc-    EpaDelta dp [] -> return anc { anchor_op = MovedAnchor dp }-    EpaDelta _ _cs -> error "printUnicode should not capture comments"---markName :: (Monad m, Monoid w)-  => NameAdornment -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation-  -> EP w m (EpaLocation, Maybe (EpaLocation,RdrName), EpaLocation)-markName adorn open mname close = do-  let (kwo,kwc) = adornments adorn-  (AddEpAnn _ open') <- markKwC CaptureComments (AddEpAnn kwo open)-  mname' <--    case mname of-      Nothing -> return Nothing-      Just (name, a) -> do-        name' <- printStringAtAAC CaptureComments name (showPprUnsafe a)-        return (Just (name',a))-  (AddEpAnn _ close') <- markKwC CaptureComments (AddEpAnn kwc close)-  return (open', mname', close')--adornments :: NameAdornment -> (AnnKeywordId, AnnKeywordId)-adornments NameParens     = (AnnOpenP, AnnCloseP)-adornments NameParensHash = (AnnOpenPH, AnnClosePH)-adornments NameBackquotes = (AnnBackquote, AnnBackquote)-adornments NameSquare     = (AnnOpenS, AnnCloseS)---markTrailingL :: (Monad m, Monoid w) => EpAnn a -> Lens a [TrailingAnn] -> EP w m (EpAnn a)-markTrailingL EpAnnNotUsed _ = return EpAnnNotUsed-markTrailingL (EpAnn anc an cs) l = do-  ts <- mapM markKwT (view l an)-  return (EpAnn anc (set l ts an) cs)--markTrailing :: (Monad m, Monoid w) => [TrailingAnn] -> EP w m [TrailingAnn]-markTrailing ts = do-  p <- getPosP-  debugM $ "markTrailing:" ++ showPprUnsafe (p,ts)-  mapM markKwT ts---- ------------------------------------------------------------------------- based on pp_condecls in Decls.hs-exact_condecls :: (Monad m, Monoid w)-  => EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> EP w m (EpAnn [AddEpAnn],[LConDecl GhcPs])-exact_condecls an cs-  | gadt_syntax                  -- In GADT syntax-  = do-      cs' <- mapM markAnnotated cs-      return (an, cs')-  | otherwise                    -- In H98 syntax-  = do-      an0 <- markEpAnnL an lidl AnnEqual-      cs' <- mapM markAnnotated cs-      return (an0, cs')-  where-    gadt_syntax = case cs of-      []                      -> False-      (L _ ConDeclH98{}  : _) -> False-      (L _ ConDeclGADT{} : _) -> True---- -----------------------------------------------------------------------instance ExactPrint (ConDecl GhcPs) where-  getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (con_g_ext x)-  getAnnotationEntry x@(ConDeclH98{})  = fromAnn (con_ext x)--  setAnnotationAnchor x@ConDeclGADT{} anc cs = x { con_g_ext = setAnchorEpa (con_g_ext x) anc cs}-  setAnnotationAnchor x@ConDeclH98{}  anc cs = x { con_ext   = setAnchorEpa (con_ext x) anc cs}---- based on pprConDecl-  exact (ConDeclH98 { con_ext = an-                    , con_name = con-                    , con_forall = has_forall-                    , con_ex_tvs = ex_tvs-                    , con_mb_cxt = mcxt-                    , con_args = args-                    , con_doc = doc }) = do-    -- doc' <- mapM markAnnotated doc-    an0 <- if has_forall-      then markEpAnnL an lidl AnnForall-      else return an-    ex_tvs' <- mapM markAnnotated ex_tvs-    an1 <- if has_forall-      then markEpAnnL an0 lidl AnnDot-      else return an0-    mcxt' <- mapM markAnnotated mcxt-    an2 <- if (isJust mcxt)-      then markEpAnnL an1 lidl AnnDarrow-      else return an1--    (con', args') <- exact_details args-    return (ConDeclH98 { con_ext = an2-                       , con_name = con'-                       , con_forall = has_forall-                       , con_ex_tvs = ex_tvs'-                       , con_mb_cxt = mcxt'-                       , con_args = args'-                       , con_doc = doc })--    where-    --   -- In ppr_details: let's not print the multiplicities (they are always 1, by-    --   -- definition) as they do not appear in an actual declaration.-      exact_details (InfixCon t1 t2) = do-        t1' <- markAnnotated t1-        con' <- markAnnotated con-        t2' <- markAnnotated t2-        return (con', InfixCon t1' t2')-      exact_details (PrefixCon tyargs tys) = do-        con' <- markAnnotated con-        tyargs' <- markAnnotated tyargs-        tys' <- markAnnotated tys-        return (con', PrefixCon tyargs' tys')-      exact_details (RecCon fields) = do-        con' <- markAnnotated con-        fields' <- markAnnotated fields-        return (con', RecCon fields')--  -- -------------------------------------  exact (ConDeclGADT { con_g_ext = an-                     , con_names = cons-                     , con_dcolon = dcol-                     , con_bndrs = bndrs-                     , con_mb_cxt = mcxt, con_g_args = args-                     , con_res_ty = res_ty, con_doc = doc }) = do-    -- doc' <- mapM markAnnotated doc-    cons' <- mapM markAnnotated cons-    dcol' <- markUniToken dcol-    an1 <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]--    -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558-    bndrs' <- case bndrs of-      L _ (HsOuterImplicit _) -> return bndrs-      _ -> markAnnotated bndrs--    mcxt' <- mapM markAnnotated mcxt-    an2 <- if (isJust mcxt)-      then markEpAnnL an1 lidl AnnDarrow-      else return an1-    args' <--      case args of-          (PrefixConGADT args0) -> do-            args0' <- mapM markAnnotated args0-            return (PrefixConGADT args0')-          (RecConGADT fields rarr) -> do-            fields' <- markAnnotated fields-            rarr' <- markUniToken rarr-            return (RecConGADT fields' rarr')-    res_ty' <- markAnnotated res_ty-    return (ConDeclGADT { con_g_ext = an2-                        , con_names = cons'-                        , con_dcolon = dcol'-                        , con_bndrs = bndrs'-                        , con_mb_cxt = mcxt', con_g_args = args'-                        , con_res_ty = res_ty', con_doc = doc })---- -----------------------------------------------------------------------instance ExactPrint Void where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact x = return x---- -----------------------------------------------------------------------instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) where-  getAnnotationEntry (HsOuterImplicit _) = NoEntryVal-  getAnnotationEntry (HsOuterExplicit an _) = fromAnn an--  setAnnotationAnchor (HsOuterImplicit a) _ _ = HsOuterImplicit a-  setAnnotationAnchor (HsOuterExplicit an a) anc cs = HsOuterExplicit (setAnchorEpa an anc cs) a--  exact b@(HsOuterImplicit _) = pure b-  exact (HsOuterExplicit an bndrs) = do-    an0 <- markLensAA an lfst -- "forall"-    bndrs' <- markAnnotated bndrs-    an1 <- markLensAA an0 lsnd -- "."-    return (HsOuterExplicit an1 bndrs')---- -----------------------------------------------------------------------instance ExactPrint (ConDeclField GhcPs) where-  getAnnotationEntry f@(ConDeclField{}) = fromAnn (cd_fld_ext f)--  setAnnotationAnchor x anc cs = x { cd_fld_ext = setAnchorEpa (cd_fld_ext x) anc cs}--  exact (ConDeclField an names ftype mdoc) = do-    names' <- markAnnotated names-    an0 <- markEpAnnL an lidl AnnDcolon-    ftype' <- markAnnotated ftype-    -- mdoc' <- mapM markAnnotated mdoc-    return (ConDeclField an0 names' ftype' mdoc)---- -----------------------------------------------------------------------instance ExactPrint (FieldOcc GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact f@(FieldOcc _ n) = markAnnotated n >> return f---- -----------------------------------------------------------------------instance ExactPrint (AmbiguousFieldOcc GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact f@(Unambiguous _ n) = markAnnotated n >> return f-  exact f@(Ambiguous   _ n) = markAnnotated n >> return f---- -----------------------------------------------------------------------instance (ExactPrint a) => ExactPrint (HsScaled GhcPs a) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (HsScaled arr t) = do-    t' <- markAnnotated t-    arr' <- markArrow arr-    return (HsScaled arr' t')---- -----------------------------------------------------------------------instance ExactPrint (LocatedP CType) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn--  exact x@(L (SrcSpanAnn EpAnnNotUsed _) ct) = withPpr ct >> return x-  exact (L (SrcSpanAnn an ll)-         (CType stp mh (stct,ct))) = do-    an0 <- markAnnOpenP an stp "{-# CTYPE"-    an1 <- case mh of-             Nothing -> return an0-             Just (Header srcH _h) ->-               markEpAnnLMS an0 lapr_rest AnnHeader (Just (toSourceTextWithSuffix srcH "" ""))-    an2 <- markEpAnnLMS an1 lapr_rest AnnVal (Just (toSourceTextWithSuffix stct (unpackFS ct) ""))-    an3 <- markAnnCloseP an2-    return (L (SrcSpanAnn an3 ll)-         (CType stp mh (stct,ct)))---- -----------------------------------------------------------------------instance ExactPrint (SourceText, RuleName) where-  -- We end up at the right place from the Located wrapper-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (st, rn)-    = printStringAdvance (toSourceTextWithSuffix st (unpackFS rn) "")-      >> return (st, rn)----- =====================================================================--- LocatedL instances start -------- Each is dealt with specifically, as they have--- different wrapping annotations in the al_rest zone.------ In future, the annotation could perhaps be improved, with an--- 'al_pre' and 'al_post' set of annotations to be simply sorted and--- applied.--- -----------------------------------------------------------------------instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn--  exact (L (SrcSpanAnn an l) ies) = do-    debugM $ "LocatedL [LIE"-    an0 <- markEpAnnL an lal_rest AnnHiding-    p <- getPosP-    debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p-    (an1, ies') <- markAnnList True an0 (markAnnotated ies)-    return (L (SrcSpanAnn an1 l) ies')--instance (ExactPrint (Match GhcPs (LocatedA body)))-   => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA body))]) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn-  exact (L la a) = do-    let an = ann la-    debugM $ "LocatedL [LMatch"-    -- TODO: markAnnList?-    an0 <- markEpAnnAllL an lal_rest AnnWhere-    an1 <- markLensMAA an0 lal_open-    an2 <- markEpAnnAllL an1 lal_rest AnnSemi-    a' <- markAnnotated a-    an3 <- markLensMAA an2 lal_close-    return (L (la { ann = an3}) a')--instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn-  exact (L (SrcSpanAnn an l) stmts) = do-    debugM $ "LocatedL [ExprLStmt"-    (an'', stmts') <- markAnnList True an $ do-      case snocView stmts of-        Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do-          debugM $ "LocatedL [ExprLStmt: snocView"-          ls' <- markAnnotated ls-          initStmts' <- markAnnotated initStmts-          return (initStmts' ++ [ls'])-        _ -> do-          markAnnotated stmts-    return (L (SrcSpanAnn an'' l) stmts')---- instance ExactPrint (LocatedL [CmdLStmt GhcPs]) where-instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn-  exact (L (SrcSpanAnn ann l) es) = do-    debugM $ "LocatedL [CmdLStmt"-    an0 <- markLensMAA ann lal_open-    es' <- mapM markAnnotated es-    an1 <- markLensMAA an0 lal_close-    return (L (SrcSpanAnn an1 l) es')--instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn-  exact (L (SrcSpanAnn an l) fs) = do-    debugM $ "LocatedL [LConDeclField"-    (an', fs') <- markAnnList True an (markAnnotated fs)-    return (L (SrcSpanAnn an' l) fs')--instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where-  getAnnotationEntry = entryFromLocatedA-  setAnnotationAnchor = setAnchorAn-  exact (L (SrcSpanAnn an l) bf) = do-    debugM $ "LocatedL [LBooleanFormula"-    (an', bf') <- markAnnList True an (markAnnotated bf)-    return (L (SrcSpanAnn an' l) bf')---- ------------------------------------------------------------------------ LocatedL instances end ----- =====================================================================--instance ExactPrint (IE GhcPs) where-  getAnnotationEntry (IEVar _ _)            = NoEntryVal-  getAnnotationEntry (IEThingAbs (_, an) _)      = fromAnn an-  getAnnotationEntry (IEThingAll (_, an) _)      = fromAnn an-  getAnnotationEntry (IEThingWith (_, an) _ _ _) = fromAnn an-  getAnnotationEntry (IEModuleContents (_, an) _)= fromAnn an-  getAnnotationEntry (IEGroup _ _ _)        = NoEntryVal-  getAnnotationEntry (IEDoc _ _)            = NoEntryVal-  getAnnotationEntry (IEDocNamed _ _)       = NoEntryVal--  setAnnotationAnchor a@(IEVar _ _)             _ _s = a-  setAnnotationAnchor (IEThingAbs (depr, an) a)       anc cs = (IEThingAbs (depr, setAnchorEpa an anc cs) a)-  setAnnotationAnchor (IEThingAll (depr, an) a)       anc cs = (IEThingAll (depr, setAnchorEpa an anc cs) a)-  setAnnotationAnchor (IEThingWith (depr, an) a b c)  anc cs = (IEThingWith (depr, setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (IEModuleContents (depr, an) a) anc cs = (IEModuleContents (depr, setAnchorEpa an anc cs) a)-  setAnnotationAnchor a@(IEGroup _ _ _)         _ _s = a-  setAnnotationAnchor a@(IEDoc _ _)             _ _s = a-  setAnnotationAnchor a@(IEDocNamed _ _)        _ _s = a--  exact (IEVar depr ln) = do-    depr' <- markAnnotated depr-    ln' <- markAnnotated ln-    return (IEVar depr' ln')-  exact (IEThingAbs (depr, an) thing) = do-    depr' <- markAnnotated depr-    thing' <- markAnnotated thing-    return (IEThingAbs (depr', an) thing')-  exact (IEThingAll (depr, an) thing) = do-    depr' <- markAnnotated depr-    thing' <- markAnnotated thing-    an0 <- markEpAnnL an  lidl AnnOpenP-    an1 <- markEpAnnL an0 lidl AnnDotdot-    an2 <- markEpAnnL an1 lidl AnnCloseP-    return (IEThingAll (depr', an2) thing')--  exact (IEThingWith (depr, an) thing wc withs) = do-    depr' <- markAnnotated depr-    thing' <- markAnnotated thing-    an0 <- markEpAnnL an lidl AnnOpenP-    (an1, wc', withs') <--      case wc of-        NoIEWildcard -> do-          withs'' <- markAnnotated withs-          return (an0, wc, withs'')-        IEWildcard pos -> do-          let (bs, as) = splitAt pos withs-          bs' <- markAnnotated bs-          an1 <- markEpAnnL an0 lidl AnnDotdot-          an2 <- markEpAnnL an1 lidl AnnComma-          as' <- markAnnotated as-          return (an2, wc, bs'++as')-    an2 <- markEpAnnL an1 lidl AnnCloseP-    return (IEThingWith (depr', an2) thing' wc' withs')--  exact (IEModuleContents (depr, an) m) = do-    depr' <- markAnnotated depr-    an0 <- markEpAnnL an lidl AnnModule-    m' <- markAnnotated m-    return (IEModuleContents (depr', an0) m')--  -- These three exist to not error out, but are no-ops The contents-  -- appear as "normal" comments too, which we process instead.-  exact (IEGroup x lev doc) = do-    return (IEGroup x lev doc)-  exact (IEDoc x doc) = do-    return (IEDoc x doc)-  exact (IEDocNamed x str) = do-    return (IEDocNamed x str)---- -----------------------------------------------------------------------instance ExactPrint (IEWrappedName GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (IEName x n) = do-    n' <- markAnnotated n-    return (IEName x n')-  exact (IEPattern r n) = do-    r' <- printStringAtAA r "pattern"-    n' <- markAnnotated n-    return (IEPattern r' n')-  exact (IEType r n) = do-    r' <- printStringAtAA r "type"-    n' <- markAnnotated n-    return (IEType r' n')---- -----------------------------------------------------------------------instance ExactPrint (Pat GhcPs) where-  getAnnotationEntry (WildPat _)              = NoEntryVal-  getAnnotationEntry (VarPat _ _)             = NoEntryVal-  getAnnotationEntry (LazyPat an _)           = fromAnn an-  getAnnotationEntry (AsPat an _ _ _)         = fromAnn an-  getAnnotationEntry (ParPat an _ _ _)        = fromAnn an-  getAnnotationEntry (BangPat an _)           = fromAnn an-  getAnnotationEntry (ListPat an _)           = fromAnn an-  getAnnotationEntry (TuplePat an _ _)        = fromAnn an-  getAnnotationEntry (SumPat an _ _ _)        = fromAnn an-  getAnnotationEntry (ConPat an _ _)          = fromAnn an-  getAnnotationEntry (ViewPat an _ _)         = fromAnn an-  getAnnotationEntry (SplicePat _ _)          = NoEntryVal-  getAnnotationEntry (LitPat _ _)             = NoEntryVal-  getAnnotationEntry (NPat an _ _ _)          = fromAnn an-  getAnnotationEntry (NPlusKPat an _ _ _ _ _) = fromAnn an-  getAnnotationEntry (SigPat an _ _)          = fromAnn an--  setAnnotationAnchor a@(WildPat _)              _ _s = a-  setAnnotationAnchor a@(VarPat _ _)             _ _s = a-  setAnnotationAnchor (LazyPat an a)            anc cs = (LazyPat (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (AsPat an a at b)         anc cs = (AsPat (setAnchorEpa an anc cs) a at b)-  setAnnotationAnchor (ParPat an a b c)         anc cs = (ParPat (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (BangPat an a)            anc cs = (BangPat (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (ListPat an a)            anc cs = (ListPat (setAnchorEpa an anc cs) a)-  setAnnotationAnchor (TuplePat an a b)         anc cs = (TuplePat (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (SumPat an a b c)         anc cs = (SumPat (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (ConPat an a b)           anc cs = (ConPat (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor (ViewPat an a b)          anc cs = (ViewPat (setAnchorEpa an anc cs) a b)-  setAnnotationAnchor a@(SplicePat _ _)           _ _s = a-  setAnnotationAnchor a@(LitPat _ _)              _ _s = a-  setAnnotationAnchor (NPat an a b c)          anc cs = (NPat (setAnchorEpa an anc cs) a b c)-  setAnnotationAnchor (NPlusKPat an a b c d e) anc cs = (NPlusKPat (setAnchorEpa an anc cs) a b c d e)-  setAnnotationAnchor (SigPat an a b)          anc cs = (SigPat (setAnchorEpa an anc cs) a b)--  exact (WildPat w) = do-    anchor <- getAnchorU-    debugM $ "WildPat:anchor=" ++ show anchor-    _ <- printStringAtRs anchor "_"-    return (WildPat w)-  exact (VarPat x n) = do-    -- The parser inserts a placeholder value for a record pun rhs. This must be-    -- filtered.-    let pun_RDR = "pun-right-hand-side"-    n' <- if (showPprUnsafe n /= pun_RDR)-      then markAnnotated n-      else return n-    return (VarPat x n')-  exact (LazyPat an pat) = do-    an0 <- markEpAnnL an lidl AnnTilde-    pat' <- markAnnotated pat-    return (LazyPat an0 pat')-  exact (AsPat an n at pat) = do-    n' <- markAnnotated n-    at' <- markToken at-    pat' <- markAnnotated pat-    return (AsPat an n' at' pat')-  exact (ParPat an lpar pat rpar) = do-    lpar' <- markToken lpar-    pat' <- markAnnotated pat-    rpar' <- markToken rpar-    return (ParPat an lpar' pat' rpar')--  exact (BangPat an pat) = do-    an0 <- markEpAnnL an lidl AnnBang-    pat' <- markAnnotated pat-    return (BangPat an0 pat')--  exact (ListPat an pats) = do-    (an', pats') <- markAnnList True an (markAnnotated pats)-    return (ListPat an' pats')--  exact (TuplePat an pats boxity) = do-    an0 <- case boxity of-             Boxed   -> markEpAnnL an lidl AnnOpenP-             Unboxed -> markEpAnnL an lidl AnnOpenPH-    pats' <- markAnnotated pats-    an1 <- case boxity of-             Boxed   -> markEpAnnL an0 lidl AnnCloseP-             Unboxed -> markEpAnnL an0 lidl AnnClosePH-    return (TuplePat an1 pats' boxity)--  exact (SumPat an pat alt arity) = do-    an0 <- markEpAnnL an lsumPatParens AnnOpenPH-    an1 <- markAnnKwAllL an0 lsumPatVbarsBefore AnnVbar-    pat' <- markAnnotated pat-    an2 <- markAnnKwAllL an1 lsumPatVbarsAfter AnnVbar-    an3 <- markEpAnnL an2 lsumPatParens AnnClosePH-    return (SumPat an3 pat' alt arity)--  -- | ConPat an con args)-  exact (ConPat an con details) = do-    (an', con', details') <- exactUserCon an con details-    return (ConPat an' con' details')-  exact (ViewPat an expr pat) = do-    expr' <- markAnnotated expr-    an0 <- markEpAnnL an lidl AnnRarrow-    pat' <- markAnnotated pat-    return (ViewPat an0 expr' pat')-  exact (SplicePat x splice) = do-    splice' <- markAnnotated splice-    return (SplicePat x splice')-  exact p@(LitPat _ lit) = printStringAdvance (hsLit2String lit) >> return p-  exact (NPat an ol mn z) = do-    an0 <- if (isJust mn)-      then markEpAnnL an lidl AnnMinus-      else return an-    ol' <- markAnnotated ol-    return (NPat an0 ol' mn z)--  -- | NPlusKPat an n lit1 lit2 _ _)-  exact (NPlusKPat an n k lit2 a b) = do-    n' <- markAnnotated n-    an' <- printStringAtAAL an lid "+"-    k' <- markAnnotated k-    return (NPlusKPat an' n' k' lit2 a b)--  exact (SigPat an pat sig) = do-    pat' <- markAnnotated pat-    an0 <- markEpAnnL an lidl AnnDcolon-    sig' <- markAnnotated sig-    return (SigPat an0 pat' sig')---- -----------------------------------------------------------------------instance ExactPrint (HsPatSigType GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact (HsPS an ty) = do-    ty' <- markAnnotated ty-    return (HsPS an ty')---- -----------------------------------------------------------------------instance ExactPrint (HsOverLit GhcPs) where-  getAnnotationEntry = const NoEntryVal-  setAnnotationAnchor a _ _ = a--  exact ol =-    let str = case ol_val ol of-                HsIntegral   (IL src _ _) -> src-                HsFractional (FL{ fl_text = src }) -> src-                HsIsString src _ -> src-    in-      case str of-        SourceText s -> printStringAdvance (unpackFS s) >> return ol-        NoSourceText -> return ol---- -----------------------------------------------------------------------hsLit2String :: HsLit GhcPs -> String-hsLit2String lit =-  case lit of-    HsChar       src v   -> toSourceTextWithSuffix src v ""-    HsCharPrim   src p   -> toSourceTextWithSuffix src p ""-    HsString     src v   -> toSourceTextWithSuffix src v ""-    HsStringPrim src v   -> toSourceTextWithSuffix src v ""-    HsInt        _ (IL src _ v)   -> toSourceTextWithSuffix src v ""-    HsIntPrim    src v   -> toSourceTextWithSuffix src v ""-    HsWordPrim   src v   -> toSourceTextWithSuffix src v ""-    HsInt8Prim   src v   -> toSourceTextWithSuffix src v ""-    HsInt16Prim  src v   -> toSourceTextWithSuffix src v ""-    HsInt32Prim  src v   -> toSourceTextWithSuffix src v ""-    HsInt64Prim  src v   -> toSourceTextWithSuffix src v ""-    HsWord8Prim  src v   -> toSourceTextWithSuffix src v ""-    HsWord16Prim src v   -> toSourceTextWithSuffix src v ""-    HsWord32Prim src v   -> toSourceTextWithSuffix src v ""-    HsWord64Prim src v   -> toSourceTextWithSuffix src v ""-    HsInteger    src v _ -> toSourceTextWithSuffix src v ""-    HsRat        _ fl@(FL{fl_text = src }) _ -> toSourceTextWithSuffix src fl ""-    HsFloatPrim  _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "#"-    HsDoublePrim _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "##"--toSourceTextWithSuffix :: (Show a) => SourceText -> a -> String -> String-toSourceTextWithSuffix (NoSourceText)    alt suffix = show alt ++ suffix-toSourceTextWithSuffix (SourceText txt) _alt suffix = unpackFS txt ++ suffix--sourceTextToString :: SourceText -> String -> String-sourceTextToString NoSourceText alt   = alt-sourceTextToString (SourceText txt) _ = unpackFS txt---- -----------------------------------------------------------------------exactUserCon :: (Monad m, Monoid w, ExactPrint con)-  => EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs-  -> EP w m (EpAnn [AddEpAnn], con, HsConPatDetails GhcPs)-exactUserCon an c (InfixCon p1 p2) = do-  p1' <- markAnnotated p1-  c' <- markAnnotated c-  p2' <- markAnnotated p2-  return (an, c', InfixCon p1' p2')-exactUserCon an c details = do-  c' <- markAnnotated c-  an0 <- markEpAnnL an lidl AnnOpenC-  details' <- exactConArgs details-  an1 <- markEpAnnL an0 lidl AnnCloseC-  return (an1, c', details')--instance ExactPrint (HsConPatTyArg GhcPs) where-  getAnnotationEntry _ = NoEntryVal-  setAnnotationAnchor a _ _ = a-  exact (HsConPatTyArg at tyarg) = do-    at' <- markToken at-    tyarg' <- markAnnotated tyarg-    return (HsConPatTyArg at' tyarg')--exactConArgs :: (Monad m, Monoid w)-  => HsConPatDetails GhcPs -> EP w m (HsConPatDetails GhcPs)-exactConArgs (PrefixCon tyargs pats) = do-  tyargs' <- markAnnotated tyargs-  pats' <- markAnnotated pats-  return (PrefixCon tyargs' pats')-exactConArgs (InfixCon p1 p2) = do-  p1' <- markAnnotated p1-  p2' <- markAnnotated p2-  return (InfixCon p1' p2')-exactConArgs (RecCon rpats) = do-  rpats' <- markAnnotated rpats-  return (RecCon rpats')---- -----------------------------------------------------------------------entryFromLocatedA :: LocatedAn ann a -> Entry-entryFromLocatedA (L la _) = fromAnn la---- =====================================================================--- Utility stuff--- ------------------------------------------------------------------------- |This should be the final point where things are mode concrete,--- before output.--- NOTE: despite the name, this is the ghc-exactprint final output for--- the PRINT phase.-printStringAtLsDelta :: (Monad m, Monoid w) => DeltaPos -> String -> EP w m ()-printStringAtLsDelta cl s = do-  p <- getPosP-  colOffset <- getLayoutOffsetP-  if isGoodDeltaWithOffset cl colOffset-    then do-      dprior <- getPriorEndD-      printStringAt (undelta p cl colOffset) s-        -- `debug` ("printStringAtLsDelta:(cl,colOffset):" ++ show (cl,colOffset,s))-      p' <- getPosP-      dafter <- getPriorEndD-      setPriorEndASTPD (dprior,dafter)--      debugM $ "printStringAtLsDelta:(pos,p,p',d,s):" ++ show (undelta p cl colOffset,p,p',dafter,s)-    else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))---- -----------------------------------------------------------------------isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool-isGoodDeltaWithOffset dp colOffset = isGoodDelta (deltaPos l c)-  where (l,c) = undelta (0,0) dp colOffset---- | Print a comment, using the current layout offset to convert the--- @DeltaPos@ to an absolute position.-printQueuedComment :: (Monad m, Monoid w) => RealSrcSpan -> Comment -> DeltaPos -> EP w m ()-printQueuedComment _loc Comment{commentContents} dp = do-  p <- getPosP-  d <- getPriorEndD-  colOffset <- getLayoutOffsetP-  let (dr,dc) = undelta (0,0) dp colOffset-  -- do not lose comments against the left margin-  when (isGoodDelta (deltaPos dr (max 0 dc))) $ do-    printCommentAt (undelta p dp colOffset) commentContents-  p' <- getPosP-  d' <- getPriorEndD-  debugM $ "printQueuedComment: (p,p',d,d')=" ++ show (p,p',d,d')-  debugM $ "printQueuedComment: (p,p',dp,colOffset,undelta)=" ++ show (p,p',dp,colOffset,undelta p dp colOffset)----------------------------------------------------------------------------setLayoutBoth :: (Monad m, Monoid w) => EP w m a -> EP w m a-setLayoutBoth k = do-  oldLHS <- getLayoutOffsetD-  oldAnchorOffset <- getLayoutOffsetP-  debugM $ "setLayoutBoth: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)-  modify (\a -> a { dMarkLayout = True-                  , pMarkLayout = True } )-  let reset = do-        debugM $ "setLayoutBoth:reset: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)-        modify (\a -> a { dMarkLayout = False-                        , dLHS = oldLHS-                        , pMarkLayout = False-                        , pLHS = oldAnchorOffset} )-  k <* reset---- Use 'local', designed for this-setLayoutTopLevelP :: (Monad m, Monoid w) => EP w m a -> EP w m a-setLayoutTopLevelP k = do-  debugM $ "setLayoutTopLevelP entered"-  oldAnchorOffset <- getLayoutOffsetP-  modify (\a -> a { pMarkLayout = False-                  , pLHS = 1} )-  r <- k-  debugM $ "setLayoutTopLevelP:resetting"-  setLayoutOffsetP oldAnchorOffset-  return r----------------------------------------------------------------------------getPosP :: (Monad m, Monoid w) => EP w m Pos-getPosP = gets epPos--setPosP :: (Monad m, Monoid w) => Pos -> EP w m ()-setPosP l = do-  debugM $ "setPosP:" ++ show l-  modify (\s -> s {epPos = l})--getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe Anchor)-getExtraDP = gets uExtraDP--setExtraDP :: (Monad m, Monoid w) => Maybe Anchor -> EP w m ()-setExtraDP md = do-  debugM $ "setExtraDP:" ++ show md-  modify (\s -> s {uExtraDP = md})--getPriorEndD :: (Monad m, Monoid w) => EP w m Pos-getPriorEndD = gets dPriorEndPosition--getAnchorU :: (Monad m, Monoid w) => EP w m RealSrcSpan-getAnchorU = gets uAnchorSpan--setPriorEndD :: (Monad m, Monoid w) => Pos -> EP w m ()-setPriorEndD pe = do-  setPriorEndNoLayoutD pe--setPriorEndNoLayoutD :: (Monad m, Monoid w) => Pos -> EP w m ()-setPriorEndNoLayoutD pe = do-  debugM $ "setPriorEndNoLayoutD:pe=" ++ show pe-  modify (\s -> s { dPriorEndPosition = pe })--setPriorEndASTD :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()-setPriorEndASTD pe = setPriorEndASTPD (rs2range pe)--setPriorEndASTPD :: (Monad m, Monoid w) => (Pos,Pos) -> EP w m ()-setPriorEndASTPD pe@(fm,to) = do-  debugM $ "setPriorEndASTD:pe=" ++ show pe-  when True $ setLayoutStartD (snd fm)-  modify (\s -> s { dPriorEndPosition = to } )--setLayoutStartD :: (Monad m, Monoid w) => Int -> EP w m ()-setLayoutStartD p = do-  EPState{dMarkLayout} <- get-  when dMarkLayout $ do-    debugM $ "setLayoutStartD: setting dLHS=" ++ show p-    modify (\s -> s { dMarkLayout = False-                    , dLHS = LayoutStartCol p})--getLayoutOffsetD :: (Monad m, Monoid w) => EP w m LayoutStartCol-getLayoutOffsetD = gets dLHS--setAnchorU :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()-setAnchorU rss = do-  debugM $ "setAnchorU:" ++ show (rs2range rss)-  modify (\s -> s { uAnchorSpan = rss })--getEofPos :: (Monad m, Monoid w) => EP w m (Maybe (RealSrcSpan, RealSrcSpan))-getEofPos = gets epEof--setEofPos :: (Monad m, Monoid w) => Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()-setEofPos l = modify (\s -> s {epEof = l})---- -----------------------------------------------------------------------getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]-getUnallocatedComments = gets epComments--putUnallocatedComments :: (Monad m, Monoid w) => [Comment] -> EP w m ()-putUnallocatedComments cs = modify (\s -> s { epComments = cs } )---- | Push a fresh stack frame for the applied comments gatherer-pushAppliedComments  :: (Monad m, Monoid w) => EP w m ()-pushAppliedComments = modify (\s -> s { epCommentsApplied = []:(epCommentsApplied s) })---- | Return the comments applied since the last call--- takeAppliedComments, and clear them, not popping the stack-takeAppliedComments :: (Monad m, Monoid w) => EP w m [Comment]-takeAppliedComments = do-  ccs <- gets epCommentsApplied-  case ccs of-    [] -> do-      modify (\s -> s { epCommentsApplied = [] })-      return []-    h:t -> do-      modify (\s -> s { epCommentsApplied = []:t })-      return (reverse h)---- | Return the comments applied since the last call--- takeAppliedComments, and clear them, popping the stack-takeAppliedCommentsPop :: (Monad m, Monoid w) => EP w m [Comment]-takeAppliedCommentsPop = do-  ccs <- gets epCommentsApplied-  case ccs of-    [] -> do-      modify (\s -> s { epCommentsApplied = [] })-      return []-    h:t -> do-      modify (\s -> s { epCommentsApplied = t })-      return (reverse h)---- | Mark a comment as being applied.  This is used to update comments--- when doing delta processing-applyComment :: (Monad m, Monoid w) => Comment -> EP w m ()-applyComment c = do-  ccs <- gets epCommentsApplied+{-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiWayIf           #-}+{-# LANGUAGE NamedFieldPuns       #-}+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE StandaloneDeriving   #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns         #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TupleSections        #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE BlockArguments       #-}+{-# LANGUAGE UndecidableInstances  #-} -- For the (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ExactPrint instance+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-incomplete-record-updates #-}++module Language.Haskell.GHC.ExactPrint.ExactPrint+  (+    ExactPrint(..)+  , exactPrint+  , exactPrintWithOptions+  , makeDeltaAst++  -- * Configuration+  , EPOptions(epRigidity, epAstPrint, epTokenPrint, epWhitespacePrint, epUpdateAnchors)+  , stringOptions+  , epOptions+  , deltaOptions+  ) where++import GHC+import GHC.Base (NonEmpty(..))+import GHC.Core.Coercion.Axiom (Role(..))+import GHC.Data.Bag+import qualified GHC.Data.BooleanFormula as BF+import GHC.Data.FastString+import GHC.TypeLits+import GHC.Types.Basic hiding (EP)+import GHC.Types.Fixity+import GHC.Types.ForeignCall+import GHC.Types.Name.Reader+import GHC.Types.PkgQual+import GHC.Types.SourceText+import GHC.Types.SrcLoc+import GHC.Types.Var+import GHC.Unit.Module.Warnings+import GHC.Utils.Misc+import GHC.Utils.Outputable hiding ( (<>) )+import GHC.Utils.Panic++import Language.Haskell.Syntax.Basic (FieldLabelString(..))++import Control.Monad (forM, when, unless)+import Control.Monad.Identity (Identity(..))+import qualified Control.Monad.Reader as Reader+import Control.Monad.RWS (MonadReader, RWST, evalRWST, tell, modify, get, gets, ask)+import Control.Monad.Trans (lift)+import Data.Data ( Data )+import Data.Dynamic+import Data.Foldable+import Data.Functor.Const+import qualified Data.Set as Set+import Data.Typeable+import Data.List ( partition, sort, sortBy)+import qualified Data.Map.Strict as Map+import Data.Maybe ( isJust, mapMaybe )+import Data.Void++import Language.Haskell.GHC.ExactPrint.Lookup+import Language.Haskell.GHC.ExactPrint.Utils+import Language.Haskell.GHC.ExactPrint.Types++-- ---------------------------------------------------------------------++exactPrint :: ExactPrint ast => ast -> String+exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast))++-- | The additional option to specify the rigidity and printing+-- configuration.+exactPrintWithOptions :: (ExactPrint ast, Monoid b, Monad m)+                      => EPOptions m b+                      -> ast+                      -> m (ast, b)+exactPrintWithOptions r ast =+    runEP r (markAnnotated ast)++-- | Transform concrete annotations into relative annotations which+-- are more useful when transforming an AST. This corresponds to the+-- earlier 'relativiseApiAnns'.+makeDeltaAst :: ExactPrint ast => ast -> ast+makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast))++------------------------------------------------------++type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a++runEP :: (Monad m)+      => EPOptions m w+      -> EP w m a -> m (a, w)+runEP epReader action = do+  (ast, w) <- evalRWST action epReader defaultEPState+  return (ast, output w)++-- ---------------------------------------------------------------------++defaultEPState :: EPState+defaultEPState = EPState+             { epPos      = (1,1)+             , dLHS       = 0+             , pMarkLayout = False+             , pLHS = 0+             , dMarkLayout = False+             , dPriorEndPosition = (1,1)+             , uAnchorSpan = badRealSrcSpan+             , uExtraDP = Nothing+             , uExtraDPReturn = Nothing+             , pAcceptSpan = False+             , epComments = []+             , epCommentsApplied = []+             , epEof = Nothing+             }+++-- ---------------------------------------------------------------------+-- The EP monad and basic combinators++-- | The R part of RWS. The environment. Updated via 'local' as we+-- enter a new AST element, having a different anchor point.+data EPOptions m a = EPOptions+            {+              epAstPrint :: forall ast . Data ast => GHC.Located ast -> a -> m a+            , epTokenPrint :: String -> m a+            , epWhitespacePrint :: String -> m a+            , epRigidity :: Rigidity+            , epUpdateAnchors :: Bool+            }++-- | Helper to create a 'EPOptions'+epOptions ::+      (forall ast . Data ast => GHC.Located ast -> a -> m a)+      -> (String -> m a)+      -> (String -> m a)+      -> Rigidity+      -> Bool+      -> EPOptions m a+epOptions astPrint tokenPrint wsPrint rigidity delta = EPOptions+             {+               epAstPrint = astPrint+             , epWhitespacePrint = wsPrint+             , epTokenPrint = tokenPrint+             , epRigidity = rigidity+             , epUpdateAnchors = delta+             }++-- | Options which can be used to print as a normal String.+stringOptions :: EPOptions Identity String+stringOptions = epOptions (\_ b -> return b) return return NormalLayout False++-- | Options which can be used to simply update the AST to be in delta+-- form, without generating output+deltaOptions :: EPOptions Identity ()+deltaOptions = epOptions (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ()) NormalLayout True++data EPWriter a = EPWriter+              { output :: !a }++instance Monoid w => Semigroup (EPWriter w) where+  (EPWriter a) <> (EPWriter b) = EPWriter (a <> b)++instance Monoid w => Monoid (EPWriter w) where+  mempty = EPWriter mempty++data EPState = EPState+             { uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST+                                          -- reference frame, from+                                          -- Annotation+             , uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a+                                             -- list+             , uExtraDPReturn :: !(Maybe DeltaPos)+                  -- ^ Used to return Delta version of uExtraDP+             , pAcceptSpan :: Bool -- ^ When we have processed an+                                   -- entry of EpaDelta, accept the+                                   -- next `EpaSpan` start as the+                                   -- current output position. i.e. do+                                   -- not advance epPos. Achieved by+                                   -- setting dPriorEndPosition to the+                                   -- end of the span.++             -- Print phase+             , epPos        :: !Pos -- ^ Current output position+             , pMarkLayout  :: !Bool+             , pLHS   :: !LayoutStartCol++             -- Delta phase+             , dPriorEndPosition :: !Pos -- ^ End of Position reached+                                         -- when processing the+                                         -- preceding element+             , dMarkLayout :: !Bool+             , dLHS        :: !LayoutStartCol++             -- Shared+             , epComments :: ![Comment]+             , epCommentsApplied :: ![[Comment]]+             , epEof :: !(Maybe (RealSrcSpan, RealSrcSpan))+             }++-- ---------------------------------------------------------------------++-- AZ:TODO: this can just be a function :: (EpAnn a) -> Entry+class HasEntry ast where+  fromAnn :: ast -> Entry++class HasTrailing a where+  trailing :: a -> [TrailingAnn]+  setTrailing :: a -> [TrailingAnn] -> a++setAnchorEpa :: (HasTrailing an)+             => EpAnn an -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn an+setAnchorEpa (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing an ts)          cs++setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs+setAnchorHsModule hsmod anc cs = hsmod { hsmodExt = (hsmodExt hsmod) {hsmodAnn = an'} }+  where+    anc' = anc+    an' = setAnchorEpa (hsmodAnn $ hsmodExt hsmod) anc' [] cs++setAnchorAn :: (HasTrailing an)+             => LocatedAn an a -> Anchor -> [TrailingAnn] -> EpAnnComments -> LocatedAn an a+setAnchorAn (L (EpAnn _ an _) a) anc ts cs = (L (EpAnn anc (setTrailing an ts) cs) a)+     -- `debug` ("setAnchorAn: anc=" ++ showAst anc)++setAnchorEpaL :: EpAnn AnnList -> Anchor -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList+setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = Nothing}) ts) cs++-- ---------------------------------------------------------------------++-- | Key entry point.  Switches to an independent AST element with its+-- own annotation, calculating new offsets, etc+markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a+markAnnotated a = enterAnn (getAnnotationEntry a) a++-- | For HsModule, because we do not have a proper SrcSpan, we must+-- indicate to flush trailing comments when done.+data FlushComments = FlushComments+                   | NoFlushComments+                   deriving (Eq, Show)++-- | For GenLocated SrcSpan, we construct an entry location but cannot update it.+data CanUpdateAnchor = CanUpdateAnchor+                     | CanUpdateAnchorOnly+                     | NoCanUpdateAnchor+                   deriving (Eq, Show, Data)++data Entry = Entry Anchor [TrailingAnn] EpAnnComments FlushComments CanUpdateAnchor+           | NoEntryVal++-- | For flagging whether to capture comments in an EpaDelta or not+data CaptureComments = CaptureComments+                     | NoCaptureComments++mkEntry :: Anchor -> [TrailingAnn] -> EpAnnComments -> Entry+mkEntry anc ts cs = Entry anc ts cs NoFlushComments CanUpdateAnchor++instance (HasTrailing a) => HasEntry (EpAnn a) where+  fromAnn (EpAnn anc a cs) = mkEntry anc (trailing a) cs++-- ---------------------------------------------------------------------++instance HasTrailing NoEpAnns where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing EpaLocation where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AddEpAnn where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing [AddEpAnn] where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing (AddEpAnn, AddEpAnn) where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing EpAnnSumPat where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnList where+  trailing a = al_trailing a+  setTrailing a ts = a { al_trailing = ts }++instance HasTrailing AnnListItem where+  trailing a = lann_trailing a+  setTrailing a ts = a { lann_trailing = ts }++instance HasTrailing AnnPragma where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnContext where+  trailing (AnnContext ma _opens _closes)+    = case ma of+      Just (UnicodeSyntax, r) -> [AddDarrowUAnn r]+      Just (NormalSyntax,  r) -> [AddDarrowAnn r]+      Nothing -> []++  setTrailing a [AddDarrowUAnn r] = a {ac_darrow = Just (UnicodeSyntax, r)}+  setTrailing a [AddDarrowAnn r] = a{ac_darrow = Just (NormalSyntax, r)}+  setTrailing a [] = a{ac_darrow = Nothing}+  setTrailing a ts = error $ "Cannot setTrailing " ++ showAst ts ++ " for " ++ showAst a+++instance HasTrailing AnnParen where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnsIf where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing EpAnnHsCase where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnFieldLabel where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnProjection where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnExplicitSum where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing (Maybe EpAnnUnboundVar) where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing GrhsAnn where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnSig where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing HsRuleAnn where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing EpAnnImportDecl where+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing AnnsModule where+  -- Report none, as all are used internally+  trailing _ = []+  setTrailing a _ = a++instance HasTrailing NameAnn where+  trailing a = nann_trailing a+  setTrailing a ts = a { nann_trailing = ts }++instance HasTrailing Bool where+  trailing _ = []+  setTrailing a _ = a++-- ---------------------------------------------------------------------++fromAnn' :: (HasEntry a) => a -> Entry+fromAnn' an = case fromAnn an of+  NoEntryVal -> NoEntryVal+  Entry a ts c _ u -> Entry a ts c FlushComments u++-- ---------------------------------------------------------------------++astId :: (Typeable a) => a -> String+astId a = show (typeOf a)++cua :: (Monad m, Monoid w) => CanUpdateAnchor -> EP w m [a] -> EP w m [a]+cua CanUpdateAnchor f = f+cua CanUpdateAnchorOnly _ = return []+cua NoCanUpdateAnchor _ = return []++-- | "Enter" an annotation, by using the associated 'anchor' field as+-- the new reference point for calculating all DeltaPos positions.+-- This is the heart of the exact printing process.+--+-- This is combination of the ghc=exactprint Delta.withAST and+-- Print.exactPC functions and effectively does the delta processing+-- immediately followed by the print processing.  JIT ghc-exactprint.+enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a+enterAnn NoEntryVal a = do+  p <- getPosP+  debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a)+  r <- exact a+  debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a)+  return r+enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do+  acceptSpan <- getAcceptSpan+  setAcceptSpan False+  case anchor' of+    EpaDelta _ _ -> setAcceptSpan True+    _            -> return ()+  p <- getPosP+  pe0 <- getPriorEndD+  debugM $ "enterAnn:starting:(anchor',p,pe,a) =" ++ show (showAst anchor', p, pe0, astId a)+  prevAnchor <- getAnchorU+  let curAnchor = case anchor' of+        EpaSpan (RealSrcSpan r _) -> r+        _ -> prevAnchor+  debugM $ "enterAnn:(curAnchor):=" ++ show (rs2range curAnchor)+  case canUpdateAnchor of+    CanUpdateAnchor -> pushAppliedComments+    _ -> return ()+  case anchor' of+    EpaDelta _ dcs -> do+      debugM $ "enterAnn:Delta:Flushing comments"+      flushComments []+      debugM $ "enterAnn:Delta:Printing prior comments:" ++ showGhc (priorComments cs)+      mapM_ printOneComment (concatMap tokComment $ priorComments cs)+      debugM $ "enterAnn:Delta:Printing EpaDelta comments:" ++ showGhc dcs+      mapM_ printOneComment (concatMap tokComment dcs)+    _ -> do+      debugM $ "enterAnn:Adding comments:" ++ showGhc (priorComments cs)+      addCommentsA (priorComments cs)+  debugM $ "enterAnn:Added comments"+  printCommentsBefore curAnchor+  priorCs <- cua canUpdateAnchor takeAppliedComments -- no pop+  -- -------------------------+  case anchor' of+    EpaDelta dp _ -> do+      debugM $ "enterAnn: EpaDelta:" ++ show dp+      -- Set the original anchor as prior end, so the rest of this AST+      -- fragment has a reference+      setPriorEndNoLayoutD (ss2pos curAnchor)+    _ -> do+      if acceptSpan+        then setPriorEndNoLayoutD (ss2pos curAnchor)+        else return ()++  -- -------------------------+  if ((fst $ fst $ rs2range curAnchor) >= 0)+    then+      setAnchorU curAnchor+    else+      debugM $ "enterAnn: not calling setAnchorU for : " ++ show (rs2range curAnchor)+  -- -------------------------------------------------------------------+  -- Make sure the running dPriorEndPosition gets updated according to+  -- the change in the current anchor.++  -- Compute the distance from dPriorEndPosition to the start of the new span.++  -- While processing in the context of the prior anchor, we choose to+  -- enter a new Anchor, which has a defined position relative to the+  -- prior anchor, even if we do not actively output anything at that+  -- point.+  -- Is this edp?++  -- -------------------------------------------------------------------+  -- The first part corresponds to the delta phase, so should only use+  -- delta phase variables -----------------------------------+  -- Calculate offset required to get to the start of the SrcSPan+  !off <- getLayoutOffsetD+  let spanStart = ss2pos curAnchor+  priorEndAfterComments <- getPriorEndD+  let edp' = adjustDeltaForOffset+               -- Use the propagated offset if one is set+               -- Note that we need to use the new offset if it has+               -- changed.+               off (ss2delta priorEndAfterComments curAnchor)+  debugM $ "enterAnn: (edp',off,priorEndAfterComments,curAnchor):" ++ show (edp',off,priorEndAfterComments,rs2range curAnchor)+  let edp'' = case anchor' of+        EpaDelta dp _ -> dp+        _ -> edp'+  -- ---------------------------------------------+  med <- getExtraDP+  setExtraDP Nothing+  let (edp, medr) = case med of+        Nothing -> (edp'', Nothing)+        Just (EpaDelta dp _) -> (dp, Nothing)+                   -- Replace original with desired one. Allows all+                   -- list entry values to be DP (1,0)+        Just (EpaSpan (RealSrcSpan r _)) -> (dp, Just dp)+          where+            dp = adjustDeltaForOffset+                   off (ss2delta priorEndAfterComments r)+        Just (EpaSpan (UnhelpfulSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r+  when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ showAst (med,edp)+  when (isJust medr) $ setExtraDPReturn medr+  -- ---------------------------------------------+  -- Preparation complete, perform the action+  when (priorEndAfterComments < spanStart) (do+    debugM $ "enterAnn.dPriorEndPosition:spanStart=" ++ show spanStart+    modify (\s -> s { dPriorEndPosition    = spanStart } ))++  debugM $ "enterAnn: (anchor', curAnchor):" ++ show (anchor', rs2range curAnchor)+  -- debugM $ "enterAnn: (dLHS,spanStart,pec,edp)=" ++ show (off,spanStart,priorEndAfterComments,edp)+  p0 <- getPosP+  d <- getPriorEndD+  debugM $ "enterAnn: (posp, posd)=" ++ show (p0,d)++  -- end of delta phase processing+  -- -------------------------------------------------------------------+  -- start of print phase processing++  advance edp+  debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor')+  a' <- exact a+  debugM $ "enterAnn:exact a done:" ++ show (showAst anchor')++  -- Core recursive exactprint done, start end of Entry processing++  when (flush == FlushComments) $ do+    debugM $ "flushing comments in enterAnn:" ++ showAst (cs, getFollowingComments cs)+    flushComments (getFollowingComments cs)+    debugM $ "flushing comments in enterAnn done"++  !eof <- getEofPos+  case eof of+    Nothing -> return ()+    Just (pos, prior) -> do+       let dp = if pos == prior+             then (DifferentLine 1 0)+             else origDelta pos prior+       debugM $ "EOF:(pos,posEnd,prior,dp) =" ++ showGhc (ss2pos pos, ss2posEnd pos, ss2pos prior, dp)+       printStringAtLsDelta dp ""+       setEofPos Nothing -- Only do this once++  -- Deal with exit from the current anchor+  when (flush == NoFlushComments) $ do+    printCommentsIn curAnchor -- Make sure all comments in the span are printed++  p1 <- getPosP+  pe1 <- getPriorEndD+  debugM $ "enterAnn:done:(anchor,p,pe,a) =" ++ show (showAst anchor', p1, pe1, astId a')++  case anchor' of+    EpaDelta _ _ -> return ()+    EpaSpan (RealSrcSpan rss _) -> do+      setAcceptSpan False+      setPriorEndD (snd $ rs2range rss)+    EpaSpan _ -> return ()++  -- Outside the anchor, mark any trailing+  postCs <- cua canUpdateAnchor takeAppliedCommentsPop+  following <- if (flush == NoFlushComments)+          then do+              let (before, after) = splitAfterTrailingAnns trailing_anns+                                                           (getFollowingComments cs)+              addCommentsA before+              return after+           else return []+  !trailing' <- markTrailing trailing_anns+  -- mapM_ printOneComment (concatMap tokComment $ following)+  addCommentsA following++  -- Update original anchor, comments based on the printing process+  let newAnchor = EpaDelta edp []+  debugM $ "enterAnn:setAnnotationAnchor:(canUpdateAnchor,newAnchor,priorCs,postCs):" ++ showAst (canUpdateAnchor,newAnchor,priorCs,postCs)+  let r = case canUpdateAnchor of+            CanUpdateAnchor -> setAnnotationAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs)+            CanUpdateAnchorOnly -> setAnnotationAnchor a' newAnchor [] emptyComments+            NoCanUpdateAnchor -> a'+  return r++-- ---------------------------------------------------------------------++-- | Split the span following comments into ones that occur prior to+-- the last trailing ann, and ones after.+splitAfterTrailingAnns :: [TrailingAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])+splitAfterTrailingAnns [] cs = ([], cs)+splitAfterTrailingAnns tas cs = (before, after)+  where+    trailing_loc ta = case ta_location ta of+        EpaSpan (RealSrcSpan s _) -> [s]+        _ -> []+    (before, after) = case reverse (concatMap trailing_loc tas) of+        [] -> ([],cs)+        (s:_) -> (b,a)+          where+            s_pos = ss2pos s+            (b,a) = break (\(L ll _) -> (ss2pos $ anchor ll) > s_pos)+                          cs+++-- ---------------------------------------------------------------------++addCommentsA :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()+addCommentsA csNew = addComments False (concatMap tokComment csNew)++{-+TODO: When we addComments, some may have an anchor that is no longer+valid, as it has been moved and has an anchor_op.++Does an Anchor even make sense for a comment, perhaps it should be an+EpaLocation?++How do we sort them? do we assign a location based on when we add them+to the list, based on the current output pos?  Except the offset is a+delta compared to a reference location.  Need to nail the concept of+the reference location.++By definition it is the current anchor, so work against that. And that+also means that the first entry comment that has moved should not have+a line offset.+-}+addComments :: (Monad m, Monoid w) => Bool -> [Comment] -> EP w m ()+addComments sortNeeded csNew = do+  debugM $ "addComments:csNew" ++ show csNew+  cs <- getUnallocatedComments+  debugM $ "addComments:cs" ++ show cs+  -- We can only sort the comments if we are in the first phase,+  -- were all comments have locations. If any have EpaDelta the+  -- sort will fail, so we do not try.+  if sortNeeded && all noDelta (csNew ++ cs)+    then putUnallocatedComments (sort (cs ++ csNew))+    else putUnallocatedComments (cs ++ csNew)++noDelta :: Comment -> Bool+noDelta c = case commentLoc c of+    EpaSpan _ -> True+    _ -> False++-- ---------------------------------------------------------------------++-- | Just before we print out the EOF comments, flush the remaining+-- ones in the state.+flushComments :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()+flushComments !trailing_anns = do+  debugM $ "flushComments entered: " ++ showAst trailing_anns+  addCommentsA trailing_anns+  debugM $ "flushComments after addCommentsA"+  cs <- getUnallocatedComments+  debugM $ "flushComments: got cs"+  debugM $ "flushing comments starting: cs" ++ showAst cs+    -- AZ:TODO: is the sort still needed?+  -- mapM_ printOneComment (sortComments cs)+  mapM_ printOneComment cs+  putUnallocatedComments []+  debugM $ "flushing comments done"++-- ---------------------------------------------------------------------++-- |In order to interleave annotations into the stream, we turn them into+-- comments. They are removed from the annotation to avoid duplication.+annotationsToComments :: (Monad m, Monoid w)+  => a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a+annotationsToComments a l kws = do+  let (newComments, newAnns) = go ([],[]) (view l a)+  addComments True newComments+  return (set l (reverse newAnns) a)+  where+    keywords = Set.fromList kws++    go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])+    go acc [] = acc+    go (cs',ans) ((AddEpAnn k ss) : ls)+      | Set.member k keywords = go ((mkKWComment k (epaToNoCommentsLocation ss)):cs', ans) ls+      | otherwise             = go (cs', (AddEpAnn k ss):ans)    ls++-- ---------------------------------------------------------------------++-- Temporary function to simply reproduce the "normal" pretty printer output+withPpr :: (Monad m, Monoid w, Outputable a) => a -> EP w m a+withPpr a = do+  ss <- getAnchorU+  debugM $ "withPpr: ss=" ++ show ss+  printStringAtRs' ss (showPprUnsafe a)+  return a++-- ---------------------------------------------------------------------++-- | An AST fragment with an annotation must be able to return the+-- requirements for nesting another one, captured in an 'Entry', and+-- to be able to use the rest of the exactprint machinery to print the+-- element.  In the analogy to Outputable, 'exact' plays the role of+-- 'ppr'.+class (Typeable a) => ExactPrint a where+  getAnnotationEntry :: a -> Entry+  setAnnotationAnchor :: a -> Anchor -> [TrailingAnn] -> EpAnnComments -> a+  exact :: (Monad m, Monoid w) => a -> EP w m a++-- ---------------------------------------------------------------------+-- Start of utility functions+-- ---------------------------------------------------------------------++printSourceText :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()+printSourceText (NoSourceText) txt   =  printStringAdvance txt >> return ()+printSourceText (SourceText   txt) _ =  printStringAdvance (unpackFS txt) >> return ()++printSourceTextAA :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()+printSourceTextAA (NoSourceText) txt   = printStringAdvanceA  txt >> return ()+printSourceTextAA (SourceText   txt) _ = printStringAdvanceA  (unpackFS txt) >> return ()++-- ---------------------------------------------------------------------++printStringAtRs :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m EpaLocation+printStringAtRs pa str = printStringAtRsC CaptureComments pa str++printStringAtRsC :: (Monad m, Monoid w)+  => CaptureComments -> RealSrcSpan -> String -> EP w m EpaLocation+printStringAtRsC capture pa str = do+  debugM $ "printStringAtRsC: pa=" ++ showAst pa+  printCommentsBefore pa+  pe <- getPriorEndD+  debugM $ "printStringAtRsC:pe=" ++ show pe+  let p = ss2delta pe pa+  p' <- adjustDeltaForOffsetM p+  debugM $ "printStringAtRsC:(p,p')=" ++ show (p,p')+  printStringAtLsDelta p' str+  setPriorEndASTD pa+  cs' <- case capture of+    CaptureComments -> takeAppliedComments+    NoCaptureComments -> return []+  debugM $ "printStringAtRsC:cs'=" ++ show cs'+  debugM $ "printStringAtRsC:p'=" ++ showAst p'+  debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' NoComments)+  debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta p' (map comment2LEpaComment cs'))+  return (EpaDelta p' (map comment2LEpaComment cs'))++printStringAtRs' :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m ()+printStringAtRs' pa str = printStringAtRsC NoCaptureComments pa str >> return ()++-- ---------------------------------------------------------------------++printStringAtMLoc' :: (Monad m, Monoid w)+  => Maybe EpaLocation -> String -> EP w m (Maybe EpaLocation)+printStringAtMLoc' (Just aa) s = Just <$> printStringAtAA aa s+printStringAtMLoc' Nothing s = do+  printStringAtLsDelta (SameLine 1) s+  return (Just (EpaDelta (SameLine 1) []))++printStringAtMLocL :: (Monad m, Monoid w)+  => EpAnn a -> Lens a (Maybe EpaLocation) -> String -> EP w m (EpAnn a)+printStringAtMLocL (EpAnn anc an cs) l s = do+  r <- go (view l an) s+  return (EpAnn anc (set l r an) cs)+  where+    go (Just aa) str = Just <$> printStringAtAA aa str+    go Nothing str = do+      printStringAtLsDelta (SameLine 1) str+      return (Just (EpaDelta (SameLine 1) []))++printStringAdvanceA :: (Monad m, Monoid w) => String -> EP w m ()+printStringAdvanceA str = printStringAtAA (EpaDelta (SameLine 0) []) str >> return ()++printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation+printStringAtAA el str = printStringAtAAC CaptureComments el str++printStringAtNC :: (Monad m, Monoid w) => NoCommentsLocation -> String -> EP w m NoCommentsLocation+printStringAtNC el str = do+    el' <- printStringAtAAC NoCaptureComments (noCommentsToEpaLocation el) str+    return (epaToNoCommentsLocation el')++printStringAtAAL :: (Monad m, Monoid w)+  => a -> Lens a EpaLocation -> String -> EP w m a+printStringAtAAL an l str = do+  r <- printStringAtAAC CaptureComments (view l an) str+  return (set l r an)++printStringAtAAC :: (Monad m, Monoid w)+  => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation+printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s+printStringAtAAC _capture (EpaSpan ss@(UnhelpfulSpan _)) _s = error $ "printStringAtAAC:ss=" ++ show ss+printStringAtAAC capture (EpaDelta d cs) s = do+  mapM_ printOneComment $ concatMap tokComment cs+  pe1 <- getPriorEndD+  p1 <- getPosP+  printStringAtLsDelta d s+  p2 <- getPosP+  pe2 <- getPriorEndD+  debugM $ "printStringAtAA:(pe1,pe2,p1,p2)=" ++ show (pe1,pe2,p1,p2)+  setPriorEndASTPD (pe1,pe2)+  cs' <- case capture of+    CaptureComments -> takeAppliedComments+    NoCaptureComments -> return []+  debugM $ "printStringAtAA:(pe1,pe2,p1,p2,cs')=" ++ show (pe1,pe2,p1,p2,cs')+  return (EpaDelta d (map comment2LEpaComment cs'))++-- ---------------------------------------------------------------------++markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation+markExternalSourceTextE l NoSourceText txt   = printStringAtAA l txt+markExternalSourceTextE l (SourceText txt) _ = printStringAtAA l (unpackFS txt)++-- ---------------------------------------------------------------------++markLensMAA :: (Monad m, Monoid w)+  => EpAnn a -> Lens a (Maybe AddEpAnn) -> EP w m (EpAnn a)+markLensMAA epann l = markLensMAA' epann (lepa . l)++markLensMAA' :: (Monad m, Monoid w)+  => a -> Lens a (Maybe AddEpAnn) -> EP w m a+markLensMAA' a l =+  case view l a of+    Nothing -> return a+    Just aa -> do+      aa' <- markAddEpAnn aa+      return (set l (Just aa') a)++-- -------------------------------------++markLensAA :: (Monad m, Monoid w)+  => EpAnn a -> Lens a AddEpAnn -> EP w m (EpAnn a)+markLensAA epann l = markLensAA' epann (lepa . l)++markLensAA' :: (Monad m, Monoid w)+  => a -> Lens a AddEpAnn -> EP w m a+markLensAA' a l = do+  a' <- markKw (view l a)+  return (set l a' a)++-- -------------------------------------++markEpAnnLMS :: (Monad m, Monoid w)+  => EpAnn a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)+markEpAnnLMS epann l kw ms = markEpAnnLMS'' epann (lepa . l) kw ms++markEpAnnLMS'' :: (Monad m, Monoid w)+  => a -> Lens a [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m a+markEpAnnLMS'' an l kw Nothing = markEpAnnL an l kw+markEpAnnLMS'' a l kw (Just str) = do+  anns <- mapM go (view l a)+  return (set l anns a)+  where+    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+    go (AddEpAnn kw' r)+      | kw' == kw = do+          r' <- printStringAtAA r str+          return (AddEpAnn kw' r')+      | otherwise = return (AddEpAnn kw' r)++-- -------------------------------------++markEpAnnMS' :: (Monad m, Monoid w)+  => [AddEpAnn] -> AnnKeywordId -> Maybe String -> EP w m [AddEpAnn]+markEpAnnMS' anns kw Nothing = mark anns kw+markEpAnnMS' anns kw (Just str) = do+  mapM go anns+  where+    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+    go (AddEpAnn kw' r)+      | kw' == kw = do+          r' <- printStringAtAA r str+          return (AddEpAnn kw' r')+      | otherwise = return (AddEpAnn kw' r)++-- -------------------------------------++markEpAnnLMS' :: (Monad m, Monoid w)+  => EpAnn a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m (EpAnn a)+markEpAnnLMS' an l kw ms = markEpAnnLMS0 an (lepa . l) kw ms++markEpAnnLMS0 :: (Monad m, Monoid w)+  => a -> Lens a AddEpAnn -> AnnKeywordId -> Maybe String -> EP w m a+markEpAnnLMS0 an l _kw Nothing = markLensKwA an l+markEpAnnLMS0 a l kw (Just str) = do+  anns <- go (view l a)+  return (set l anns a)+  where+    go :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+    go (AddEpAnn kw' r)+      | kw' == kw = do+          r' <- printStringAtAA r str+          return (AddEpAnn kw' r')+      | otherwise = return (AddEpAnn kw' r)++-- ---------------------------------------------------------------------++markEpToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)+  => EpToken tok -> EP w m (EpToken tok)+markEpToken NoEpTok = return NoEpTok+markEpToken (EpTok aa) = do+  aa' <- printStringAtAA aa (symbolVal (Proxy @tok))+  return (EpTok aa')++markEpUniToken :: forall m w tok utok . (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)+  => EpUniToken tok utok -> EP w m (EpUniToken tok utok)+markEpUniToken NoEpUniTok = return NoEpUniTok+markEpUniToken (EpUniTok aa isUnicode)  = do+  aa' <- case isUnicode of+    NormalSyntax  -> printStringAtAA aa (symbolVal (Proxy @tok))+    UnicodeSyntax -> printStringAtAA aa (symbolVal (Proxy @utok))+  return (EpUniTok aa' isUnicode)++-- ---------------------------------------------------------------------++markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)+markArrow (HsUnrestrictedArrow arr) = do+  arr' <- markEpUniToken arr+  return (HsUnrestrictedArrow arr')+markArrow (HsLinearArrow (EpPct1 pct1 arr)) = do+  pct1' <- markEpToken pct1+  arr' <- markEpUniToken arr+  return (HsLinearArrow (EpPct1 pct1' arr'))+markArrow (HsLinearArrow (EpLolly arr)) = do+  arr' <- markEpToken arr+  return (HsLinearArrow (EpLolly arr'))+markArrow (HsExplicitMult (pct, arr) t) = do+  pct' <- markEpToken pct+  t' <- markAnnotated t+  arr' <- markEpUniToken arr+  return (HsExplicitMult (pct', arr') t')+++-- ---------------------------------------------------------------------++markAnnCloseP :: (Monad m, Monoid w) => EpAnn AnnPragma -> EP w m (EpAnn AnnPragma)+markAnnCloseP an = markEpAnnLMS' an lapr_close AnnClose (Just "#-}")++markAnnCloseP' :: (Monad m, Monoid w) => AnnPragma -> EP w m AnnPragma+markAnnCloseP' an = markEpAnnLMS0 an lapr_close AnnClose (Just "#-}")++markAnnOpenP :: (Monad m, Monoid w) => EpAnn AnnPragma -> SourceText -> String -> EP w m (EpAnn AnnPragma)+markAnnOpenP an NoSourceText txt   = markEpAnnLMS' an lapr_open AnnOpen (Just txt)+markAnnOpenP an (SourceText txt) _ = markEpAnnLMS' an lapr_open AnnOpen (Just $ unpackFS txt)++markAnnOpenP' :: (Monad m, Monoid w) => AnnPragma -> SourceText -> String -> EP w m AnnPragma+markAnnOpenP' an NoSourceText txt   = markEpAnnLMS0 an lapr_open AnnOpen (Just txt)+markAnnOpenP' an (SourceText txt) _ = markEpAnnLMS0 an lapr_open AnnOpen (Just $ unpackFS txt)++markAnnOpen :: (Monad m, Monoid w) => [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]+markAnnOpen an NoSourceText txt   = markEpAnnLMS'' an lidl AnnOpen (Just txt)+markAnnOpen an (SourceText txt) _ = markEpAnnLMS'' an lidl AnnOpen (Just $ unpackFS txt)++markAnnOpen' :: (Monad m, Monoid w)+  => Maybe EpaLocation -> SourceText -> String -> EP w m (Maybe EpaLocation)+markAnnOpen' ms NoSourceText txt   = printStringAtMLoc' ms txt+markAnnOpen' ms (SourceText txt) _ = printStringAtMLoc' ms $ unpackFS txt++markAnnOpen'' :: (Monad m, Monoid w)+  => EpaLocation -> SourceText -> String -> EP w m EpaLocation+markAnnOpen'' el NoSourceText txt   = printStringAtAA el txt+markAnnOpen'' el (SourceText txt) _ = printStringAtAA el $ unpackFS txt++-- ---------------------------------------------------------------------+{-+data AnnParen+  = AnnParen {+      ap_adornment :: ParenType,+      ap_open      :: EpaLocation,+      ap_close     :: EpaLocation+      } deriving (Data)+-}+markOpeningParen, markClosingParen :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen+markOpeningParen an = markParen an lfst+markClosingParen an = markParen an lsnd++markParen :: (Monad m, Monoid w) => AnnParen -> (forall a. Lens (a,a) a) -> EP w m AnnParen+markParen (AnnParen pt o c) l = do+  loc' <- markKwA (view l $ kw pt) (view l (o, c))+  let (o',c') = set l loc' (o,c)+  return (AnnParen pt o' c')+  where+    kw AnnParens       = (AnnOpenP,  AnnCloseP)+    kw AnnParensHash   = (AnnOpenPH, AnnClosePH)+    kw AnnParensSquare = (AnnOpenS, AnnCloseS)++-- ---------------------------------------------------------------------+-- Bare bones Optics+-- Base on From https://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html++type Lens    a b = forall f . Functor f => (b -> f        b) -> (a -> f        a)+type Getting a b =                         (b -> Const  b b) -> (a -> Const b  a)+type ASetter a b =                         (b -> Identity b) -> (a -> Identity a)++view :: MonadReader s m => Getting s a -> m a+view l = Reader.asks (getConst . l Const)+{-# INLINE view #-}++over :: ASetter a b -> (b -> b) -> (a -> a)+over l f = runIdentity . l (Identity . f)+{-# INLINE over #-}++set  :: Lens a b -> b -> a -> a+set lens b = over lens (\_ -> b)+{-# INLINE set #-}++{-+Question: How do I combine lenses?++Answer: You compose them, using function composition (Yes, really!)++You can think of the function composition operator as having this type:++(.) :: Lens' a b -> Lens' b c -> Lens' a c+-}++-- ---------------------------------------------------------------------+-- Lenses++-- data EpAnn ann+--   = EpAnn { entry   :: !Anchor+--            , anns     :: !ann+--            , comments :: !EpAnnComments+--            }++lepa :: Lens (EpAnn a) a+lepa k epAnn = fmap (\newAnns -> epAnn { anns = newAnns })+                    (k (anns epAnn))++-- data AnnsModule+--   = AnnsModule {+--     am_main :: [AddEpAnn],+--     am_decls :: AnnList+--     } deriving (Data, Eq)++lam_main :: Lens AnnsModule [AddEpAnn]+lam_main k annsModule = fmap (\newAnns -> annsModule { am_main = newAnns })+                             (k (am_main annsModule))++-- lam_decls :: Lens AnnsModule AnnList+-- lam_decls k annsModule = fmap (\newAnns -> annsModule { am_decls = newAnns })+--                               (k (am_decls annsModule))+++-- data EpAnnImportDecl = EpAnnImportDecl+--   { importDeclAnnImport    :: EpaLocation+--   , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation)+--   , importDeclAnnSafe      :: Maybe EpaLocation+--   , importDeclAnnQualified :: Maybe EpaLocation+--   , importDeclAnnPackage   :: Maybe EpaLocation+--   , importDeclAnnAs        :: Maybe EpaLocation+--   } deriving (Data)++limportDeclAnnImport :: Lens EpAnnImportDecl EpaLocation+limportDeclAnnImport k annImp = fmap (\new -> annImp { importDeclAnnImport = new })+                                     (k (importDeclAnnImport annImp))++-- limportDeclAnnPragma :: Lens EpAnnImportDecl (Maybe (EpaLocation, EpaLocation))+-- limportDeclAnnPragma k annImp = fmap (\new -> annImp { importDeclAnnPragma = new })+--                                      (k (importDeclAnnPragma annImp))++limportDeclAnnSafe :: Lens EpAnnImportDecl (Maybe EpaLocation)+limportDeclAnnSafe k annImp = fmap (\new -> annImp { importDeclAnnSafe = new })+                                     (k (importDeclAnnSafe annImp))++limportDeclAnnQualified :: Lens EpAnnImportDecl (Maybe EpaLocation)+limportDeclAnnQualified k annImp = fmap (\new -> annImp { importDeclAnnQualified = new })+                                     (k (importDeclAnnQualified annImp))++limportDeclAnnPackage :: Lens EpAnnImportDecl (Maybe EpaLocation)+limportDeclAnnPackage k annImp = fmap (\new -> annImp { importDeclAnnPackage = new })+                                     (k (importDeclAnnPackage annImp))++-- limportDeclAnnAs :: Lens EpAnnImportDecl (Maybe EpaLocation)+-- limportDeclAnnAs k annImp = fmap (\new -> annImp { importDeclAnnAs = new })+--                                      (k (importDeclAnnAs annImp))++-- -------------------------------------++-- data AnnList+--   = 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+--       } deriving (Data,Eq)++lal_open :: Lens AnnList (Maybe AddEpAnn)+lal_open k parent = fmap (\new -> parent { al_open = new })+                           (k (al_open parent))++lal_close :: Lens AnnList (Maybe AddEpAnn)+lal_close k parent = fmap (\new -> parent { al_close = new })+                           (k (al_close parent))++lal_rest :: Lens AnnList [AddEpAnn]+lal_rest k parent = fmap (\new -> parent { al_rest = new })+                           (k (al_rest parent))++-- lal_trailing :: Lens AnnList [TrailingAnn]+-- lal_trailing k parent = fmap (\new -> parent { al_trailing = new })+--                            (k (al_trailing parent))++-- -------------------------------------++lapr_rest :: Lens AnnPragma [AddEpAnn]+lapr_rest k parent = fmap (\newAnns -> parent { apr_rest = newAnns })+                          (k (apr_rest parent))++lapr_open :: Lens AnnPragma AddEpAnn+lapr_open k parent = fmap (\new -> parent { apr_open = new })+                          (k (apr_open parent))++lapr_close :: Lens AnnPragma AddEpAnn+lapr_close k parent = fmap (\new -> parent { apr_close = new })+                          (k (apr_close parent))++lidl :: Lens [AddEpAnn] [AddEpAnn]+lidl k parent = fmap (\new -> new)+                     (k parent)++lid :: Lens a a+lid k parent = fmap (\new -> new)+                    (k parent)++lfst :: Lens (a,a) a+lfst k parent = fmap (\new -> (new, snd parent))+                     (k (fst parent))++lsnd :: Lens (a,a) a+lsnd k parent = fmap (\new -> (fst parent, new))+                     (k (snd parent))++-- -------------------------------------+-- data AnnExplicitSum+--   = AnnExplicitSum {+--       aesOpen       :: EpaLocation,+--       aesBarsBefore :: [EpaLocation],+--       aesBarsAfter  :: [EpaLocation],+--       aesClose      :: EpaLocation+--       } deriving Data++laesOpen :: Lens AnnExplicitSum EpaLocation+laesOpen k parent = fmap (\new -> parent { aesOpen = new })+                         (k (aesOpen parent))++laesBarsBefore :: Lens AnnExplicitSum [EpaLocation]+laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })+                               (k (aesBarsBefore parent))++laesBarsAfter :: Lens AnnExplicitSum [EpaLocation]+laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })+                               (k (aesBarsAfter parent))++laesClose :: Lens AnnExplicitSum EpaLocation+laesClose k parent = fmap (\new -> parent { aesClose = new })+                               (k (aesClose parent))++-- -------------------------------------+-- data AnnFieldLabel+--   = AnnFieldLabel {+--       afDot :: Maybe EpaLocation+--       } deriving Data++lafDot :: Lens AnnFieldLabel (Maybe EpaLocation)+lafDot k parent = fmap (\new -> parent { afDot = new })+                         (k (afDot parent))++-- -------------------------------------+-- data AnnProjection+--   = AnnProjection {+--       apOpen  :: EpaLocation, -- ^ '('+--       apClose :: EpaLocation  -- ^ ')'+--       } deriving Data++lapOpen :: Lens AnnProjection EpaLocation+lapOpen k parent = fmap (\new -> parent { apOpen = new })+                         (k (apOpen parent))++lapClose :: Lens AnnProjection EpaLocation+lapClose k parent = fmap (\new -> parent { apClose = new })+                         (k (apClose parent))++-- -------------------------------------+-- data AnnsIf+--   = AnnsIf {+--       aiIf       :: EpaLocation,+--       aiThen     :: EpaLocation,+--       aiElse     :: EpaLocation,+--       aiThenSemi :: Maybe EpaLocation,+--       aiElseSemi :: Maybe EpaLocation+--       } deriving Data++laiIf :: Lens AnnsIf EpaLocation+laiIf k parent = fmap (\new -> parent { aiIf = new })+                      (k (aiIf parent))++laiThen :: Lens AnnsIf EpaLocation+laiThen k parent = fmap (\new -> parent { aiThen = new })+                        (k (aiThen parent))++laiElse :: Lens AnnsIf EpaLocation+laiElse k parent = fmap (\new -> parent { aiElse = new })+                        (k (aiElse parent))++laiThenSemi :: Lens AnnsIf (Maybe EpaLocation)+laiThenSemi k parent = fmap (\new -> parent { aiThenSemi = new })+                            (k (aiThenSemi parent))++laiElseSemi :: Lens AnnsIf (Maybe EpaLocation)+laiElseSemi k parent = fmap (\new -> parent { aiElseSemi = new })+                            (k (aiElseSemi parent))++-- -------------------------------------++-- data AnnParen+--   = AnnParen {+--       ap_adornment :: ParenType,+--       ap_open      :: EpaLocation,+--       ap_close     :: EpaLocation+--       } deriving (Data)++-- lap_open :: Lens AnnParen EpaLocation+-- lap_open k parent = fmap (\new -> parent { ap_open = new })+--                          (k (ap_open parent))++-- lap_close :: Lens AnnParen EpaLocation+-- lap_close k parent = fmap (\new -> parent { ap_close = new })+--                           (k (ap_close parent))++-- -------------------------------------+-- data EpAnnHsCase = EpAnnHsCase+--       { hsCaseAnnCase :: EpaLocation+--       , hsCaseAnnOf   :: EpaLocation+--       , hsCaseAnnsRest :: [AddEpAnn]+--       } deriving Data++lhsCaseAnnCase :: Lens EpAnnHsCase EpaLocation+lhsCaseAnnCase k parent = fmap (\new -> parent { hsCaseAnnCase = new })+                               (k (hsCaseAnnCase parent))++lhsCaseAnnOf :: Lens EpAnnHsCase EpaLocation+lhsCaseAnnOf k parent = fmap (\new -> parent { hsCaseAnnOf = new })+                               (k (hsCaseAnnOf parent))++lhsCaseAnnsRest :: Lens EpAnnHsCase [AddEpAnn]+lhsCaseAnnsRest k parent = fmap (\new -> parent { hsCaseAnnsRest = new })+                                (k (hsCaseAnnsRest parent))++-- ---------------------------------------------------------------------++-- 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]+--        } deriving (Data, Eq)++lra_tyanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))+lra_tyanns k parent = fmap (\new -> parent { ra_tyanns = new })+                               (k (ra_tyanns parent))++ff :: Maybe (a,b) -> (Maybe a,Maybe b)+ff Nothing = (Nothing, Nothing)+ff (Just (a,b)) = (Just a, Just b)+++gg :: (Maybe a,Maybe b) -> Maybe (a,b)+gg (Nothing, Nothing) = Nothing+gg (Just a, Just b) = Just (a,b)+gg _ = error "gg:expecting two Nothing or two Just"++lff :: Lens (Maybe (a,b)) (Maybe a,Maybe b)+lff k parent = fmap (\new -> gg new)+                    (k (ff parent))++-- (.) :: Lens' a b -> Lens' b c -> Lens' a c+lra_tyanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tyanns_fst = lra_tyanns . lff . lfst++lra_tyanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tyanns_snd = lra_tyanns . lff . lsnd++lra_tmanns :: Lens HsRuleAnn (Maybe (AddEpAnn, AddEpAnn))+lra_tmanns k parent = fmap (\new -> parent { ra_tmanns = new })+                               (k (ra_tmanns parent))++lra_tmanns_fst :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tmanns_fst = lra_tmanns . lff . lfst++lra_tmanns_snd :: Lens HsRuleAnn (Maybe AddEpAnn)+lra_tmanns_snd = lra_tmanns . lff . lsnd++lra_rest :: Lens HsRuleAnn [AddEpAnn]+lra_rest k parent = fmap (\new -> parent { ra_rest = new })+                                (k (ra_rest parent))+++-- ---------------------------------------------------------------------+-- data GrhsAnn+--   = GrhsAnn {+--       ga_vbar :: Maybe EpaLocation, -- TODO:AZ do we need this?+--       ga_sep  :: AddEpAnn -- ^ Match separator location+--       } deriving (Data)++lga_vbar :: Lens GrhsAnn (Maybe EpaLocation)+lga_vbar k parent = fmap (\new -> parent { ga_vbar = new })+                                (k (ga_vbar parent))++lga_sep :: Lens GrhsAnn AddEpAnn+lga_sep k parent = fmap (\new -> parent { ga_sep = new })+                                (k (ga_sep parent))++-- ---------------------------------------------------------------------+-- data AnnSig+--   = AnnSig {+--       asDcolon :: AddEpAnn, -- Not an EpaAnchor to capture unicode option+--       asRest   :: [AddEpAnn]+--       } deriving Data++lasDcolon :: Lens AnnSig AddEpAnn+lasDcolon k parent = fmap (\new -> parent { asDcolon = new })+                                (k (asDcolon parent))++lasRest :: Lens AnnSig [AddEpAnn]+lasRest k parent = fmap (\new -> parent { asRest = new })+                                (k (asRest parent))++-- ---------------------------------------------------------------------+-- data EpAnnSumPat = EpAnnSumPat+--       { sumPatParens      :: [AddEpAnn]+--       , sumPatVbarsBefore :: [EpaLocation]+--       , sumPatVbarsAfter  :: [EpaLocation]+--       } deriving Data++lsumPatParens :: Lens EpAnnSumPat [AddEpAnn]+lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })+                              (k (sumPatParens parent))++lsumPatVbarsBefore :: Lens EpAnnSumPat [EpaLocation]+lsumPatVbarsBefore k parent = fmap (\new -> parent { sumPatVbarsBefore = new })+                              (k (sumPatVbarsBefore parent))++lsumPatVbarsAfter :: Lens EpAnnSumPat [EpaLocation]+lsumPatVbarsAfter k parent = fmap (\new -> parent { sumPatVbarsAfter = new })+                              (k (sumPatVbarsAfter parent))++-- End of lenses+-- ---------------------------------------------------------------------++markLensKwA :: (Monad m, Monoid w)+  => a -> Lens a AddEpAnn -> EP w m a+markLensKwA a l = do+  loc <- markKw (view l a)+  return (set l loc a)++markLensKw' :: (Monad m, Monoid w)+  => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)+markLensKw' (EpAnn anc a cs) l kw = do+  loc <- markKwA kw (view l a)+  return (EpAnn anc (set l loc a) cs)++markLensKw :: (Monad m, Monoid w)+  => a -> Lens a EpaLocation -> AnnKeywordId -> EP w m a+markLensKw a l kw = do+  loc <- markKwA kw (view l a)+  return (set l loc a)++markAnnKwAllL :: (Monad m, Monoid w)+  => a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m a+markAnnKwAllL a l kw = do+  anns <- mapM (markKwA kw) (view l a)+  return (set l anns a)++markLensKwM :: (Monad m, Monoid w)+  => EpAnn a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m (EpAnn a)+markLensKwM (EpAnn anc a cs) l kw = do+  new <- go (view l a)+  return (EpAnn anc (set l new a) cs)+  where+    go Nothing = return Nothing+    go (Just s) = Just <$> markKwA kw s++markLensKwM' :: (Monad m, Monoid w)+  => a -> Lens a (Maybe EpaLocation) -> AnnKeywordId -> EP w m a+markLensKwM' a l kw = do+  new <- go (view l a)+  return (set l new a)+  where+    go Nothing = return Nothing+    go (Just s) = Just <$> markKwA kw s++-- ---------------------------------------------------------------------++markEpAnnL' :: (Monad m, Monoid w)+  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)+markEpAnnL' epann l kw = markEpAnnL epann (lepa . l) kw++markEpAnnL :: (Monad m, Monoid w)+  => ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann+markEpAnnL a l kw = do+  anns <- mark (view l a) kw+  return (set l anns a)++-- -------------------------------------++markEpAnnAllL :: (Monad m, Monoid w)+  => EpAnn ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m (EpAnn ann)+markEpAnnAllL (EpAnn anc a cs) l kw = do+  anns <- mapM doit (view l a)+  return (EpAnn anc (set l anns a) cs)+  where+    doit an@(AddEpAnn ka _)+      = if ka == kw+          then markKw an+          else return an++markEpAnnAllL' :: (Monad m, Monoid w)+  => ann -> Lens ann [AddEpAnn] -> AnnKeywordId -> EP w m ann+markEpAnnAllL' a l kw = do+  anns <- mapM doit (view l a)+  return (set l anns a)+  where+    doit an@(AddEpAnn ka _)+      = if ka == kw+          then markKw an+          else return an++markAddEpAnn :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+markAddEpAnn a@(AddEpAnn kw _) = do+  r <- mark [a] kw+  case r of+    [a'] -> return a'+    _ -> error "Should not happen: markAddEpAnn"++mark :: (Monad m, Monoid w) => [AddEpAnn] -> AnnKeywordId -> EP w m [AddEpAnn]+mark anns kw = do+  case find' kw anns of+    (lead, Just aa, end) -> do+      aa' <- markKw aa+      return (lead ++ [aa'] ++ end)+    (_lead, Nothing, _end) -> case find' (unicodeAnn kw) anns of+      (leadu, Just aau, endu) -> do+        aau' <- markKw aau+        return (leadu ++ [aau'] ++ endu)+      (_,Nothing,_) -> return anns++-- | Find for update, returning lead section of the list, item if+-- found, and tail of the list+find' :: AnnKeywordId -> [AddEpAnn] -> ([AddEpAnn], Maybe AddEpAnn, [AddEpAnn])+find' kw anns = (lead, middle, end)+  where+    (lead, rest) = break (\(AddEpAnn k _) -> k == kw) anns+    (middle,end) = case rest of+      [] -> (Nothing, [])+      (x:xs) -> (Just x, xs)++markKw :: (Monad m, Monoid w) => AddEpAnn -> EP w m AddEpAnn+markKw an = markKwC CaptureComments an++markKwC :: (Monad m, Monoid w) => CaptureComments -> AddEpAnn -> EP w m AddEpAnn+markKwC capture (AddEpAnn kw ss) = do+  ss' <- markKwAC capture kw ss+  return (AddEpAnn kw ss')++-- | This should be the main driver of the process, managing printing keywords.+-- It returns the 'EpaDelta' variant of the passed in 'EpaLocation'+markKwA :: (Monad m, Monoid w) => AnnKeywordId -> EpaLocation -> EP w m EpaLocation+markKwA kw aa = markKwAC CaptureComments kw aa++markKwAC :: (Monad m, Monoid w)+  => CaptureComments -> AnnKeywordId -> EpaLocation -> EP w m EpaLocation+markKwAC capture kw aa = printStringAtAAC capture aa (keywordToString kw)++-- | Print a keyword encoded in a 'TrailingAnn'+markKwT :: (Monad m, Monoid w) => TrailingAnn -> EP w m TrailingAnn+markKwT (AddSemiAnn ss)    = AddSemiAnn    <$> markKwA AnnSemi ss+markKwT (AddCommaAnn ss)   = AddCommaAnn   <$> markKwA AnnComma ss+markKwT (AddVbarAnn ss)    = AddVbarAnn    <$> markKwA AnnVbar ss+markKwT (AddDarrowAnn ss)  = AddDarrowAnn  <$> markKwA AnnDarrow ss+markKwT (AddDarrowUAnn ss) = AddDarrowUAnn <$> markKwA AnnDarrowU ss++-- ---------------------------------------------------------------------++markAnnList :: (Monad m, Monoid w)+  => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)+markAnnList ann action = do+  markAnnListA ann $ \a -> do+    r <- action+    return (a,r)++markAnnList' :: (Monad m, Monoid w)+  => AnnList -> EP w m a -> EP w m (AnnList, a)+markAnnList' ann action = do+  markAnnListA' ann $ \a -> do+    r <- action+    return (a,r)++markAnnListA :: (Monad m, Monoid w)+  => EpAnn AnnList+  -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))+  -> EP w m (EpAnn AnnList, a)+markAnnListA an action = do+  an0 <- markLensMAA an lal_open+  an1 <- markEpAnnAllL an0 lal_rest AnnSemi+  (an2, r) <- action an1+  an3 <- markLensMAA an2 lal_close+  return (an3, r)++markAnnListA' :: (Monad m, Monoid w)+  => AnnList+  -> (AnnList -> EP w m (AnnList, a))+  -> EP w m (AnnList, a)+markAnnListA' an action = do+  an0 <- markLensMAA' an lal_open+  an1 <- markEpAnnAllL' an0 lal_rest AnnSemi+  (an2, r) <- action an1+  an3 <- markLensMAA' an2 lal_close+  return (an3, r)++-- ---------------------------------------------------------------------++printCommentsBefore :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()+printCommentsBefore ss = do+  cs <- commentAllocationBefore ss+  debugM $ "printCommentsBefore: (ss): " ++ showPprUnsafe (rs2range ss)+  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentLoc cs)+  mapM_ printOneComment cs++printCommentsIn :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()+printCommentsIn ss = do+  cs <- commentAllocationIn ss+  debugM $ "printCommentsIn: (ss): " ++ showPprUnsafe (rs2range ss)+  -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentLoc cs)+  mapM_ printOneComment cs+  debugM $ "printCommentsIn:done"++-- ---------------------------------------------------------------------++printOneComment :: (Monad m, Monoid w) => Comment -> EP w m ()+printOneComment c@(Comment _str loc _r _mo) = do+  debugM $ "printOneComment:c=" ++ showGhc c+  dp <-case loc of+    EpaDelta dp _ -> return dp+    EpaSpan (RealSrcSpan r _) -> do+        pe <- getPriorEndD+        debugM $ "printOneComment:pe=" ++ showGhc pe+        let dp = ss2delta pe r+        debugM $ "printOneComment:(dp,pe,loc)=" ++ showGhc (dp,pe,loc)+        adjustDeltaForOffsetM dp+    EpaSpan (UnhelpfulSpan _) -> return (SameLine 0)+  mep <- getExtraDP+  dp' <- case mep of+    Just (EpaDelta edp _) -> do+      debugM $ "printOneComment:edp=" ++ show edp+      adjustDeltaForOffsetM edp+    _ -> return dp+  -- Start of debug printing+  LayoutStartCol dOff <- getLayoutOffsetD+  debugM $ "printOneComment:(dp,dp',dOff,loc)=" ++ showGhc (dp,dp',dOff,loc)+  -- End of debug printing+  updateAndApplyComment c dp'+  printQueuedComment c dp'++updateAndApplyComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()+updateAndApplyComment (Comment str anc pp mo) dp = do+  applyComment (Comment str anc' pp mo)+  where+    (r,c) = ss2posEnd pp+    dp'' = case anc of+      EpaDelta dp1 _ -> dp1+      EpaSpan (RealSrcSpan la _) ->+           if r == 0+             then (ss2delta (r,c+0) la)+             else (ss2delta (r,c)   la)+      EpaSpan (UnhelpfulSpan _) -> SameLine 0+    dp' = case anc of+      EpaSpan (RealSrcSpan r1 _) ->+          if pp == r1+                 then dp+                 else dp''+      _ -> dp''+    op' = case dp' of+            SameLine n -> if n >= 0+                            then EpaDelta dp' NoComments+                            else EpaDelta dp NoComments+            _ -> EpaDelta dp' NoComments+    anc' = if str == "" && op' == EpaDelta (SameLine 0) NoComments -- EOF comment+           then EpaDelta dp NoComments+           else EpaDelta dp NoComments++-- ---------------------------------------------------------------------++commentAllocationBefore :: (Monad m, Monoid w) => RealSrcSpan -> EP w m [Comment]+commentAllocationBefore ss = do+  cs <- getUnallocatedComments+  -- Note: The CPP comment injection may change the file name in the+  -- RealSrcSpan, which affects comparison, as the Ord instance for+  -- RealSrcSpan compares the file first. So we sort via ss2pos+  -- TODO: this is inefficient, use Pos all the way through+  let (earlier,later) = partition (\(Comment _str loc _r _mo) ->+                                     case loc of+                                       EpaSpan (RealSrcSpan r _) -> (ss2pos r) <= (ss2pos ss)+                                       _ -> True -- Choose one+                                  ) cs+  putUnallocatedComments later+  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)+  return earlier++commentAllocationIn :: (Monad m, Monoid w) => RealSrcSpan -> EP w m [Comment]+commentAllocationIn ss = do+  cs <- getUnallocatedComments+  -- Note: The CPP comment injection may change the file name in the+  -- RealSrcSpan, which affects comparison, as the Ord instance for+  -- RealSrcSpan compares the file first. So we sort via ss2pos+  -- TODO: this is inefficient, use Pos all the way through+  let (earlier,later) = partition (\(Comment _str loc _r _mo) ->+                                     case loc of+                                       EpaSpan (RealSrcSpan r _) -> (ss2posEnd r) <= (ss2posEnd ss)+                                       _ -> True -- Choose one+                                  ) cs+  putUnallocatedComments later+  -- debugM $ "commentAllocation:(ss,earlier,later)" ++ show (rs2range ss,earlier,later)+  return earlier+-- ---------------------------------------------------------------------++markAnnotatedWithLayout :: (Monad m, Monoid w) => ExactPrint ast => ast -> EP w m ast+markAnnotatedWithLayout a = setLayoutBoth $ markAnnotated a++-- ---------------------------------------------------------------------++markTopLevelList :: (Monad m, Monoid w) => ExactPrint ast => [ast] -> EP w m [ast]+markTopLevelList ls = mapM (\a -> setLayoutTopLevelP $ markAnnotated a) ls++-- ---------------------------------------------------------------------+-- End of utility functions+-- ---------------------------------------------------------------------+-- Start of ExactPrint instances+-- ---------------------------------------------------------------------++-- | Bare Located elements are simply stripped off without further+-- processing.+instance (ExactPrint a) => ExactPrint (Located a) where+  getAnnotationEntry (L l _) = case l of+    UnhelpfulSpan _ -> NoEntryVal+    _ -> Entry (EpaSpan l) [] emptyComments NoFlushComments CanUpdateAnchorOnly++  setAnnotationAnchor (L l a) _anc _ts _cs = L l a++  exact (L l a) = L l <$> markAnnotated a++instance (ExactPrint a) => ExactPrint (LocatedE a) where+  getAnnotationEntry (L l _) = Entry l [] emptyComments NoFlushComments CanUpdateAnchorOnly+  setAnnotationAnchor (L _ a) anc _ts _cs = L anc a++  exact (L la a) = do+    debugM $ "LocatedE a:la loc=" ++ show (ss2range $ locA la)+    a' <- markAnnotated a+    return (L la a')++instance (ExactPrint a) => ExactPrint (LocatedA a) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor la anc ts cs = setAnchorAn la anc ts cs+  exact (L la a) = do+    debugM $ "LocatedA a:la loc=" ++ show (ss2range $ locA la)+    a' <- markAnnotated a+    return (L la a')++instance (ExactPrint a) => ExactPrint (LocatedAn NoEpAnns a) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor la anc ts cs = setAnchorAn la anc ts cs+  exact (L la a) = do+    a' <- markAnnotated a+    return (L la a')++instance (ExactPrint a) => ExactPrint [a] where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor ls _ _ _ = ls+  exact ls = mapM markAnnotated ls++instance (ExactPrint a) => ExactPrint (Maybe a) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor ma _ _ _ = ma+  exact ma = mapM markAnnotated ma++-- ---------------------------------------------------------------------++-- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource'+instance ExactPrint (HsModule GhcPs) where+  getAnnotationEntry hsmod = fromAnn' (hsmodAnn $ hsmodExt hsmod)+  -- A bit pointless actually changing anything here+  setAnnotationAnchor hsmod anc _ts cs = setAnchorHsModule hsmod anc cs+                   `debug` ("setAnnotationAnchor hsmod called" ++ showAst (anc,cs))++  exact (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) = do++    let mbDoc' = mbDoc++    (an0, mmn' , mdeprec', mexports') <-+      case mmn of+        Nothing -> return (an, mmn, mdeprec, mexports)+        Just m -> do+          an0 <- markEpAnnL' an lam_main AnnModule+          m' <- markAnnotated m++          mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec++          mexports' <- setLayoutTopLevelP $ markAnnotated mexports++          an1 <- setLayoutTopLevelP $ markEpAnnL' an0 lam_main AnnWhere++          return (an1, Just m', mdeprec', mexports')++    lo0 <- case lo of+        EpExplicitBraces open close -> do+          open' <- markEpToken open+          return (EpExplicitBraces open' close)+        _ -> return lo++    am_decls' <- markTrailing (am_decls $ anns an0)++    mid <- markAnnotated (HsModuleImpDecls (am_cs $ anns an0) imports decls)+    let imports' = id_imps mid+    let decls' = id_decls mid++    lo1 <- case lo0 of+        EpExplicitBraces open close -> do+          close' <- markEpToken close+          return (EpExplicitBraces open close')+        _ -> return lo++    -- Print EOF+    case am_eof $ anns an of+      Nothing -> return ()+      Just (pos, prior) -> do+        debugM $ "am_eof:" ++ showGhc (pos, prior)+        setEofPos (Just (pos, prior))++    let anf = an0 { anns = (anns an0) { am_decls = am_decls', am_cs = [] }}+    debugM $ "HsModule, anf=" ++ showAst anf++    return (HsModule (XModulePs anf lo1 mdeprec' mbDoc') mmn' mexports' imports' decls')++-- ---------------------------------------------------------------------++-- | This is used to ensure the comments are updated into the right+-- place for makeDeltaAst.+data HsModuleImpDecls+    = HsModuleImpDecls {+        id_cs     :: [LEpaComment],+        id_imps   :: [LImportDecl GhcPs],+        id_decls  :: [LHsDecl GhcPs]+    } deriving Data++instance ExactPrint HsModuleImpDecls where+  -- Use an UnHelpfulSpan for the anchor, we are only interested in the comments+  getAnnotationEntry mid = mkEntry (EpaSpan (UnhelpfulSpan UnhelpfulNoLocationInfo)) [] (EpaComments (id_cs mid))+  setAnnotationAnchor mid _anc _ cs = mid { id_cs = priorComments cs ++ getFollowingComments cs }+     `debug` ("HsModuleImpDecls.setAnnotationAnchor:cs=" ++ showAst cs)+  exact (HsModuleImpDecls cs imports decls) = do+    imports' <- markTopLevelList imports+    decls' <- markTopLevelList (filter notDocDecl decls)+    return (HsModuleImpDecls cs imports' decls')+++-- ---------------------------------------------------------------------++instance ExactPrint ModuleName where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor n _anc _ cs = n+     `debug` ("ModuleName.setAnnotationAnchor:cs=" ++ showAst cs)+  exact n = do+    debugM $ "ModuleName: " ++ showPprUnsafe n+    withPpr n++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedP (WarningTxt GhcPs)) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  exact (L an (WarningTxt mb_cat src ws)) = do+    an0 <- markAnnOpenP an src "{-# WARNING"+    mb_cat' <- markAnnotated mb_cat+    an1 <- markEpAnnL' an0 lapr_rest AnnOpenS+    ws' <- markAnnotated ws+    an2 <- markEpAnnL' an1 lapr_rest AnnCloseS+    an3 <- markAnnCloseP an2+    return (L an3 (WarningTxt mb_cat' src ws'))++  exact (L an (DeprecatedTxt src ws)) = do+    an0 <- markAnnOpenP an src "{-# DEPRECATED"+    an1 <- markEpAnnL' an0 lapr_rest AnnOpenS+    ws' <- markAnnotated ws+    an2 <- markEpAnnL' an1 lapr_rest AnnCloseS+    an3 <- markAnnCloseP an2+    return (L an3 (DeprecatedTxt src ws'))++instance ExactPrint InWarningCategory where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (InWarningCategory tkIn source (L l wc)) = do+      tkIn' <- markEpToken tkIn+      L l' (_,wc') <- markAnnotated (L l (source, wc))+      return (InWarningCategory tkIn' source (L l' wc'))++instance ExactPrint (SourceText, WarningCategory) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (st, WarningCategory wc) = do+      case st of+          NoSourceText -> printStringAdvance $ "\"" ++ (unpackFS wc) ++ "\""+          SourceText src -> printStringAdvance $ (unpackFS src)+      return (st, WarningCategory wc)++-- ---------------------------------------------------------------------++instance ExactPrint (ImportDecl GhcPs) where+  getAnnotationEntry idecl = fromAnn (ideclAnn $ ideclExt idecl)+  setAnnotationAnchor idecl anc ts cs = idecl { ideclExt+                    = (ideclExt idecl) { ideclAnn = setAnchorEpa (ideclAnn $ ideclExt idecl) anc ts cs} }++  exact (ImportDecl (XImportDeclPass ann msrc impl)+                     modname mpkg src safeflag qualFlag mAs hiding) = do++    ann0 <- markLensKw' ann limportDeclAnnImport AnnImport+    let (EpAnn _anc an _cs) = ann0++    -- "{-# SOURCE" and "#-}"+    importDeclAnnPragma' <-+      case msrc of+        SourceText _txt -> do+          debugM $ "ImportDecl sourcetext"+          case importDeclAnnPragma an of+            Just (mo, mc) -> do+              mo' <- markAnnOpen'' mo msrc "{-# SOURCE"+              mc' <- printStringAtAA mc "#-}"+              return $ Just (mo', mc')+            Nothing ->  do+              _ <- markAnnOpen' Nothing msrc "{-# SOURCE"+              printStringAtLsDelta (SameLine 1) "#-}"+              return Nothing+        NoSourceText -> return (importDeclAnnPragma an)+    ann1 <- if safeflag+      then (markLensKwM ann0 limportDeclAnnSafe AnnSafe)+      else return ann0+    ann2 <-+      case qualFlag of+        QualifiedPre  -- 'qualified' appears in prepositive position.+          -> printStringAtMLocL ann1 limportDeclAnnQualified "qualified"+        _ -> return ann1+    ann3 <-+      case mpkg of+       RawPkgQual (StringLiteral src' v _) ->+         printStringAtMLocL ann2 limportDeclAnnPackage (sourceTextToString src' (show v))+       _ -> return ann2+    modname' <- markAnnotated modname++    ann4 <-+      case qualFlag of+        QualifiedPost  -- 'qualified' appears in postpositive position.+          -> printStringAtMLocL ann3 limportDeclAnnQualified "qualified"+        _ -> return ann3++    (importDeclAnnAs', mAs') <-+      case mAs of+        Nothing -> return (importDeclAnnAs an, Nothing)+        Just m0 -> do+          a <- printStringAtMLoc' (importDeclAnnAs an) "as"+          m'' <- markAnnotated m0+          return (a, Just m'')++    hiding' <-+      case hiding of+        Nothing -> return hiding+        Just (isHiding,lie) -> do+          lie' <- markAnnotated lie+          return (Just (isHiding, lie'))++    let (EpAnn anc' an' cs') = ann4+    let an2 = an' { importDeclAnnAs = importDeclAnnAs'+                  , importDeclAnnPragma = importDeclAnnPragma'+                  }++    return (ImportDecl (XImportDeclPass (EpAnn anc' an2 cs') msrc impl)+                     modname' mpkg src safeflag qualFlag mAs' hiding')+++-- ---------------------------------------------------------------------++instance ExactPrint HsDocString where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (MultiLineDocString decorator (x :| xs)) = do+    printStringAdvance ("-- " ++ printDecorator decorator)+    pe <- getPriorEndD+    debugM $ "MultiLineDocString: (pe,x)=" ++ showAst (pe,x)+    x' <- markAnnotated x+    xs' <- markAnnotated (map dedentDocChunk xs)+    return (MultiLineDocString decorator (x' :| xs'))+  exact x = do+    -- TODO: can this happen?+    debugM $ "Not exact printing:" ++ showAst x+    return x+++instance ExactPrint HsDocStringChunk where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact chunk = do+    printStringAdvance ("--" ++ unpackHDSC chunk)+    return chunk+++instance ExactPrint a => ExactPrint (WithHsDocIdentifiers a GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (WithHsDocIdentifiers ds ids) = do+    ds' <- exact ds+    return (WithHsDocIdentifiers ds' ids)++-- ---------------------------------------------------------------------++instance ExactPrint (HsDecl GhcPs) where+  getAnnotationEntry (TyClD      _ _) = NoEntryVal+  getAnnotationEntry (InstD      _ _) = NoEntryVal+  getAnnotationEntry (DerivD     _ _) = NoEntryVal+  getAnnotationEntry (ValD       _ _) = NoEntryVal+  getAnnotationEntry (SigD       _ _) = NoEntryVal+  getAnnotationEntry (KindSigD   _ _) = NoEntryVal+  getAnnotationEntry (DefD       _ _) = NoEntryVal+  getAnnotationEntry (ForD       _ _) = NoEntryVal+  getAnnotationEntry (WarningD   _ _) = NoEntryVal+  getAnnotationEntry (AnnD       _ _) = NoEntryVal+  getAnnotationEntry (RuleD      _ _) = NoEntryVal+  getAnnotationEntry (SpliceD    _ _) = NoEntryVal+  getAnnotationEntry (DocD       _ _) = NoEntryVal+  getAnnotationEntry (RoleAnnotD _ _) = NoEntryVal++  -- We do not recurse, the generic traversal using this feature+  -- should do that for us.+  setAnnotationAnchor d _ _ _ = d++  exact (TyClD       x d) = TyClD       x <$> markAnnotated d+  exact (InstD       x d) = InstD       x <$> markAnnotated d+  exact (DerivD      x d) = DerivD      x <$> markAnnotated d+  exact (ValD        x d) = ValD        x <$> markAnnotated d+  exact (SigD        x d) = SigD        x <$> markAnnotated d+  exact (KindSigD    x d) = KindSigD    x <$> markAnnotated d+  exact (DefD        x d) = DefD        x <$> markAnnotated d+  exact (ForD        x d) = ForD        x <$> markAnnotated d+  exact (WarningD    x d) = WarningD    x <$> markAnnotated d+  exact (AnnD        x d) = AnnD        x <$> markAnnotated d+  exact (RuleD       x d) = RuleD       x <$> markAnnotated d+  exact (SpliceD     x d) = SpliceD     x <$> markAnnotated d+  exact (DocD        x d) = DocD        x <$> markAnnotated d+  exact (RoleAnnotD  x d) = RoleAnnotD  x <$> markAnnotated d++-- ---------------------------------------------------------------------++instance ExactPrint (InstDecl GhcPs) where+  getAnnotationEntry (ClsInstD     _ _) = NoEntryVal+  getAnnotationEntry (DataFamInstD _ _) = NoEntryVal+  getAnnotationEntry (TyFamInstD   _ _) = NoEntryVal++  setAnnotationAnchor d _ _ _ = d+++  exact (ClsInstD     a  cid) = do+    cid' <- markAnnotated cid+    return (ClsInstD     a  cid')+  exact (DataFamInstD a decl) = do+    d' <- markAnnotated (DataFamInstDeclWithContext noAnn TopLevel decl)+    return (DataFamInstD a (dc_d d'))+  exact (TyFamInstD a eqn) = do+    eqn' <- markAnnotated eqn+    return (TyFamInstD a eqn')++-- ---------------------------------------------------------------------++data DataFamInstDeclWithContext+  = DataFamInstDeclWithContext+    { _dc_a :: [AddEpAnn]+    , _dc_f :: TopLevelFlag+    , dc_d :: DataFamInstDecl GhcPs+    }++instance ExactPrint DataFamInstDeclWithContext where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (DataFamInstDeclWithContext an c d) = do+    debugM $ "starting DataFamInstDeclWithContext:an=" ++ showAst an+    (an', d') <- exactDataFamInstDecl an c d+    return (DataFamInstDeclWithContext an' c d')++-- ---------------------------------------------------------------------++exactDataFamInstDecl :: (Monad m, Monoid w)+                     => [AddEpAnn] -> TopLevelFlag -> DataFamInstDecl GhcPs+                     -> EP w m ([AddEpAnn], DataFamInstDecl GhcPs)+exactDataFamInstDecl an top_lvl+  (DataFamInstDecl (FamEqn { feqn_ext    = an2+                           , feqn_tycon  = tycon+                           , feqn_bndrs  = bndrs+                           , feqn_pats   = pats+                           , feqn_fixity = fixity+                           , feqn_rhs    = defn })) = do+    (an', an2', tycon', bndrs', pats',  defn') <- exactDataDefn an2 pp_hdr defn+                                          -- See Note [an and an2 in exactDataFamInstDecl]+    return+      (an',+       DataFamInstDecl ( FamEqn { feqn_ext    = an2'+                                , feqn_tycon  = tycon'+                                , feqn_bndrs  = bndrs'+                                , feqn_pats   = pats'+                                , feqn_fixity = fixity+                                , feqn_rhs    = defn' }))+                    `debug` ("exactDataFamInstDecl: defn' derivs:" ++ showAst (dd_derivs defn'))+  where+    pp_hdr :: (Monad m, Monoid w)+           => Maybe (LHsContext GhcPs)+           -> EP w m ( [AddEpAnn]+                     , LocatedN RdrName+                     , HsOuterTyVarBndrs () GhcPs+                     , HsFamEqnPats GhcPs+                     , Maybe (LHsContext GhcPs))+    pp_hdr mctxt = do+      an0 <- case top_lvl of+               TopLevel -> markEpAnnL an lidl AnnInstance -- TODO: maybe in toplevel+               NotTopLevel -> return an+      exactHsFamInstLHS an0 tycon bndrs pats fixity mctxt++{-+Note [an and an2 in exactDataFamInstDecl]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The exactDataFamInstDecl function is called to render a+DataFamInstDecl within its surrounding context. This context is+rendered via the 'pp_hdr' function, which uses the exact print+annotations from that context, named 'an'.  The EPAs used for+rendering the DataDefn are contained in the FamEqn, and are called+'an2'.++-}++-- ---------------------------------------------------------------------++instance ExactPrint (DerivDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (DerivDecl (mw, an) typ ms mov) = do+    an0 <- markEpAnnL an lidl AnnDeriving+    ms' <- mapM markAnnotated ms+    an1 <- markEpAnnL an0 lidl AnnInstance+    mw' <- mapM markAnnotated mw+    mov' <- mapM markAnnotated mov+    typ' <- markAnnotated typ+    return (DerivDecl (mw', an1) typ' ms' mov')++-- ---------------------------------------------------------------------++instance ExactPrint (ForeignDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (ForeignImport an n ty fimport) = do+    an0 <- markEpAnnL an lidl AnnForeign+    an1 <- markEpAnnL an0 lidl AnnImport++    fimport' <- markAnnotated fimport++    n' <- markAnnotated n+    an2 <- markEpAnnL an1 lidl AnnDcolon+    ty' <- markAnnotated ty+    return (ForeignImport an2 n' ty' fimport')++  exact (ForeignExport an n ty fexport) = do+    an0 <- markEpAnnL an lidl AnnForeign+    an1 <- markEpAnnL an0 lidl AnnExport+    fexport' <- markAnnotated fexport+    n' <- markAnnotated n+    an2 <- markEpAnnL an1 lidl AnnDcolon+    ty' <- markAnnotated ty+    return (ForeignExport an2 n' ty' fexport')++-- ---------------------------------------------------------------------++instance ExactPrint (ForeignImport GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (CImport (L ls src) cconv safety@(L l _) mh imp) = do+    cconv' <- markAnnotated cconv+    safety' <- if notDodgyE l+        then markAnnotated safety+        else return safety+    ls' <- if notDodgyE ls+        then markExternalSourceTextE ls src ""+        else return ls+    return (CImport (L ls' src) cconv' safety' mh imp)++-- ---------------------------------------------------------------------++instance ExactPrint (ForeignExport GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (CExport (L ls src) spec) = do+    debugM $ "CExport starting"+    spec' <- markAnnotated spec+    ls' <- if notDodgyE ls+        then markExternalSourceTextE ls src ""+        else return ls+    return (CExport (L ls' src) spec')++-- ---------------------------------------------------------------------++instance ExactPrint CExportSpec where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (CExportStatic st lbl cconv) = do+    debugM $ "CExportStatic starting"+    cconv' <- markAnnotated cconv+    return (CExportStatic st lbl cconv')++-- ---------------------------------------------------------------------++instance ExactPrint Safety where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact = withPpr++-- ---------------------------------------------------------------------++instance ExactPrint CCallConv where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact = withPpr++-- ---------------------------------------------------------------------++instance ExactPrint (WarnDecls GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (Warnings (an,src) warns) = do+    an0 <- markAnnOpen an src "{-# WARNING" -- Note: might be {-# DEPRECATED+    warns' <- markAnnotated warns+    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")+    return (Warnings (an1,src) warns')++-- ---------------------------------------------------------------------++instance ExactPrint (WarnDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (Warning (ns_spec, an) lns  (WarningTxt mb_cat src ls )) = do+    mb_cat' <- markAnnotated mb_cat+    ns_spec' <- exactNsSpec ns_spec+    lns' <- markAnnotated lns+    an0 <- markEpAnnL an lidl AnnOpenS -- "["+    ls' <- markAnnotated ls+    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"+    return (Warning (ns_spec', an1) lns'  (WarningTxt mb_cat' src ls'))+    -- return (Warning an1 lns'  (WarningTxt mb_cat' src ls'))++  exact (Warning (ns_spec, an) lns (DeprecatedTxt src ls)) = do+    ns_spec' <- exactNsSpec ns_spec+    lns' <- markAnnotated lns+    an0 <- markEpAnnL an lidl AnnOpenS -- "["+    ls' <- markAnnotated ls+    an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"+    return (Warning (ns_spec', an1) lns' (DeprecatedTxt src ls'))+    -- return (Warning an1 lns' (DeprecatedTxt src ls'))++exactNsSpec :: (Monad m, Monoid w) => NamespaceSpecifier -> EP w m NamespaceSpecifier+exactNsSpec NoNamespaceSpecifier = pure NoNamespaceSpecifier+exactNsSpec (TypeNamespaceSpecifier type_) = do+  type_' <- markEpToken type_+  pure (TypeNamespaceSpecifier type_')+exactNsSpec (DataNamespaceSpecifier data_) = do+  data_' <- markEpToken data_+  pure (DataNamespaceSpecifier data_')++-- ---------------------------------------------------------------------++instance ExactPrint StringLiteral where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (StringLiteral src fs mcomma) = do+    printSourceTextAA src (show (unpackFS fs))+    mcomma' <- mapM (\r -> printStringAtNC r ",") mcomma+    return (StringLiteral src fs mcomma')+++-- ---------------------------------------------------------------------++instance ExactPrint FastString where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.+  -- exact fs = printStringAdvance (show (unpackFS fs))+  exact fs = printStringAdvance (unpackFS fs) >> return fs++-- ---------------------------------------------------------------------++instance ExactPrint (RuleDecls GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (HsRules (an, src) rules) = do+    an0 <-+      case src of+        NoSourceText      -> markEpAnnLMS'' an lidl AnnOpen  (Just "{-# RULES")+        SourceText srcTxt -> markEpAnnLMS'' an lidl AnnOpen  (Just $ unpackFS srcTxt)+    rules' <- markAnnotated rules+    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")+    return (HsRules (an1,src) rules')++-- ---------------------------------------------------------------------++instance ExactPrint (RuleDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsRule (an,nsrc) (L ln n) act mtybndrs termbndrs lhs rhs) = do+    (L ln' _) <- markAnnotated (L ln (nsrc, n))+    an0 <- markActivation an lra_rest act+    (an1, mtybndrs') <-+      case mtybndrs of+        Nothing -> return (an0, Nothing)+        Just bndrs -> do+          an1 <-  markLensMAA' an0 lra_tyanns_fst  -- AnnForall+          bndrs' <- mapM markAnnotated bndrs+          an2 <- markLensMAA' an1 lra_tyanns_snd  -- AnnDot+          return (an2, Just bndrs')++    an2 <- markLensMAA' an1 lra_tmanns_fst  -- AnnForall+    termbndrs' <- mapM markAnnotated termbndrs+    an3 <- markLensMAA' an2 lra_tmanns_snd  -- AnnDot++    lhs' <- markAnnotated lhs+    an4 <- markEpAnnL an3 lra_rest AnnEqual+    rhs' <- markAnnotated rhs+    return (HsRule (an4,nsrc) (L ln' n) act mtybndrs' termbndrs' lhs' rhs')++markActivation :: (Monad m, Monoid w)+  => a -> Lens a [AddEpAnn] -> Activation -> EP w m a+markActivation an l act = do+  case act of+    ActiveBefore src phase -> do+      an0 <- markEpAnnL an l AnnOpenS --  '['+      an1 <- markEpAnnL an0 l AnnTilde -- ~+      an2 <- markEpAnnLMS'' an1 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))+      an3 <- markEpAnnL an2 l AnnCloseS -- ']'+      return an3+    ActiveAfter src phase -> do+      an0 <- markEpAnnL an l AnnOpenS --  '['+      an1 <- markEpAnnLMS'' an0 l AnnVal (Just (toSourceTextWithSuffix src (show phase) ""))+      an2 <- markEpAnnL an1 l AnnCloseS -- ']'+      return an2+    NeverActive -> do+      an0 <- markEpAnnL an l AnnOpenS --  '['+      an1 <- markEpAnnL an0 l AnnTilde -- ~+      an2 <- markEpAnnL an1 l AnnCloseS -- ']'+      return an2+    _ -> return an++-- ---------------------------------------------------------------------++instance ExactPrint (SpliceDecl GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (SpliceDecl x splice flag) = do+    splice' <- markAnnotated splice+    return (SpliceDecl x splice' flag)++-- ---------------------------------------------------------------------++instance ExactPrint (DocDecl GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  -- We print these as plain comments instead, do a NOP here.+  exact v = return v++-- ---------------------------------------------------------------------++instance ExactPrint (RoleAnnotDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (RoleAnnotDecl an ltycon roles) = do+    an0 <- markEpAnnL an lidl AnnType+    an1 <- markEpAnnL an0 lidl AnnRole+    ltycon' <- markAnnotated ltycon+    let markRole (L l (Just r)) = do+          (L l' r') <- markAnnotated (L l r)+          return (L l' (Just r'))+        markRole (L l Nothing) = do+          e' <- printStringAtAA  (entry l) "_"+          return (L (l { entry = e'}) Nothing)+    roles' <- mapM markRole roles+    return (RoleAnnotDecl an1 ltycon' roles')++-- ---------------------------------------------------------------------++instance ExactPrint Role where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact = withPpr++-- ---------------------------------------------------------------------++instance ExactPrint (RuleBndr GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (RuleBndr x ln) = do+    ln' <- markAnnotated ln+    return (RuleBndr x ln')+  exact (RuleBndrSig an ln (HsPS x ty)) = do+    an0 <- markEpAnnL an lidl AnnOpenP -- "("+    ln' <- markAnnotated ln+    an1 <- markEpAnnL an0 lidl AnnDcolon+    ty' <- markAnnotated ty+    an2 <- markEpAnnL an1 lidl AnnCloseP -- ")"+    return (RuleBndrSig an2 ln' (HsPS x ty'))++-- ---------------------------------------------------------------------++instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor fe _ _ _s = fe+  exact (FamEqn { feqn_ext = an+                , feqn_tycon  = tycon+                , feqn_bndrs  = bndrs+                , feqn_pats   = pats+                , feqn_fixity = fixity+                , feqn_rhs    = rhs }) = do+    (an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS an tycon bndrs pats fixity Nothing+    an1 <- markEpAnnL an0 lidl AnnEqual+    rhs' <- markAnnotated rhs+    return (FamEqn { feqn_ext = an1+                   , feqn_tycon  = tycon'+                   , feqn_bndrs  = bndrs'+                   , feqn_pats   = pats'+                   , feqn_fixity = fixity+                   , feqn_rhs    = rhs' })++-- ---------------------------------------------------------------------++exactHsFamInstLHS ::+      (Monad m, Monoid w)+   => [AddEpAnn]+   -> LocatedN RdrName+   -> HsOuterTyVarBndrs () GhcPs+   -> HsFamEqnPats GhcPs+   -> LexicalFixity+   -> Maybe (LHsContext GhcPs)+   -> EP w m ( [AddEpAnn]+             , LocatedN RdrName+             , HsOuterTyVarBndrs () GhcPs+             , HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))+exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do+  an0 <- markEpAnnL an lidl AnnForall+  bndrs' <- markAnnotated bndrs+  an1 <- markEpAnnL an0 lidl AnnDot+  mb_ctxt' <- mapM markAnnotated mb_ctxt+  (an2, thing', typats') <- exact_pats an1 typats+  return (an2, thing', bndrs', typats', mb_ctxt')+  where+    exact_pats :: (Monad m, Monoid w)+      => [AddEpAnn] -> HsFamEqnPats GhcPs -> EP w m ([AddEpAnn], LocatedN RdrName, HsFamEqnPats GhcPs)+    exact_pats an' (patl:patr:pats)+      | Infix <- fixity+      = let exact_op_app = do+              an0 <- markEpAnnAllL' an' lidl AnnOpenP+              patl' <- markAnnotated patl+              thing' <- markAnnotated thing+              patr' <- markAnnotated patr+              an1 <- markEpAnnAllL' an0 lidl AnnCloseP+              return (an1, thing', [patl',patr'])+        in case pats of+             [] -> exact_op_app+             _  -> do+               (an0, thing', p) <- exact_op_app+               pats' <- mapM markAnnotated pats+               return (an0, thing', p++pats')++    exact_pats an' pats = do+      an0 <- markEpAnnAllL' an' lidl AnnOpenP+      thing' <- markAnnotated thing+      pats' <- markAnnotated pats+      an1 <- markEpAnnAllL' an0 lidl AnnCloseP+      return (an1, thing', pats')++-- ---------------------------------------------------------------------++instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)+     =>  ExactPrint (HsArg GhcPs tm ty) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsValArg x tm) = do+      tm' <- markAnnotated tm+      return (HsValArg x tm')+  exact (HsTypeArg at ty) = do+      at' <- markEpToken at+      ty' <- markAnnotated ty+      return (HsTypeArg at' ty')+  exact x@(HsArgPar _sp)    = withPpr x -- Does not appear in original source++-- ---------------------------------------------------------------------++instance ExactPrint (ClsInstDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (ClsInstDecl { cid_ext = (mbWarn, an, sortKey)+                     , cid_poly_ty = inst_ty, cid_binds = binds+                     , cid_sigs = sigs, cid_tyfam_insts = ats+                     , cid_overlap_mode = mbOverlap+                     , cid_datafam_insts = adts })+      = do+          (mbWarn', an0, mbOverlap', inst_ty') <- top_matter+          an1 <- markEpAnnL an0 lidl AnnOpenC+          an2 <- markEpAnnAllL' an1 lid AnnSemi+          (sortKey', ds) <- withSortKey sortKey+                               [(ClsAtTag, prepareListAnnotationA ats),+                                (ClsAtdTag, prepareListAnnotationF adts),+                                (ClsMethodTag, prepareListAnnotationA (bagToList binds)),+                                (ClsSigTag, prepareListAnnotationA sigs)+                               ]+          an3 <- markEpAnnL an2 lidl AnnCloseC -- '}'+          let+            ats'   = undynamic ds+            adts'  = undynamic ds+            binds' = listToBag $ undynamic ds+            sigs'  = undynamic ds+          return (ClsInstDecl { cid_ext = (mbWarn', an3, sortKey')+                              , cid_poly_ty = inst_ty', cid_binds = binds'+                              , cid_sigs = sigs', cid_tyfam_insts = ats'+                              , cid_overlap_mode = mbOverlap'+                              , cid_datafam_insts = adts' })++      where+        top_matter = do+          an0 <- markEpAnnL an lidl AnnInstance+          mw <- mapM markAnnotated mbWarn+          mo <- mapM markAnnotated mbOverlap+          it <- markAnnotated inst_ty+          an1 <- markEpAnnL an0 lidl AnnWhere -- Optional+          return (mw, an1, mo,it)++-- ---------------------------------------------------------------------++instance ExactPrint (TyFamInstDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact d@(TyFamInstDecl { tfid_xtn = an, tfid_eqn = eqn }) = do+    an0 <- markEpAnnL an lidl AnnType+    an1 <- markEpAnnL an0 lidl AnnInstance+    eqn' <- markAnnotated eqn+    return (d { tfid_xtn = an1, tfid_eqn = eqn' })++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedP OverlapMode) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  -- NOTE: NoOverlap is only used in the typechecker+  exact (L an (NoOverlap src)) = do+    an0 <- markAnnOpenP an src "{-# NO_OVERLAP"+    an1 <- markAnnCloseP an0+    return (L an1 (NoOverlap src))++  exact (L an (Overlappable src)) = do+    an0 <- markAnnOpenP an src "{-# OVERLAPPABLE"+    an1 <- markAnnCloseP an0+    return (L an1 (Overlappable src))++  exact (L an (Overlapping src)) = do+    an0 <- markAnnOpenP an src "{-# OVERLAPPING"+    an1 <- markAnnCloseP an0+    return (L an1 (Overlapping src))++  exact (L an (Overlaps src)) = do+    an0 <- markAnnOpenP an src "{-# OVERLAPS"+    an1 <- markAnnCloseP an0+    return (L an1 (Overlaps src))++  exact (L an (Incoherent src)) = do+    an0 <- markAnnOpenP an src "{-# INCOHERENT"+    an1 <- markAnnCloseP an0+    return (L an1 (Incoherent src))++  exact (L an (NonCanonical src)) = do+    an0 <- markAnnOpenP an src "{-# INCOHERENT"+    an1 <- markAnnCloseP an0+    return (L an1 (Incoherent src))++-- ---------------------------------------------------------------------++instance ExactPrint (HsBind GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (FunBind x fid matches) = do+    matches' <- markAnnotated matches+    let+      fun_id' = case unLoc (mg_alts matches') of+        [] -> fid+        (L _ m:_) -> case m_ctxt m of+          FunRhs f _ _ -> f+          _ -> fid+    return (FunBind x fun_id' matches')++  exact (PatBind x pat q grhss) = do+    q' <- markAnnotated q+    pat' <- markAnnotated pat+    grhss' <- markAnnotated grhss+    return (PatBind x pat' q' grhss')+  exact (PatSynBind x bind) = do+    bind' <- markAnnotated bind+    return (PatSynBind x bind')++  exact x = error $ "HsBind: exact for " ++ showAst x++instance ExactPrint (HsMultAnn GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsNoMultAnn x) = return (HsNoMultAnn x)+  exact (HsPct1Ann tok) = do+      tok' <- markEpToken tok+      return (HsPct1Ann tok')+  exact (HsMultAnn tok ty) = do+      tok' <- markEpToken tok+      ty' <- markAnnotated ty+      return (HsMultAnn tok' ty')++-- ---------------------------------------------------------------------++instance ExactPrint (PatSynBind GhcPs GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (PSB{ psb_ext = an+            , psb_id = psyn, psb_args = details+            , psb_def = pat+            , psb_dir = dir }) = do+    an0 <- markEpAnnL an lidl AnnPattern+    (an1, psyn', details') <-+      case details of+        InfixCon v1 v2 -> do+          v1' <- markAnnotated v1+          psyn' <- markAnnotated psyn+          v2' <- markAnnotated v2+          return (an0, psyn',InfixCon v1' v2')+        PrefixCon tvs vs -> do+          psyn' <- markAnnotated psyn+          tvs' <- markAnnotated tvs+          vs' <- markAnnotated vs+          return (an0, psyn', PrefixCon tvs' vs')+        RecCon vs -> do+          psyn' <- markAnnotated psyn+          an1 <- markEpAnnL an0 lidl AnnOpenC  -- '{'+          vs' <- markAnnotated vs+          an2 <- markEpAnnL an1 lidl AnnCloseC -- '}'+          return (an2, psyn', RecCon vs')++    (an2, pat', dir') <-+      case dir of+        Unidirectional           -> do+          an2 <- markEpAnnL an1 lidl AnnLarrow+          pat' <- markAnnotated pat+          return (an2, pat', dir)+        ImplicitBidirectional    -> do+          an2 <- markEpAnnL an1 lidl AnnEqual+          pat' <- markAnnotated pat+          return (an2, pat', dir)+        ExplicitBidirectional mg -> do+          an2 <- markEpAnnL an1 lidl AnnLarrow+          pat' <- markAnnotated pat+          an3 <- markEpAnnL an2 lidl  AnnWhere+          mg' <- markAnnotated mg+          return (an3, pat', ExplicitBidirectional mg')++    return (PSB{ psb_ext = an2+               , psb_id = psyn', psb_args = details'+               , psb_def = pat'+               , psb_dir = dir' })+++-- ---------------------------------------------------------------------++instance ExactPrint (RecordPatSynField GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (RecordPatSynField f v) = do+      f' <- markAnnotated f+      return (RecordPatSynField f' v)++-- ---------------------------------------------------------------------++instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (Match an mctxt pats grhss) =+    exactMatch (Match an mctxt pats grhss)++-- -------------------------------------++instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (Match an mctxt pats grhss) =+    exactMatch (Match an mctxt pats grhss)++-- ---------------------------------------------------------------------++exactMatch :: (Monad m, Monoid w, ExactPrint (GRHSs GhcPs body))+           => (Match GhcPs body) -> EP w m (Match GhcPs body)+exactMatch (Match an mctxt pats grhss) = do++  debugM $ "exact Match entered"++  (an0, mctxt', pats') <-+    case mctxt of+      FunRhs fun fixity strictness -> do+        debugM $ "exact Match FunRhs:" ++ showPprUnsafe fun+        an0' <-+          case strictness of+            SrcStrict -> markEpAnnL an lidl AnnBang+            _ -> pure an+        case fixity of+          Prefix -> do+            an' <- annotationsToComments an0' lidl [AnnOpenP,AnnCloseP]+            fun' <- markAnnotated fun+            pats' <- markAnnotated pats+            return (an', FunRhs fun' fixity strictness, pats')+          Infix ->+            case pats of+              (p1:p2:rest)+                | null rest -> do+                    p1'  <- markAnnotated p1+                    fun' <- markAnnotated fun+                    p2'  <- markAnnotated p2+                    return (an0', FunRhs fun' fixity strictness, [p1',p2'])+                | otherwise -> do+                    an0  <- markEpAnnL an0' lidl AnnOpenP+                    p1'  <- markAnnotated p1+                    fun' <- markAnnotated fun+                    p2'  <- markAnnotated p2+                    an1  <- markEpAnnL an0 lidl AnnCloseP+                    rest' <- mapM markAnnotated rest+                    return (an1, FunRhs fun' fixity strictness, p1':p2':rest')+              _ -> panic "FunRhs"++      -- ToDo: why is LamSingle treated differently?+      LamAlt LamSingle -> do+        an0' <- markEpAnnL an lidl AnnLam+        pats' <- markAnnotated pats+        return (an0', LamAlt LamSingle, pats')+      LamAlt v -> do+        pats' <- markAnnotated pats+        return (an, LamAlt v, pats')++      CaseAlt -> do+        pats' <- markAnnotated pats+        return (an, CaseAlt, pats')+      _ -> do+        mctxt' <- withPpr mctxt+        return (an, mctxt', pats)++  grhss' <- markAnnotated grhss++  return (Match an0 mctxt' pats' grhss')++-- ---------------------------------------------------------------------++instance ExactPrint (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (GRHSs cs grhss binds) = do+    addCommentsA $ priorComments cs+    addCommentsA $ getFollowingComments cs+    grhss' <- markAnnotated grhss+    binds' <- markAnnotated binds+    -- The comments will be added back as they are printed+    return (GRHSs emptyComments grhss' binds')+++instance ExactPrint (GRHSs GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry (GRHSs _ _ _) = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (GRHSs cs grhss binds) = do+    addCommentsA $ priorComments cs+    addCommentsA $ getFollowingComments cs+    grhss' <- markAnnotated grhss+    binds' <- markAnnotated binds+    -- The comments will be added back as they are printed+    return (GRHSs emptyComments grhss' binds')++-- ---------------------------------------------------------------------++instance ExactPrint (HsLocalBinds GhcPs) where+  getAnnotationEntry (HsValBinds an _) = fromAnn an+  getAnnotationEntry (HsIPBinds{}) = NoEntryVal+  getAnnotationEntry (EmptyLocalBinds{}) = NoEntryVal++  setAnnotationAnchor (HsValBinds an a) anc ts cs = HsValBinds (setAnchorEpaL an anc ts cs) a+  setAnnotationAnchor a _ _ _ = a++  exact (HsValBinds an valbinds) = do+    debugM $ "exact HsValBinds: an=" ++ showAst an+    an0 <- markEpAnnL' an lal_rest AnnWhere++    case al_anchor $ anns an of+      Just anc -> do+        when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)+      _ -> return ()++    (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds+    debugM $ "exact HsValBinds: an1=" ++ showAst an1+    medr <- getExtraDPReturn+    an2 <- case medr of+             Nothing -> return an1+             Just dp -> do+                 setExtraDPReturn Nothing+                 return $ an1 { anns = (anns an1) { al_anchor = Just (EpaDelta dp []) }}+    return (HsValBinds an2 valbinds')++  exact (HsIPBinds an bs) = do+    (an2,bs') <- markAnnListA an $ \an0 -> do+                           an1 <- markEpAnnL' an0 lal_rest AnnWhere+                           bs' <- markAnnotated bs+                           return (an1, bs')+    return (HsIPBinds an2 bs')+  exact b@(EmptyLocalBinds _) = return b+++-- ---------------------------------------------------------------------+instance ExactPrint (HsValBindsLR GhcPs GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (ValBinds sortKey binds sigs) = do+    decls <- setLayoutBoth $ mapM markAnnotated $ hsDeclsValBinds (ValBinds sortKey binds sigs)+    let+      binds' = listToBag $ concatMap decl2Bind decls+      sigs'  =             concatMap decl2Sig decls+      sortKey' = captureOrderBinds decls+    return (ValBinds sortKey' binds' sigs')+  exact (XValBindsLR _) = panic "XValBindsLR"++undynamic :: Typeable a => [Dynamic] -> [a]+undynamic ds = mapMaybe fromDynamic ds++-- ---------------------------------------------------------------------++instance ExactPrint (HsIPBinds GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (IPBinds x binds) = setLayoutBoth $ do+      binds' <- markAnnotated binds+      return (IPBinds x binds')++-- ---------------------------------------------------------------------++instance ExactPrint (IPBind GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (IPBind an lr rhs) = do+    lr' <- markAnnotated lr+    an0 <- markEpAnnL an lidl AnnEqual+    rhs' <- markAnnotated rhs+    return (IPBind an0 lr' rhs')+++-- ---------------------------------------------------------------------++instance ExactPrint HsIPName where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact i@(HsIPName fs) = printStringAdvanceA ("?" ++ (unpackFS fs)) >> return i++-- ---------------------------------------------------------------------+-- Managing lists which have been separated, e.g. Sigs and Binds++prepareListAnnotationF :: (Monad m, Monoid w) =>+  [LDataFamInstDecl GhcPs] -> [(RealSrcSpan,EP w m Dynamic)]+prepareListAnnotationF ls = map (\b -> (realSrcSpan $ getLocA b, go b)) ls+  where+    go (L l a) = do+      (L l' d') <- markAnnotated (L l (DataFamInstDeclWithContext noAnn NotTopLevel a))+      return (toDyn (L l' (dc_d d')))++prepareListAnnotationA :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))+  => [LocatedAn an a] -> [(RealSrcSpan,EP w m Dynamic)]+prepareListAnnotationA ls = map (\b -> (realSrcSpan $ getLocA b,go b)) ls+  where+    go b = do+      b' <- markAnnotated b+      return (toDyn b')++withSortKey :: (Monad m, Monoid w)+  => AnnSortKey DeclTag -> [(DeclTag, [(RealSrcSpan, EP w m Dynamic)])]+  -> EP w m (AnnSortKey DeclTag, [Dynamic])+withSortKey annSortKey xs = do+  debugM $ "withSortKey:annSortKey=" ++ showAst annSortKey+  let (sk, ordered) = case annSortKey of+                  NoAnnSortKey -> (annSortKey', map snd os)+                    where+                      doOne (tag, ds) = map (\d -> (tag, d)) ds+                      xsExpanded = concatMap doOne xs+                      os = sortBy orderByFst $ xsExpanded+                      annSortKey' = AnnSortKey (map fst os)+                  AnnSortKey _keys -> (annSortKey, orderedDecls annSortKey (Map.fromList xs))+  ordered' <- mapM snd ordered+  return (sk, ordered')++orderByFst :: Ord a => (t, (a,b1)) -> (t, (a, b2)) -> Ordering+orderByFst (_,(a,_)) (_,(b,_)) = compare a b++-- ---------------------------------------------------------------------++instance ExactPrint (Sig GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (TypeSig an vars ty)  = do+    (an', vars', ty') <- exactVarSig an vars ty+    return (TypeSig an' vars' ty')++  exact (PatSynSig an lns typ) = do+    an0 <- markEpAnnL an lasRest AnnPattern+    lns' <- markAnnotated lns+    an1 <- markLensAA' an0 lasDcolon+    typ' <- markAnnotated typ+    return (PatSynSig an1 lns' typ')++  exact (ClassOpSig an is_deflt vars ty)+    | is_deflt  = do+        an0 <- markEpAnnL an lasRest AnnDefault+        (an1, vars',ty') <- exactVarSig an0 vars ty+        return (ClassOpSig an1 is_deflt vars' ty')+    | otherwise = do+        (an0, vars',ty') <- exactVarSig an vars ty+        return (ClassOpSig an0 is_deflt vars' ty')++  exact (FixSig an (FixitySig ns names (Fixity src v fdir))) = do+    let fixstr = case fdir of+         InfixL -> "infixl"+         InfixR -> "infixr"+         InfixN -> "infix"+    an0 <- markEpAnnLMS'' an  lidl AnnInfix (Just fixstr)+    an1 <- markEpAnnLMS'' an0 lidl AnnVal (Just (sourceTextToString src (show v)))+    ns' <- markAnnotated ns+    names' <- markAnnotated names+    return (FixSig an1 (FixitySig ns' names' (Fixity src v fdir)))++  exact (InlineSig an ln inl) = do+    an0 <- markAnnOpen an (inl_src inl) "{-# INLINE"+    an1 <- markActivation an0 id (inl_act inl)+    ln' <- markAnnotated ln+    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "#-}")+    return (InlineSig an2 ln' inl)++  exact (SpecSig an ln typs inl) = do+    an0 <- markAnnOpen an (inl_src inl) "{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE+    an1 <- markActivation an0 lidl (inl_act inl)+    ln' <- markAnnotated ln+    an2 <- markEpAnnL an1 lidl AnnDcolon+    typs' <- markAnnotated typs+    an3 <- markEpAnnLMS'' an2 lidl AnnClose (Just "#-}")+    return (SpecSig an3 ln' typs' inl)++  exact (SpecInstSig (an,src) typ) = do+    an0 <- markAnnOpen an src "{-# SPECIALISE"+    an1 <- markEpAnnL an0 lidl AnnInstance+    typ' <- markAnnotated typ+    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "#-}")+    return (SpecInstSig (an2,src) typ')++  exact (MinimalSig (an,src) formula) = do+    an0 <- markAnnOpen an src "{-# MINIMAL"+    formula' <- markAnnotated formula+    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")+    return (MinimalSig (an1,src) formula')++  exact (SCCFunSig (an,src) ln ml) = do+    an0 <- markAnnOpen an src "{-# SCC"+    ln' <- markAnnotated ln+    ml' <- markAnnotated ml+    an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")+    return (SCCFunSig (an1,src) ln' ml')++  exact (CompleteMatchSig (an,src) cs mty) = do+    an0 <- markAnnOpen an src "{-# COMPLETE"+    cs' <- mapM markAnnotated cs+    (an1, mty') <-+      case mty of+        Nothing -> return (an0, mty)+        Just ty -> do+          an1 <- markEpAnnL an0 lidl AnnDcolon+          ty' <- markAnnotated ty+          return (an1, Just ty')+    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "#-}")+    return (CompleteMatchSig (an2,src) cs' mty')++-- ---------------------------------------------------------------------++instance ExactPrint NamespaceSpecifier where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact NoNamespaceSpecifier = return NoNamespaceSpecifier+  exact (TypeNamespaceSpecifier typeTok) = do+      typeTok' <- markEpToken typeTok+      return (TypeNamespaceSpecifier typeTok')+  exact (DataNamespaceSpecifier dataTok) = do+      dataTok' <- markEpToken dataTok+      return (DataNamespaceSpecifier dataTok')++-- ---------------------------------------------------------------------++exactVarSig :: (Monad m, Monoid w, ExactPrint a)+  => AnnSig -> [LocatedN RdrName] -> a -> EP w m (AnnSig, [LocatedN RdrName], a)+exactVarSig an vars ty = do+  vars' <- mapM markAnnotated vars+  an0 <- markLensAA' an lasDcolon+  ty' <- markAnnotated ty+  return (an0, vars', ty')++-- ---------------------------------------------------------------------++instance ExactPrint (StandaloneKindSig GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (StandaloneKindSig an vars sig) = do+    an0 <- markEpAnnL an lidl AnnType+    vars' <- markAnnotated vars+    an1 <- markEpAnnL an0 lidl AnnDcolon+    sig' <- markAnnotated sig+    return (StandaloneKindSig an1 vars' sig')++-- ---------------------------------------------------------------------++instance ExactPrint (DefaultDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (DefaultDecl an tys) = do+    an0 <- markEpAnnL an lidl AnnDefault+    an1 <- markEpAnnL an0 lidl AnnOpenP+    tys' <- markAnnotated tys+    an2 <- markEpAnnL an1 lidl AnnCloseP+    return (DefaultDecl an2 tys')++-- ---------------------------------------------------------------------++instance ExactPrint (AnnDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsAnnotation (an, src) prov e) = do+    an0 <- markAnnOpenP' an src "{-# ANN"+    (an1, prov') <-+      case prov of+        (ValueAnnProvenance n) -> do+          n' <- markAnnotated n+          return (an0, ValueAnnProvenance n')+        (TypeAnnProvenance n) -> do+          an1 <- markEpAnnL an0 lapr_rest AnnType+          n' <- markAnnotated n+          return (an1, TypeAnnProvenance n')+        ModuleAnnProvenance -> do+          an1 <- markEpAnnL an0 lapr_rest AnnModule+          return (an1, prov)++    e' <- markAnnotated e+    an2 <- markAnnCloseP' an1+    return (HsAnnotation (an2,src) prov' e')++-- ---------------------------------------------------------------------++instance ExactPrint (BF.BooleanFormula (LocatedN RdrName)) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (BF.Var x)  = do+    x' <- markAnnotated x+    return (BF.Var x')+  exact (BF.Or ls)  = do+    ls' <- markAnnotated ls+    return (BF.Or ls')+  exact (BF.And ls) = do+    ls' <- markAnnotated ls+    return (BF.And ls')+  exact (BF.Parens x)  = do+    x' <- markAnnotated x+    return (BF.Parens x')++-- ---------------------------------------------------------------------++instance (ExactPrint body) => ExactPrint (HsWildCardBndrs GhcPs body) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _= a+  exact (HsWC x ty) = do+    ty' <- markAnnotated ty+    return (HsWC x ty')++-- ---------------------------------------------------------------------++instance ExactPrint (GRHS GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry (GRHS an _ _) = fromAnn an+  setAnnotationAnchor (GRHS an a b) anc ts cs = GRHS (setAnchorEpa an anc ts cs) a b++  exact (GRHS an guards expr) = do+    an0 <- if null guards+             then return an+             else markLensKwM an lga_vbar AnnVbar+    guards' <- markAnnotated guards+    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs+    expr' <- markAnnotated expr+    return (GRHS an1 guards' expr')++instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry (GRHS ann _ _) = fromAnn ann+  setAnnotationAnchor (GRHS an a b) anc ts cs = GRHS (setAnchorEpa an anc ts cs) a b++  exact (GRHS an guards expr) = do+    an0 <- markLensKwM an lga_vbar AnnVbar+    guards' <- markAnnotated guards+    an1 <- markLensAA an0 lga_sep -- Mark the matchSeparator for these GRHSs+    expr' <- markAnnotated expr+    return (GRHS an1 guards' expr')++-- ---------------------------------------------------------------------++instance ExactPrint (HsExpr GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _s = a++  exact (HsVar x n) = do+    -- The parser inserts a placeholder value for a record pun rhs. This must be+    -- filtered.+    let pun_RDR = "pun-right-hand-side"+    n' <- if (showPprUnsafe n /= pun_RDR)+      then markAnnotated n+      else return n+    return (HsVar x n')+  exact (HsUnboundVar an n) = do+    case an of+      Just (EpAnnUnboundVar (ob,cb) l) -> do+        ob' <-  printStringAtAA ob "`"+        l' <- printStringAtAA l  "_"+        cb' <- printStringAtAA cb "`"+        return (HsUnboundVar (Just (EpAnnUnboundVar (ob',cb') l')) n)+      _ -> do+        printStringAdvanceA "_" >> return ()+        return (HsUnboundVar an n)+  exact x@(HsOverLabel _ src l) = do+    printStringAdvanceA "#" >> return ()+    case src of+      NoSourceText   -> printStringAdvanceA (unpackFS l)  >> return ()+      SourceText txt -> printStringAdvanceA (unpackFS txt) >> return ()+    return x++  exact x@(HsIPVar _ (HsIPName n))+    = printStringAdvance ("?" ++ unpackFS n) >> return x++  exact x@(HsOverLit _an ol) = do+    let str = case ol_val ol of+                HsIntegral   (IL src _ _) -> src+                HsFractional (FL { fl_text = src }) -> src+                HsIsString src _          -> src+    case str of+      SourceText s -> printStringAdvance (unpackFS s) >> return ()+      NoSourceText -> withPpr x >> return ()+    return x++  exact (HsLit an lit) = do+    lit' <- withPpr lit+    return (HsLit an lit')++  exact (HsLam an lam_variant mg) = do+    an0 <- mark an AnnLam+    an1 <- case lam_variant of+             LamSingle -> return an0+             LamCase -> mark an0 AnnCase+             LamCases -> mark an0 AnnCases+    mg' <- markAnnotated mg+    return (HsLam an1 lam_variant mg')++  exact (HsApp an e1 e2) = do+    p <- getPosP+    debugM $ "HsApp entered. p=" ++ show p+    e1' <- markAnnotated e1+    e2' <- markAnnotated e2+    return (HsApp an e1' e2')+  exact (HsAppType at fun arg) = do+    fun' <- markAnnotated fun+    at' <- markEpToken at+    arg' <- markAnnotated arg+    return (HsAppType at' fun' arg')+  exact (OpApp an e1 e2 e3) = do+    e1' <- markAnnotated e1+    e2' <- markAnnotated e2+    e3' <- markAnnotated e3+    return (OpApp an e1' e2' e3')++  exact (NegApp an e s) = do+    an0 <- markEpAnnL an lidl AnnMinus+    e' <- markAnnotated e+    return (NegApp an0 e' s)++  exact (HsPar (lpar, rpar) e) = do+    lpar' <- markEpToken lpar+    e' <- markAnnotated e+    debugM $ "HsPar closing paren"+    rpar' <- markEpToken rpar+    debugM $ "HsPar done"+    return (HsPar (lpar', rpar') e')++  exact (SectionL an expr op) = do+    expr' <- markAnnotated expr+    op' <- markAnnotated op+    return (SectionL an expr' op')++  exact (SectionR an op expr) = do+    op' <- markAnnotated op+    expr' <- markAnnotated expr+    return (SectionR an op' expr')++  exact (ExplicitTuple an args b) = do+    an0 <- if b == Boxed then markEpAnnL an lidl AnnOpenP+                         else markEpAnnL an lidl AnnOpenPH++    args' <- mapM markAnnotated args++    an1 <- if b == Boxed then markEpAnnL an0 lidl AnnCloseP+                         else markEpAnnL an0 lidl AnnClosePH+    debugM $ "ExplicitTuple done"+    return (ExplicitTuple an1 args' b)++  exact (ExplicitSum an alt arity expr) = do+    an0 <- markLensKw an laesOpen AnnOpenPH+    an1 <- markAnnKwAllL an0 laesBarsBefore AnnVbar+    expr' <- markAnnotated expr+    an2 <- markAnnKwAllL an1 laesBarsAfter AnnVbar+    an3 <- markLensKw an2 laesClose AnnClosePH+    return (ExplicitSum an3 alt arity expr')++  exact (HsCase an e alts) = do+    an0 <- markLensKw an lhsCaseAnnCase AnnCase+    e' <- markAnnotated e+    an1 <- markLensKw an0 lhsCaseAnnOf AnnOf+    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC+    an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi+    alts' <- setLayoutBoth $ markAnnotated alts+    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC+    return (HsCase an4 e' alts')++  exact (HsIf an e1 e2 e3) = do+    an0 <- markLensKw an laiIf AnnIf+    e1' <- markAnnotated e1+    an1 <- markLensKwM' an0 laiThenSemi AnnSemi+    an2 <- markLensKw an1 laiThen AnnThen+    e2' <- markAnnotated e2+    an3 <- markLensKwM' an2 laiElseSemi AnnSemi+    an4 <- markLensKw an3 laiElse AnnElse+    e3' <- markAnnotated e3+    return (HsIf an4 e1' e2' e3')++  exact (HsMultiIf an mg) = do+    an0 <- markEpAnnL an lidl AnnIf+    an1 <- markEpAnnL an0 lidl AnnOpenC -- optional+    mg' <- markAnnotated mg+    an2 <- markEpAnnL an1 lidl AnnCloseC -- optional+    return (HsMultiIf an2 mg')++  exact (HsLet (tkLet, tkIn) binds e) = do+    setLayoutBoth $ do -- Make sure the 'in' gets indented too+      tkLet' <- markEpToken tkLet+      binds' <- setLayoutBoth $ markAnnotated binds+      tkIn' <- markEpToken tkIn+      e' <- markAnnotated e+      return (HsLet (tkLet',tkIn') binds' e')++  exact (HsDo an do_or_list_comp stmts) = do+    debugM $ "HsDo"+    (an',stmts') <- markAnnListA' an $ \a -> exactDo a do_or_list_comp stmts+    return (HsDo an' do_or_list_comp stmts')++  exact (ExplicitList an es) = do+    debugM $ "ExplicitList start"+    an0 <- markLensMAA' an lal_open+    es' <- markAnnotated es+    an1 <- markLensMAA' an0 lal_close+    debugM $ "ExplicitList end"+    return (ExplicitList an1 es')+  exact (RecordCon an con_id binds) = do+    con_id' <- markAnnotated con_id+    an0 <- markEpAnnL an lidl AnnOpenC+    binds' <- markAnnotated binds+    an1 <- markEpAnnL an0 lidl AnnCloseC+    return (RecordCon an1 con_id' binds')+  exact (RecordUpd an expr fields) = do+    expr' <- markAnnotated expr+    an0 <- markEpAnnL an lidl AnnOpenC+    fields' <- markAnnotated fields+    an1 <- markEpAnnL an0 lidl AnnCloseC+    return (RecordUpd an1 expr' fields')+  exact (HsGetField an expr field) = do+    expr' <- markAnnotated expr+    field' <- markAnnotated field+    return (HsGetField an expr' field')+  exact (HsProjection an flds) = do+    an0 <- markLensKw an lapOpen AnnOpenP+    flds' <- mapM markAnnotated flds+    an1 <- markLensKw an0 lapClose AnnCloseP+    return (HsProjection an1 flds')+  exact (ExprWithTySig an expr sig) = do+    expr' <- markAnnotated expr+    an0 <- markEpAnnL an lidl AnnDcolon+    sig' <- markAnnotated sig+    return (ExprWithTySig an0 expr' sig')+  exact (ArithSeq an s seqInfo) = do+    an0 <- markEpAnnL an lidl AnnOpenS -- '['+    (an1, seqInfo') <-+      case seqInfo of+        From e -> do+          e' <- markAnnotated e+          an' <- markEpAnnL an0 lidl AnnDotdot+          return (an', From e')+        FromTo e1 e2 -> do+          e1' <- markAnnotated e1+          an' <- markEpAnnL an0 lidl AnnDotdot+          e2' <- markAnnotated e2+          return (an', FromTo e1' e2')+        FromThen e1 e2 -> do+          e1' <- markAnnotated e1+          an' <- markEpAnnL an0 lidl AnnComma+          e2' <- markAnnotated e2+          an'' <- markEpAnnL an' lidl AnnDotdot+          return (an'', FromThen e1' e2')+        FromThenTo e1 e2 e3 -> do+          e1' <- markAnnotated e1+          an' <- markEpAnnL an0 lidl AnnComma+          e2' <- markAnnotated e2+          an'' <- markEpAnnL an' lidl AnnDotdot+          e3' <- markAnnotated e3+          return (an'', FromThenTo e1' e2' e3')+    an2 <- markEpAnnL an1 lidl AnnCloseS -- ']'+    return (ArithSeq an2 s seqInfo')+++  exact (HsTypedBracket an e) = do+    an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[||")+    an1 <- markEpAnnLMS'' an0 lidl AnnOpenE (Just "[e||")+    e' <- markAnnotated e+    an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "||]")+    return (HsTypedBracket an2 e')++  exact (HsUntypedBracket an (ExpBr a e)) = do+    an0 <- markEpAnnL an  lidl AnnOpenEQ -- "[|"+    an1 <- markEpAnnL an0 lidl AnnOpenE  -- "[e|" -- optional+    e' <- markAnnotated e+    an2 <- markEpAnnL an1 lidl AnnCloseQ -- "|]"+    return (HsUntypedBracket an2 (ExpBr a e'))++  exact (HsUntypedBracket an (PatBr a e)) = do+    an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[p|")+    e' <- markAnnotated e+    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"+    return (HsUntypedBracket an1 (PatBr a e'))++  exact (HsUntypedBracket an (DecBrL a e)) = do+    an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[d|")+    an1 <- markEpAnnL an0 lidl AnnOpenC+    e' <- markAnnotated e+    an2 <- markEpAnnL an1 lidl AnnCloseC+    an3 <- markEpAnnL an2 lidl AnnCloseQ -- "|]"+    return (HsUntypedBracket an3 (DecBrL a e'))++  exact (HsUntypedBracket an (TypBr a e)) = do+    an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[t|")+    e' <- markAnnotated e+    an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"+    return (HsUntypedBracket an1 (TypBr a e'))++  exact (HsUntypedBracket an (VarBr a b e)) = do+    (an0, e') <- if b+      then do+        an' <- markEpAnnL an lidl AnnSimpleQuote+        e' <- markAnnotated e+        return (an', e')+      else do+        an' <- markEpAnnL an lidl AnnThTyQuote+        e' <- markAnnotated e+        return (an', e')+    return (HsUntypedBracket an0 (VarBr a b e'))++  exact (HsTypedSplice an s)   = do+    an0 <- markEpAnnL an lidl AnnDollarDollar+    s' <- markAnnotated s+    return (HsTypedSplice an0 s')++  exact (HsUntypedSplice an s) = do+    s' <- markAnnotated s+    return (HsUntypedSplice an s')++  exact (HsProc an p c) = do+    debugM $ "HsProc start"+    an0 <- markEpAnnL an lidl AnnProc+    p' <- markAnnotated p+    an1 <- markEpAnnL an0 lidl AnnRarrow+    debugM $ "HsProc after AnnRarrow"+    c' <- markAnnotated c+    return (HsProc an1 p' c')++  exact (HsStatic an e) = do+    an0 <- markEpAnnL an lidl AnnStatic+    e' <- markAnnotated e+    return (HsStatic an0 e')++  exact (HsPragE a prag e) = do+    prag' <- markAnnotated prag+    e' <- markAnnotated e+    return (HsPragE a prag' e')++  exact (HsEmbTy toktype t) = do+    toktype' <- markEpToken toktype+    t' <- markAnnotated t+    return (HsEmbTy toktype' t')++  exact x = error $ "exact HsExpr for:" ++ showAst x++-- ---------------------------------------------------------------------++exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))+        => AnnList -> HsDoFlavour -> LocatedAn an a+        -> EP w m (AnnList, LocatedAn an a)+exactDo an (DoExpr m)    stmts = exactMdo an m AnnDo           >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an GhciStmtCtxt  stmts = markEpAnnL an lal_rest AnnDo >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an (MDoExpr m)   stmts = exactMdo an m AnnMdo          >>= \an0 -> markMaybeDodgyStmts an0 stmts+exactDo an ListComp      stmts = markMaybeDodgyStmts an stmts+exactDo an MonadComp     stmts = markMaybeDodgyStmts an stmts++exactMdo :: (Monad m, Monoid w)+  => AnnList -> Maybe ModuleName -> AnnKeywordId -> EP w m AnnList+exactMdo an Nothing            kw = markEpAnnL    an lal_rest kw+exactMdo an (Just module_name) kw = markEpAnnLMS'' an lal_rest kw (Just n)+    where+      n = (moduleNameString module_name) ++ "." ++ (keywordToString kw)++markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))+  => AnnList -> LocatedAn an a -> EP w m (AnnList, LocatedAn an a)+markMaybeDodgyStmts an stmts =+  if notDodgy stmts+    then do+      r <- markAnnotatedWithLayout stmts+      return (an, r)+    else return (an, stmts)++notDodgy :: GenLocated (EpAnn ann) a -> Bool+notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc++notDodgyE :: EpaLocation -> Bool+notDodgyE anc =+  case anc of+    EpaSpan s -> isGoodSrcSpan s+    EpaDelta{} -> True++-- ---------------------------------------------------------------------+instance ExactPrint (HsPragE GhcPs) where+  getAnnotationEntry HsPragSCC{}  = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsPragSCC (an,st) sl) = do+    an0 <- markAnnOpenP' an st "{-# SCC"+    let txt = sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl)+    an1 <- markEpAnnLMS'' an0 lapr_rest AnnVal    (Just txt) -- optional+    an2 <- markEpAnnLMS'' an1 lapr_rest AnnValStr (Just txt) -- optional+    an3 <- markAnnCloseP' an2+    return (HsPragSCC (an3,st) sl)+++-- ---------------------------------------------------------------------++instance ExactPrint (HsUntypedSplice GhcPs) where+  getAnnotationEntry _ = NoEntryVal++  setAnnotationAnchor a _ _  _= a++  exact (HsUntypedSpliceExpr an e) = do+    an0 <- markEpAnnL an lidl AnnDollar+    e' <- markAnnotated e+    return (HsUntypedSpliceExpr an0 e')++  exact (HsQuasiQuote an q (L l fs)) = do+    -- The quasiquote string does not honour layout offsets. Store+    -- the colOffset for now.+    -- TODO: use local?+    oldOffset <- getLayoutOffsetP+    EPState{pMarkLayout} <- get+    unless pMarkLayout $ setLayoutOffsetP 0+    printStringAdvance+            -- Note: Lexer.x does not provide unicode alternative. 2017-02-26+            ("[" ++ (showPprUnsafe q) ++ "|" ++ (unpackFS fs) ++ "|]")+    unless pMarkLayout $ setLayoutOffsetP oldOffset+    return (HsQuasiQuote an q (L l fs))++-- ---------------------------------------------------------------------++-- TODO:AZ: combine these instances+instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (MG x matches) = do+    -- TODO:AZ use SortKey, in MG ann.+    matches' <- markAnnotated matches+    return (MG x matches')++instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (MG x matches) = do+    -- TODO:AZ use SortKey, in MG ann.+    matches' <- if notDodgy matches+      then markAnnotated matches+      else return matches+    return (MG x matches')++-- ---------------------------------------------------------------------++instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (HsRecFields fields mdot) = do+    fields' <- markAnnotated fields+    mdot' <- case mdot of+      Nothing -> return Nothing+      Just (L ss d) -> do+        ss' <- printStringAtAA ss ".."+        return $ Just (L ss' d)+      -- Note: mdot contains the SrcSpan where the ".." appears, if present+    return (HsRecFields fields' mdot')++-- ---------------------------------------------------------------------++instance (ExactPrint body)+    => ExactPrint (HsFieldBind (LocatedA (FieldOcc GhcPs)) body) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsFieldBind an f arg isPun) = do+    debugM $ "HsFieldBind"+    f' <- markAnnotated f+    (an0, arg') <- if isPun then return (an, arg)+             else do+               an0 <- markEpAnnL an lidl AnnEqual+               arg' <- markAnnotated arg+               return (an0, arg')+    return (HsFieldBind an0 f' arg' isPun)++-- ---------------------------------------------------------------------++instance (ExactPrint body)+    => ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsFieldBind an f arg isPun) = do+    debugM $ "HsFieldBind FieldLabelStrings"+    f' <- markAnnotated f+    (an0, arg') <- if isPun then return (an, arg)+             else do+               an0 <- markEpAnnL an lidl AnnEqual+               arg' <- markAnnotated arg+               return (an0, arg')+    return (HsFieldBind an0 f' arg' isPun)++-- ---------------------------------------------------------------------++instance (ExactPrint (LocatedA body))+    => ExactPrint (HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsFieldBind an f arg isPun) = do+    debugM $ "HsRecUpdField"+    f' <- markAnnotated f+    an0 <- if isPun then return an+             else markEpAnnL an lidl AnnEqual+    arg' <- if isPun+              then return arg+              else markAnnotated arg+    return (HsFieldBind an0 f' arg' isPun)++-- ---------------------------------------------------------------------+instance ExactPrint (LHsRecUpdFields GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact flds@(RegularRecUpdFields    { recUpdFields  = rbinds }) = do+    debugM $ "RegularRecUpdFields"+    rbinds' <- markAnnotated rbinds+    return $ flds { recUpdFields = rbinds' }+  exact flds@(OverloadedRecUpdFields { olRecUpdFields = pbinds }) = do+    debugM $ "OverloadedRecUpdFields"+    pbinds' <- markAnnotated pbinds+    return $ flds { olRecUpdFields = pbinds' }++-- ---------------------------------------------------------------------++instance ExactPrint (FieldLabelStrings GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (FieldLabelStrings fs) = FieldLabelStrings <$> markAnnotated fs++-- ---------------------------------------------------------------------++instance ExactPrint (DotFieldOcc GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (DotFieldOcc an (L loc (FieldLabelString fs))) = do+    an0 <- markLensKwM' an lafDot  AnnDot+    -- The field name has a SrcSpanAnnN, print it as a+    -- LocatedN RdrName+    L loc' _ <- markAnnotated (L loc (mkVarUnqual fs))+    return (DotFieldOcc an0 (L loc' (FieldLabelString fs)))++-- ---------------------------------------------------------------------++instance ExactPrint (HsTupArg GhcPs) where+  getAnnotationEntry (Present _ _) = NoEntryVal+  getAnnotationEntry (Missing (EpAnn _ False _)) = NoEntryVal+  getAnnotationEntry (Missing an)   = fromAnn an++  setAnnotationAnchor (Present a b) _ _ _ = Present a b+  setAnnotationAnchor (Missing an)   anc ts cs = Missing (setAnchorEpa an anc ts cs)++  exact (Present a e) = Present a <$> markAnnotated e++  exact a@(Missing (EpAnn _ False _)) = return a+  exact a@(Missing _) = printStringAdvance "," >> return a++-- ---------------------------------------------------------------------++instance ExactPrint (HsCmdTop GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (HsCmdTop a cmd) = HsCmdTop a <$> markAnnotated cmd++-- ---------------------------------------------------------------------++instance ExactPrint (HsCmd GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsCmdArrApp an arr arg o isRightToLeft) = do+    if isRightToLeft+      then do+        arr' <- markAnnotated arr+        an0 <- markKw an+        arg' <- markAnnotated arg+        return (HsCmdArrApp an0 arr' arg' o isRightToLeft)+      else do+        arg' <- markAnnotated arg+        an0 <- markKw an+        arr' <- markAnnotated arr+        return (HsCmdArrApp an0 arr' arg' o isRightToLeft)++  exact (HsCmdArrForm an e fixity mf cs) = do+    an0 <- markLensMAA' an lal_open+    (e',cs') <- case (fixity, cs) of+      (Infix, (arg1:argrest)) -> do+        arg1' <- markAnnotated arg1+        e' <- markAnnotated e+        argrest' <- markAnnotated argrest+        return (e', arg1':argrest')+      (Prefix, _) -> do+        e' <- markAnnotated e+        cs' <- markAnnotated cs+        return (e', cs')+      (Infix, []) -> error "Not possible"+    an1 <- markLensMAA' an0 lal_close+    return (HsCmdArrForm an1 e' fixity mf cs')++  exact (HsCmdApp an e1 e2) = do+    e1' <- markAnnotated e1+    e2' <- markAnnotated e2+    return (HsCmdApp an e1' e2')++  exact (HsCmdLam an lam_variant matches) = do+    an0 <- markEpAnnL an lidl AnnLam+    an1 <- case lam_variant of+             LamSingle -> return an0+             LamCase -> markEpAnnL an0 lidl AnnCase+             LamCases -> markEpAnnL an0 lidl AnnCases+    matches' <- markAnnotated matches+    return (HsCmdLam an1 lam_variant matches')++  exact (HsCmdPar (lpar, rpar) e) = do+    lpar' <- markEpToken lpar+    e' <- markAnnotated e+    rpar' <- markEpToken rpar+    return (HsCmdPar (lpar', rpar') e')++  exact (HsCmdCase an e alts) = do+    an0 <- markLensKw an lhsCaseAnnCase AnnCase+    e' <- markAnnotated e+    an1 <- markLensKw an0 lhsCaseAnnOf AnnOf+    an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC+    an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi+    alts' <- markAnnotated alts+    an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC+    return (HsCmdCase an4 e' alts')++  exact (HsCmdIf an a e1 e2 e3) = do+    an0 <- markLensKw an laiIf AnnIf+    e1' <- markAnnotated e1+    an1 <- markLensKwM' an0 laiThenSemi AnnSemi+    an2 <- markLensKw an1 laiThen AnnThen+    e2' <- markAnnotated e2+    an3 <- markLensKwM' an2 laiElseSemi AnnSemi+    an4 <- markLensKw an3 laiElse AnnElse+    e3' <- markAnnotated e3+    return (HsCmdIf an4 a e1' e2' e3')++  exact (HsCmdLet (tkLet, tkIn) binds e) = do+    setLayoutBoth $ do -- Make sure the 'in' gets indented too+      tkLet' <- markEpToken tkLet+      binds' <- setLayoutBoth $ markAnnotated binds+      tkIn' <- markEpToken tkIn+      e' <- markAnnotated e+      return (HsCmdLet (tkLet', tkIn') binds' e')++  exact (HsCmdDo an es) = do+    debugM $ "HsCmdDo"+    an0 <- markEpAnnL an lal_rest AnnDo+    es' <- markAnnotated es+    return (HsCmdDo an0 es')++-- ---------------------------------------------------------------------++instance (+  ExactPrint (LocatedA (body GhcPs)),+                 Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,+           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnL,+           (ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))+   => ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _s = a++  exact (LastStmt a body b c) = do+    debugM $ "LastStmt"+    body' <- markAnnotated body+    return (LastStmt a body' b c)++  exact (BindStmt an pat body) = do+    debugM $ "BindStmt"+    pat' <- markAnnotated pat+    an0 <- markEpAnnL an lidl AnnLarrow+    body' <- markAnnotated body+    return (BindStmt an0 pat' body')++  exact (ApplicativeStmt _ _body _) = do+    error $ "ApplicativeStmt is introduced in the renamer"++  exact (BodyStmt a body b c) = do+    debugM $ "BodyStmt"+    body' <- markAnnotated body+    return (BodyStmt a body' b c)++  exact (LetStmt an binds) = do+    debugM $ "LetStmt"+    an0 <- markEpAnnL an lidl AnnLet+    binds' <- markAnnotated binds+    return (LetStmt an0 binds')++  exact (ParStmt a pbs b c) = do+    debugM $ "ParStmt"+    pbs' <- markAnnotated pbs+    return (ParStmt a pbs' b c)++  exact (TransStmt an form stmts b using by c d e) = do+    debugM $ "TransStmt"+    stmts' <- markAnnotated stmts+    (an', by', using') <- exactTransStmt an by using form+    return (TransStmt an' form stmts' b using' by' c d e)++  exact (RecStmt an stmts a b c d e) = do+    debugM $ "RecStmt"+    an0 <- markEpAnnL an lal_rest AnnRec+    (an1, stmts') <- markAnnList' an0 (markAnnotated stmts)+    return (RecStmt an1 stmts' a b c d e)++-- ---------------------------------------------------------------------++instance ExactPrint (ParStmtBlock GhcPs GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (ParStmtBlock a stmts b c) = do+    stmts' <- markAnnotated stmts+    return (ParStmtBlock a stmts' b c)++exactTransStmt :: (Monad m, Monoid w)+  => [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm+  -> EP w m ([AddEpAnn], Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))+exactTransStmt an by using ThenForm = do+  debugM $ "exactTransStmt:ThenForm"+  an0 <- markEpAnnL an lidl AnnThen+  using' <- markAnnotated using+  case by of+    Nothing -> return (an0, by, using')+    Just b -> do+      an1 <- markEpAnnL an0 lidl AnnBy+      b' <- markAnnotated b+      return (an1, Just b', using')+exactTransStmt an by using GroupForm = do+  debugM $ "exactTransStmt:GroupForm"+  an0 <- markEpAnnL an lidl AnnThen+  an1 <- markEpAnnL an0 lidl AnnGroup+  (an2, by') <- case by of+    Nothing -> return (an1, by)+    Just b -> do+      an2 <- markEpAnnL an1 lidl AnnBy+      b' <- markAnnotated b+      return (an2, Just b')+  an3 <- markEpAnnL an2 lidl AnnUsing+  using' <- markAnnotated using+  return (an3, by', using')++-- ---------------------------------------------------------------------++instance ExactPrint (TyClDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _s = a++  exact (FamDecl a decl) = do+    decl' <- markAnnotated decl+    return (FamDecl a decl')++  exact (SynDecl { tcdSExt = an+                 , tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity+                 , tcdRhs = rhs }) = do+    -- There may be arbitrary parens around parts of the constructor+    -- that are infix.  Turn these into comments so that they feed+    -- into the right place automatically+    -- TODO: no longer sorting on insert. What now?+    an0 <- annotationsToComments an lidl [AnnOpenP,AnnCloseP]+    an1 <- markEpAnnL an0 lidl AnnType++    (_anx, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing+    an2 <- markEpAnnL an1 lidl AnnEqual+    rhs' <- markAnnotated rhs+    return (SynDecl { tcdSExt = an2+                    , tcdLName = ltycon', tcdTyVars = tyvars', tcdFixity = fixity+                    , tcdRhs = rhs' })++  -- TODO: add a workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/20452+  exact (DataDecl { tcdDExt = an, tcdLName = ltycon, tcdTyVars = tyvars+                  , tcdFixity = fixity, tcdDataDefn = defn }) = do+    (_, an', ltycon', tyvars', _, defn') <-+      exactDataDefn an (exactVanillaDeclHead ltycon tyvars fixity) defn+    return (DataDecl { tcdDExt = an', tcdLName = ltycon', tcdTyVars = tyvars'+                     , tcdFixity = fixity, tcdDataDefn = defn' })++  -- -----------------------------------++  exact (ClassDecl {tcdCExt = (an, lo, sortKey),+                    tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,+                    tcdFixity = fixity,+                    tcdFDs  = fds,+                    tcdSigs = sigs, tcdMeths = methods,+                    tcdATs = ats, tcdATDefs = at_defs,+                    tcdDocs = _docs})+      -- TODO: add a test that demonstrates tcdDocs+      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part+      = do+          (an0, fds', lclas', tyvars',context') <- top_matter+          an1 <- markEpAnnL an0 lidl AnnOpenC+          an2 <- markEpAnnL an1 lidl AnnCloseC+          return (ClassDecl {tcdCExt = (an2, lo, sortKey),+                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',+                             tcdFixity = fixity,+                             tcdFDs  = fds',+                             tcdSigs = sigs, tcdMeths = methods,+                             tcdATs = ats, tcdATDefs = at_defs,+                             tcdDocs = _docs})++      | otherwise       -- Laid out+      = do+          (an0, fds', lclas', tyvars',context') <- top_matter+          an1 <- markEpAnnL    an0 lidl AnnOpenC+          an2 <- markEpAnnAllL' an1 lidl AnnSemi+          (sortKey', ds) <- withSortKey sortKey+                               [(ClsSigTag, prepareListAnnotationA sigs),+                                (ClsMethodTag, prepareListAnnotationA (bagToList methods)),+                                (ClsAtTag, prepareListAnnotationA ats),+                                (ClsAtdTag, prepareListAnnotationA at_defs)+                             -- ++ prepareListAnnotation docs+                               ]+          an3 <- markEpAnnL an2 lidl AnnCloseC+          let+            sigs'    = undynamic ds+            methods' = listToBag $ undynamic ds+            ats'     = undynamic ds+            at_defs' = undynamic ds+          return (ClassDecl {tcdCExt = (an3, lo, sortKey'),+                             tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',+                             tcdFixity = fixity,+                             tcdFDs  = fds',+                             tcdSigs = sigs', tcdMeths = methods',+                             tcdATs = ats', tcdATDefs = at_defs',+                             tcdDocs = _docs})+      where+        top_matter = do+          an' <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]+          an0 <- markEpAnnL an' lidl AnnClass+          (_, lclas', tyvars',_,context') <-  exactVanillaDeclHead lclas tyvars fixity context+          (an1, fds') <- if (null fds)+            then return (an0, fds)+            else do+              an1 <- markEpAnnL an0 lidl AnnVbar+              fds' <- markAnnotated fds+              return (an1, fds')+          an2 <- markEpAnnL an1 lidl AnnWhere+          return (an2, fds', lclas', tyvars',context')+++-- ---------------------------------------------------------------------++instance ExactPrint (FunDep GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (FunDep an ls rs') = do+    ls' <- markAnnotated ls+    an0 <- markEpAnnL an lidl AnnRarrow+    rs'' <- markAnnotated rs'+    return (FunDep an0 ls' rs'')++-- ---------------------------------------------------------------------++instance ExactPrint (FamilyDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (FamilyDecl { fdExt = an+                    , fdInfo = info+                    , fdTopLevel = top_level+                    , fdLName = ltycon+                    , fdTyVars = tyvars+                    , fdFixity = fixity+                    , fdResultSig = L lr result+                    , fdInjectivityAnn = mb_inj }) = do+    an0 <- exactFlavour an info+    an1 <- exact_top_level an0+    an2 <- annotationsToComments an1 lidl [AnnOpenP,AnnCloseP]+    (_, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing+    (an3, result') <- exact_kind an2+    (an4, mb_inj') <-+      case mb_inj of+        Nothing -> return (an3, mb_inj)+        Just inj -> do+          an4 <- markEpAnnL an3 lidl AnnVbar+          inj' <- markAnnotated inj+          return (an4, Just inj')+    (an5, info') <-+             case info of+               ClosedTypeFamily mb_eqns -> do+                 an5 <- markEpAnnL an4 lidl AnnWhere+                 an6 <- markEpAnnL an5 lidl AnnOpenC+                 (an7, mb_eqns') <-+                   case mb_eqns of+                     Nothing -> do+                       an7 <- markEpAnnL an6 lidl AnnDotdot+                       return (an7, mb_eqns)+                     Just eqns -> do+                       eqns' <- markAnnotated eqns+                       return (an6, Just eqns')+                 an8 <- markEpAnnL an7 lidl AnnCloseC+                 return (an8, ClosedTypeFamily mb_eqns')+               _ -> return (an4, info)+    return (FamilyDecl { fdExt = an5+                       , fdInfo = info'+                       , fdTopLevel = top_level+                       , fdLName = ltycon'+                       , fdTyVars = tyvars'+                       , fdFixity = fixity+                       , fdResultSig = L lr result'+                       , fdInjectivityAnn = mb_inj' })+    where+      exact_top_level an' =+        case top_level of+          TopLevel    -> markEpAnnL an' lidl AnnFamily+          NotTopLevel -> do+            -- It seems that in some kind of legacy+            -- mode the 'family' keyword is still+            -- accepted.+            markEpAnnL an' lidl AnnFamily++      exact_kind an' =+        case result of+          NoSig    _         -> return (an', result)+          KindSig  x kind    -> do+            an0 <- markEpAnnL an' lidl AnnDcolon+            kind' <- markAnnotated kind+            return (an0, KindSig  x kind')+          TyVarSig x tv_bndr -> do+            an0 <- markEpAnnL an' lidl AnnEqual+            tv_bndr' <- markAnnotated tv_bndr+            return (an0, TyVarSig x tv_bndr')+++exactFlavour :: (Monad m, Monoid w) => [AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]+exactFlavour an DataFamily            = markEpAnnL an lidl AnnData+exactFlavour an OpenTypeFamily        = markEpAnnL an lidl AnnType+exactFlavour an (ClosedTypeFamily {}) = markEpAnnL an lidl AnnType++-- ---------------------------------------------------------------------++exactDataDefn+  :: (Monad m, Monoid w)+  => [AddEpAnn]+  -> (Maybe (LHsContext GhcPs) -> EP w m ([AddEpAnn]+                                         , LocatedN RdrName+                                         , a+                                         , b+                                         , Maybe (LHsContext GhcPs))) -- Printing the header+  -> HsDataDefn GhcPs+  -> EP w m ( [AddEpAnn] -- ^ from exactHdr+            , [AddEpAnn] -- ^ updated one passed in+            , LocatedN RdrName, a, b, HsDataDefn GhcPs)+exactDataDefn an exactHdr+                 (HsDataDefn { dd_ext = x, dd_ctxt = context+                             , dd_cType = mb_ct+                             , dd_kindSig = mb_sig+                             , dd_cons = condecls, dd_derivs = derivings }) = do++  an' <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]++  an0 <- case condecls of+    DataTypeCons is_type_data _ -> do+      an0' <- if is_type_data+                then markEpAnnL an' lidl AnnType+                else return an'+      markEpAnnL an0' lidl AnnData+    NewTypeCon   _ -> markEpAnnL an' lidl AnnNewtype++  an1 <- markEpAnnL an0 lidl AnnInstance -- optional+  mb_ct' <- mapM markAnnotated mb_ct+  (anx, ln', tvs', b, context') <- exactHdr context+  (an2, mb_sig') <- case mb_sig of+    Nothing -> return (an1, Nothing)+    Just kind -> do+      an2 <- markEpAnnL an1 lidl AnnDcolon+      kind' <- markAnnotated kind+      return (an2, Just kind')+  an3 <- if (needsWhere condecls)+    then markEpAnnL an2 lidl AnnWhere+    else return an2+  an4 <- markEpAnnL an3 lidl AnnOpenC+  (an5, condecls') <- exact_condecls an4 (toList condecls)+  let condecls'' = case condecls of+        DataTypeCons d _ -> DataTypeCons d condecls'+        NewTypeCon _     -> case condecls' of+          [decl] -> NewTypeCon decl+          _ -> panic "exacprint NewTypeCon"+  an6 <- markEpAnnL an5 lidl AnnCloseC+  derivings' <- mapM markAnnotated derivings+  return (anx, an6, ln', tvs', b,+                 (HsDataDefn { dd_ext = x, dd_ctxt = context'+                             , dd_cType = mb_ct'+                             , dd_kindSig = mb_sig'+                             , dd_cons = condecls'', dd_derivs = derivings' }))+++exactVanillaDeclHead :: (Monad m, Monoid w)+                     => LocatedN RdrName+                     -> LHsQTyVars GhcPs+                     -> LexicalFixity+                     -> Maybe (LHsContext GhcPs)+                     -> EP w m ( [AddEpAnn]+                               , LocatedN RdrName+                               , LHsQTyVars GhcPs+                               , (), Maybe (LHsContext GhcPs))+exactVanillaDeclHead thing tvs@(HsQTvs { hsq_explicit = tyvars }) fixity context = do+  let+    exact_tyvars (varl:varsr)+      | hvarsr : tvarsr@(_ : _) <- varsr+      , fixity == Infix = do+          varl' <- markAnnotated varl+          thing' <- markAnnotated thing+          hvarsr' <- markAnnotated hvarsr+          tvarsr' <- markAnnotated tvarsr+          return (thing', varl':hvarsr':tvarsr')+      | fixity == Infix = do+          varl' <- markAnnotated varl+          thing' <- markAnnotated thing+          varsr' <- markAnnotated varsr+          return (thing', varl':varsr')+      | otherwise = do+          thing' <- markAnnotated thing+          vs <- mapM markAnnotated (varl:varsr)+          return (thing', vs)+    exact_tyvars [] = do+      thing' <- markAnnotated thing+      return (thing', [])+  context' <- mapM markAnnotated context+  (thing', tyvars') <- exact_tyvars tyvars+  return (noAnn, thing', tvs { hsq_explicit = tyvars' }, (), context')++-- ---------------------------------------------------------------------++instance ExactPrint (InjectivityAnn GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (InjectivityAnn an lhs rhs) = do+    an0 <- markEpAnnL an lidl AnnVbar+    lhs' <- markAnnotated lhs+    an1 <- markEpAnnL an0 lidl AnnRarrow+    rhs' <- mapM markAnnotated rhs+    return (InjectivityAnn an1 lhs' rhs')++-- ---------------------------------------------------------------------++class Typeable flag => ExactPrintTVFlag flag where+  exactTVDelimiters :: (Monad m, Monoid w)+    => [AddEpAnn] -> flag+    -> ([AddEpAnn] -> EP w m ([AddEpAnn], HsTyVarBndr flag GhcPs))+    -> EP w m ([AddEpAnn], flag, (HsTyVarBndr flag GhcPs))++instance ExactPrintTVFlag () where+  exactTVDelimiters an flag thing_inside = do+    an0 <- markEpAnnAllL' an lid AnnOpenP+    (an1, r) <- thing_inside an0+    an2 <- markEpAnnAllL' an1 lid AnnCloseP+    return (an2, flag, r)++instance ExactPrintTVFlag Specificity where+  exactTVDelimiters an s thing_inside = do+    an0 <- markEpAnnAllL' an lid open+    (an1, r) <- thing_inside an0+    an2 <- markEpAnnAllL' an1 lid close+    return (an2, s, r)+    where+      (open, close) = case s of+        SpecifiedSpec -> (AnnOpenP, AnnCloseP)+        InferredSpec  -> (AnnOpenC, AnnCloseC)++instance ExactPrintTVFlag (HsBndrVis GhcPs) where+  exactTVDelimiters an0 bvis thing_inside = do+    bvis' <- case bvis of+      HsBndrRequired _ -> return bvis+      HsBndrInvisible at -> HsBndrInvisible <$> markEpToken at+    an1 <- markEpAnnAllL' an0 lid AnnOpenP+    (an2, r) <- thing_inside an1+    an3 <- markEpAnnAllL' an2 lid AnnCloseP+    return (an3, bvis', r)++instance ExactPrintTVFlag flag => ExactPrint (HsTyVarBndr flag GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (UserTyVar an flag n) = do+    r <- exactTVDelimiters an flag $ \ani -> do+           n' <- markAnnotated n+           return (ani, UserTyVar an flag n')+    case r of+      (an', flag', UserTyVar _ _ n'') -> return (UserTyVar an' flag' n'')+      _ -> error "KindedTyVar should never happen here"+  exact (KindedTyVar an flag n k) = do+    r <- exactTVDelimiters an flag $ \ani -> do+          n' <- markAnnotated n+          an0 <- markEpAnnL ani lidl AnnDcolon+          k' <- markAnnotated k+          return (an0, KindedTyVar an0 flag n' k')+    case r of+      (an',flag', KindedTyVar _ _ n'' k'') -> return (KindedTyVar an' flag' n'' k'')+      _ -> error "UserTyVar should never happen here"++-- ---------------------------------------------------------------------++instance ExactPrint (HsType GhcPs) where+  getAnnotationEntry _         = NoEntryVal+  setAnnotationAnchor a _ _ _s = a++  exact (HsForAllTy { hst_xforall = an+                    , hst_tele = tele, hst_body = ty }) = do+    tele' <- markAnnotated tele+    ty' <- markAnnotated ty+    return (HsForAllTy { hst_xforall = an+                       , hst_tele = tele', hst_body = ty' })++  exact (HsQualTy an ctxt ty) = do+    ctxt' <- markAnnotated ctxt+    ty' <- markAnnotated ty+    return (HsQualTy an ctxt' ty')+  exact (HsTyVar an promoted name) = do+    an0 <- if (promoted == IsPromoted)+             then markEpAnnL an lidl AnnSimpleQuote+             else return an+    name' <- markAnnotated name+    return (HsTyVar an0 promoted name')+  exact (HsAppTy an t1 t2) = do+    t1' <- markAnnotated t1+    t2' <- markAnnotated t2+    return (HsAppTy an t1' t2')+  exact (HsAppKindTy at ty ki) = do+    ty' <- markAnnotated ty+    at' <- markEpToken at+    ki' <- markAnnotated ki+    return (HsAppKindTy at' ty' ki')+  exact (HsFunTy an mult ty1 ty2) = do+    ty1' <- markAnnotated ty1+    mult' <- markArrow mult+    ty2' <- markAnnotated ty2+    return (HsFunTy an mult' ty1' ty2')+  exact (HsListTy an tys) = do+    an0 <- markOpeningParen an+    tys' <- markAnnotated tys+    an1 <- markClosingParen an0+    return (HsListTy an1 tys')+  exact (HsTupleTy an con tys) = do+    an0 <- markOpeningParen an+    tys' <- markAnnotated tys+    an1 <- markClosingParen an0+    return (HsTupleTy an1 con tys')+  exact (HsSumTy an tys) = do+    an0 <- markOpeningParen an+    tys' <- markAnnotated tys+    an1 <- markClosingParen an0+    return (HsSumTy an1 tys')+  exact (HsOpTy an promoted t1 lo t2) = do+    an0 <- if (isPromoted promoted)+        then markEpAnnL an lidl AnnSimpleQuote+        else return an+    t1' <- markAnnotated t1+    lo' <- markAnnotated lo+    t2' <- markAnnotated t2+    return (HsOpTy an0 promoted t1' lo' t2')+  exact (HsParTy an ty) = do+    an0 <- markOpeningParen an+    ty' <- markAnnotated ty+    an1 <- markClosingParen an0+    return (HsParTy an1 ty')+  exact (HsIParamTy an n t) = do+    n' <- markAnnotated n+    an0 <- markEpAnnL an lidl AnnDcolon+    t' <- markAnnotated t+    return (HsIParamTy an0 n' t')+  exact (HsStarTy an isUnicode) = do+    if isUnicode+        then printStringAdvance "\x2605" -- Unicode star+        else printStringAdvance "*"+    return (HsStarTy an isUnicode)+  exact (HsKindSig an ty k) = do+    ty' <- markAnnotated ty+    an0 <- markEpAnnL an lidl AnnDcolon+    k' <- markAnnotated k+    return (HsKindSig an0 ty' k')+  exact (HsSpliceTy a splice) = do+    splice' <- markAnnotated splice+    return (HsSpliceTy a splice')+  exact (HsDocTy an ty doc) = do+    ty' <- markAnnotated ty+    return (HsDocTy an ty' doc)+  exact (HsBangTy an (HsSrcBang mt up str) ty) = do+    an0 <-+      case mt of+        NoSourceText -> return an+        SourceText src -> do+          debugM $ "HsBangTy: src=" ++ showAst src+          an0 <- markEpAnnMS' an AnnOpen  (Just $ unpackFS src)+          an1 <- markEpAnnMS' an0 AnnClose (Just "#-}")+          debugM $ "HsBangTy: done unpackedness"+          return an1+    an1 <-+      case str of+        SrcLazy     -> mark an0 AnnTilde+        SrcStrict   -> mark an0 AnnBang+        NoSrcStrict -> return an0+    ty' <- markAnnotated ty+    return (HsBangTy an1 (HsSrcBang mt up str) ty')+  exact (HsExplicitListTy an prom tys) = do+    an0 <- if (isPromoted prom)+             then mark an AnnSimpleQuote+             else return an+    an1 <- mark an0 AnnOpenS+    tys' <- markAnnotated tys+    an2 <- mark an1 AnnCloseS+    return (HsExplicitListTy an2 prom tys')+  exact (HsExplicitTupleTy an tys) = do+    an0 <- mark an AnnSimpleQuote+    an1 <- mark an0 AnnOpenP+    tys' <- markAnnotated tys+    an2 <- mark an1 AnnCloseP+    return (HsExplicitTupleTy an2 tys')+  exact (HsTyLit a lit) = do+    case lit of+      (HsNumTy src v) -> printSourceText src (show v)+      (HsStrTy src v) -> printSourceText src (show v)+      (HsCharTy src v) -> printSourceText src (show v)+    return (HsTyLit a lit)+  exact t@(HsWildCardTy _) = printStringAdvance "_" >> return t+  exact x = error $ "missing match for HsType:" ++ showAst x++-- ---------------------------------------------------------------------++instance ExactPrint (HsForAllTelescope GhcPs) where+  getAnnotationEntry (HsForAllVis an _)   = fromAnn an+  getAnnotationEntry (HsForAllInvis an _) = fromAnn an++  setAnnotationAnchor (HsForAllVis an a) anc ts cs = HsForAllVis (setAnchorEpa an anc ts cs) a+  setAnnotationAnchor (HsForAllInvis an a) anc ts cs = HsForAllInvis (setAnchorEpa an anc ts cs) a++  exact (HsForAllVis an bndrs)   = do+    an0 <- markLensAA an lfst -- AnnForall+    bndrs' <- markAnnotated bndrs+    an1 <- markLensAA an0 lsnd -- AnnRarrow+    return (HsForAllVis an1 bndrs')++  exact (HsForAllInvis an bndrs) = do+    an0 <- markLensAA an lfst -- AnnForall+    bndrs' <- markAnnotated bndrs+    an1 <- markLensAA an0 lsnd -- AnnDot+    return (HsForAllInvis an1 bndrs')++-- ---------------------------------------------------------------------++instance ExactPrint (HsDerivingClause GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsDerivingClause { deriv_clause_ext      = an+                          , deriv_clause_strategy = dcs+                          , deriv_clause_tys      = dct }) = do+    an0 <- markEpAnnL an lidl AnnDeriving+    dcs0 <- case dcs of+            Just (L _ ViaStrategy{}) -> return dcs+            _ -> mapM markAnnotated dcs+    dct' <- markAnnotated dct+    dcs1 <- case dcs0 of+            Just (L _ ViaStrategy{}) -> mapM markAnnotated dcs0+            _ -> return dcs0+    return (HsDerivingClause { deriv_clause_ext      = an0+                             , deriv_clause_strategy = dcs1+                             , deriv_clause_tys      = dct' })++-- ---------------------------------------------------------------------++instance ExactPrint (DerivStrategy GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (StockStrategy an)    = do+    an0 <- markEpAnnL an lid AnnStock+    return (StockStrategy an0)+  exact (AnyclassStrategy an) = do+    an0 <- markEpAnnL an lid AnnAnyclass+    return (AnyclassStrategy an0)+  exact (NewtypeStrategy an)  = do+    an0 <- markEpAnnL an lid AnnNewtype+    return (NewtypeStrategy an0)+  exact (ViaStrategy (XViaStrategyPs an ty)) = do+    an0 <- markEpAnnL an lid AnnVia+    ty' <- markAnnotated ty+    return (ViaStrategy (XViaStrategyPs an0 ty'))++-- ---------------------------------------------------------------------++instance (ExactPrint a) => ExactPrint (LocatedC a) where+  getAnnotationEntry (L sann _) = fromAnn sann+  setAnnotationAnchor = setAnchorAn++  exact (L (EpAnn anc (AnnContext ma opens closes) cs) a) = do+    opens' <- mapM (markKwA AnnOpenP) opens+    a' <- markAnnotated a+    closes' <- mapM (markKwA AnnCloseP) closes+    return (L (EpAnn anc (AnnContext ma opens' closes') cs) a')++-- ---------------------------------------------------------------------++instance ExactPrint (DerivClauseTys GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (DctSingle x ty) = do+    ty' <- markAnnotated ty+    return (DctSingle x ty')+  exact (DctMulti x tys) = do+    tys' <- markAnnotated tys+    return (DctMulti x tys')++-- ---------------------------------------------------------------------++instance ExactPrint (HsSigType GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsSig a bndrs ty) = do+    bndrs' <- markAnnotated bndrs+    ty' <- markAnnotated ty+    return (HsSig a bndrs' ty')++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedN RdrName) where+  getAnnotationEntry (L sann _) = fromAnn sann+  setAnnotationAnchor = setAnchorAn++  exact (L (EpAnn anc ann cs) n) = do+    ann' <-+      case ann of+        NameAnn a o l c t -> do+          mn <- markName a o (Just (l,n)) c+          case mn of+            (o', (Just (l',_n)), c') -> do+              return (NameAnn a o' l' c' t)+            _ -> error "ExactPrint (LocatedN RdrName)"+        NameAnnCommas a o commas c t -> do+          let (kwo,kwc) = adornments a+          (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn kwo o)+          commas' <- forM commas (\loc -> locFromAdd <$> markKwC NoCaptureComments (AddEpAnn AnnComma loc))+          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)+          return (NameAnnCommas a o' commas' c' t)+        NameAnnBars a o bars c t -> do+          let (kwo,kwc) = adornments a+          (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn kwo o)+          bars' <- forM bars (\loc -> locFromAdd <$> markKwC NoCaptureComments (AddEpAnn AnnVbar loc))+          (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn kwc c)+          return (NameAnnBars a o' bars' c' t)+        NameAnnOnly a o c t -> do+          (o',_,c') <- markName a o Nothing c+          return (NameAnnOnly a o' c' t)+        NameAnnRArrow unicode o nl c t -> do+          o' <- case o of+            Just o0 -> do+              (AddEpAnn _ o') <- markKwC NoCaptureComments (AddEpAnn AnnOpenP o0)+              return (Just o')+            Nothing -> return Nothing+          (AddEpAnn _ nl') <-+            if unicode+              then markKwC NoCaptureComments (AddEpAnn AnnRarrowU nl)+              else markKwC NoCaptureComments (AddEpAnn AnnRarrow nl)+          c' <- case c of+            Just c0 -> do+              (AddEpAnn _ c') <- markKwC NoCaptureComments (AddEpAnn AnnCloseP c0)+              return (Just c')+            Nothing -> return Nothing+          return (NameAnnRArrow unicode o' nl' c' t)+        NameAnnQuote q name t -> do+          debugM $ "NameAnnQuote"+          (AddEpAnn _ q') <- markKwC NoCaptureComments (AddEpAnn AnnSimpleQuote q)+          (L name' _) <- markAnnotated (L name n)+          return (NameAnnQuote q' name' t)+        NameAnnTrailing t -> do+          _anc' <- printUnicode anc n+          return (NameAnnTrailing t)+    return (L (EpAnn anc ann' cs) n)++locFromAdd :: AddEpAnn -> EpaLocation+locFromAdd (AddEpAnn _ loc) = loc++printUnicode :: (Monad m, Monoid w) => Anchor -> RdrName -> EP w m Anchor+printUnicode anc n = do+  let str = case (showPprUnsafe n) of+            -- TODO: unicode support?+              "forall" -> if spanLength (anchor anc) == 1 then "∀" else "forall"+              s -> s+  loc <- printStringAtAAC NoCaptureComments (EpaDelta (SameLine 0) []) str+  case loc of+    EpaSpan _ -> return anc+    EpaDelta dp [] -> return $ EpaDelta dp []+    EpaDelta _ _cs -> error "printUnicode should not capture comments"+++markName :: (Monad m, Monoid w)+  => NameAdornment -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation+  -> EP w m (EpaLocation, Maybe (EpaLocation,RdrName), EpaLocation)+markName adorn open mname close = do+  let (kwo,kwc) = adornments adorn+  (AddEpAnn _ open') <- markKwC CaptureComments (AddEpAnn kwo open)+  mname' <-+    case mname of+      Nothing -> return Nothing+      Just (name, a) -> do+        name' <- printStringAtAAC CaptureComments name (showPprUnsafe a)+        return (Just (name',a))+  (AddEpAnn _ close') <- markKwC CaptureComments (AddEpAnn kwc close)+  return (open', mname', close')++adornments :: NameAdornment -> (AnnKeywordId, AnnKeywordId)+adornments NameParens     = (AnnOpenP, AnnCloseP)+adornments NameParensHash = (AnnOpenPH, AnnClosePH)+adornments NameBackquotes = (AnnBackquote, AnnBackquote)+adornments NameSquare     = (AnnOpenS, AnnCloseS)++markTrailing :: (Monad m, Monoid w) => [TrailingAnn] -> EP w m [TrailingAnn]+markTrailing ts = do+  p <- getPosP+  debugM $ "markTrailing:" ++ showPprUnsafe (p,ts)+  mapM markKwT ts++-- ---------------------------------------------------------------------++-- based on pp_condecls in Decls.hs+exact_condecls :: (Monad m, Monoid w)+  => [AddEpAnn] -> [LConDecl GhcPs] -> EP w m ([AddEpAnn],[LConDecl GhcPs])+exact_condecls an cs+  | gadt_syntax                  -- In GADT syntax+  = do+      cs' <- mapM markAnnotated cs+      return (an, cs')+  | otherwise                    -- In H98 syntax+  = do+      an0 <- markEpAnnL an lidl AnnEqual+      cs' <- mapM markAnnotated cs+      return (an0, cs')+  where+    gadt_syntax = case cs of+      []                      -> False+      (L _ ConDeclH98{}  : _) -> False+      (L _ ConDeclGADT{} : _) -> True++-- ---------------------------------------------------------------------++instance ExactPrint (ConDecl GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++-- based on pprConDecl+  exact (ConDeclH98 { con_ext = an+                    , con_name = con+                    , con_forall = has_forall+                    , con_ex_tvs = ex_tvs+                    , con_mb_cxt = mcxt+                    , con_args = args+                    , con_doc = doc }) = do+    an0 <- if has_forall+      then markEpAnnL an lidl AnnForall+      else return an+    ex_tvs' <- mapM markAnnotated ex_tvs+    an1 <- if has_forall+      then markEpAnnL an0 lidl AnnDot+      else return an0+    mcxt' <- mapM markAnnotated mcxt+    an2 <- if (isJust mcxt)+      then markEpAnnL an1 lidl AnnDarrow+      else return an1++    (con', args') <- exact_details args+    return (ConDeclH98 { con_ext = an2+                       , con_name = con'+                       , con_forall = has_forall+                       , con_ex_tvs = ex_tvs'+                       , con_mb_cxt = mcxt'+                       , con_args = args'+                       , con_doc = doc })++    where+    -- In ppr_details: let's not print the multiplicities (they are always 1, by+    -- definition) as they do not appear in an actual declaration.+      exact_details (InfixCon t1 t2) = do+        t1' <- markAnnotated t1+        con' <- markAnnotated con+        t2' <- markAnnotated t2+        return (con', InfixCon t1' t2')+      exact_details (PrefixCon tyargs tys) = do+        con' <- markAnnotated con+        tyargs' <- markAnnotated tyargs+        tys' <- markAnnotated tys+        return (con', PrefixCon tyargs' tys')+      exact_details (RecCon fields) = do+        con' <- markAnnotated con+        fields' <- markAnnotated fields+        return (con', RecCon fields')++  -- -----------------------------------++  exact (ConDeclGADT { con_g_ext = (dcol, an)+                     , con_names = cons+                     , con_bndrs = bndrs+                     , con_mb_cxt = mcxt, con_g_args = args+                     , con_res_ty = res_ty, con_doc = doc }) = do+    cons' <- mapM markAnnotated cons+    dcol' <- markEpUniToken dcol+    an1 <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]++    -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558+    bndrs' <- case bndrs of+      L _ (HsOuterImplicit _) -> return bndrs+      _ -> markAnnotated bndrs++    mcxt' <- mapM markAnnotated mcxt+    an2 <- if (isJust mcxt)+      then markEpAnnL an1 lidl AnnDarrow+      else return an1+    args' <-+      case args of+          (PrefixConGADT x args0) -> do+            args0' <- mapM markAnnotated args0+            return (PrefixConGADT x args0')+          (RecConGADT rarr fields) -> do+            fields' <- markAnnotated fields+            rarr' <- markEpUniToken rarr+            return (RecConGADT rarr' fields')+    res_ty' <- markAnnotated res_ty+    return (ConDeclGADT { con_g_ext = (dcol', an2)+                        , con_names = cons'+                        , con_bndrs = bndrs'+                        , con_mb_cxt = mcxt', con_g_args = args'+                        , con_res_ty = res_ty', con_doc = doc })++-- ---------------------------------------------------------------------++instance ExactPrint Void where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact x = return x++-- ---------------------------------------------------------------------++instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) where+  getAnnotationEntry (HsOuterImplicit _) = NoEntryVal+  getAnnotationEntry (HsOuterExplicit an _) = fromAnn an++  setAnnotationAnchor (HsOuterImplicit a) _ _ _ = HsOuterImplicit a+  setAnnotationAnchor (HsOuterExplicit an a) anc ts cs = HsOuterExplicit (setAnchorEpa an anc ts cs) a++  exact b@(HsOuterImplicit _) = pure b+  exact (HsOuterExplicit an bndrs) = do+    an0 <- markLensAA an lfst -- "forall"+    bndrs' <- markAnnotated bndrs+    an1 <- markLensAA an0 lsnd -- "."+    return (HsOuterExplicit an1 bndrs')++-- ---------------------------------------------------------------------++instance ExactPrint (ConDeclField GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (ConDeclField an names ftype mdoc) = do+    names' <- markAnnotated names+    an0 <- markEpAnnL an lidl AnnDcolon+    ftype' <- markAnnotated ftype+    return (ConDeclField an0 names' ftype' mdoc)++-- ---------------------------------------------------------------------++instance ExactPrint (FieldOcc GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (FieldOcc x n) = do+      n' <- markAnnotated n+      return (FieldOcc x n')++-- ---------------------------------------------------------------------++instance ExactPrint (AmbiguousFieldOcc GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact f@(Unambiguous _ n) = markAnnotated n >> return f+  exact f@(Ambiguous   _ n) = markAnnotated n >> return f++-- ---------------------------------------------------------------------++instance (ExactPrint a) => ExactPrint (HsScaled GhcPs a) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (HsScaled arr t) = do+    t' <- markAnnotated t+    arr' <- markArrow arr+    return (HsScaled arr' t')++-- ---------------------------------------------------------------------++instance ExactPrint (LocatedP CType) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  exact (L an (CType stp mh (stct,ct))) = do+    an0 <- markAnnOpenP an stp "{-# CTYPE"+    an1 <- case mh of+             Nothing -> return an0+             Just (Header srcH _h) ->+               markEpAnnLMS an0 lapr_rest AnnHeader (Just (toSourceTextWithSuffix srcH "" ""))+    an2 <- markEpAnnLMS an1 lapr_rest AnnVal (Just (toSourceTextWithSuffix stct (unpackFS ct) ""))+    an3 <- markAnnCloseP an2+    return (L an3 (CType stp mh (stct,ct)))++-- ---------------------------------------------------------------------++instance ExactPrint (SourceText, RuleName) where+  -- We end up at the right place from the Located wrapper+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (st, rn)+    = printStringAdvance (toSourceTextWithSuffix st (unpackFS rn) "")+      >> return (st, rn)+++-- =====================================================================+-- LocatedL instances start --+--+-- Each is dealt with specifically, as they have+-- different wrapping annotations in the al_rest zone.+--+-- In future, the annotation could perhaps be improved, with an+-- 'al_pre' and 'al_post' set of annotations to be simply sorted and+-- applied.+-- ---------------------------------------------------------------------++instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn++  exact (L an ies) = do+    debugM $ "LocatedL [LIE"+    an0 <- markEpAnnL' an lal_rest AnnHiding+    p <- getPosP+    debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p+    (an1, ies') <- markAnnList an0 (markAnnotated (filter notIEDoc ies))+    return (L an1 ies')++instance (ExactPrint (Match GhcPs (LocatedA body)))+   => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA body))]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L an a) = do+    debugM $ "LocatedL [LMatch"+    -- TODO: markAnnList?+    an0 <- markEpAnnAllL an lal_rest AnnWhere+    an1 <- markLensMAA an0 lal_open+    an2 <- markEpAnnAllL an1 lal_rest AnnSemi+    a' <- markAnnotated a+    an3 <- markLensMAA an2 lal_close+    return (L an3 a')++instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L an stmts) = do+    debugM $ "LocatedL [ExprLStmt"+    (an'', stmts') <- markAnnList an $ do+      case snocView stmts of+        Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do+          debugM $ "LocatedL [ExprLStmt: snocView"+          ls' <- markAnnotated ls+          initStmts' <- markAnnotated initStmts+          return (initStmts' ++ [ls'])+        _ -> do+          markAnnotated stmts+    return (L an'' stmts')++instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L ann es) = do+    debugM $ "LocatedL [CmdLStmt"+    an0 <- markLensMAA ann lal_open+    es' <- mapM markAnnotated es+    an1 <- markLensMAA an0 lal_close+    return (L an1 es')++instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L an fs) = do+    debugM $ "LocatedL [LConDeclField"+    (an', fs') <- markAnnList an (markAnnotated fs)+    return (L an' fs')++instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where+  getAnnotationEntry = entryFromLocatedA+  setAnnotationAnchor = setAnchorAn+  exact (L an bf) = do+    debugM $ "LocatedL [LBooleanFormula"+    (an', bf') <- markAnnList an (markAnnotated bf)+    return (L an' bf')++-- ---------------------------------------------------------------------+-- LocatedL instances end --+-- =====================================================================++instance ExactPrint (IE GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (IEVar depr ln doc) = do+    depr' <- markAnnotated depr+    ln' <- markAnnotated ln+    doc' <- markAnnotated doc+    return (IEVar depr' ln' doc')+  exact (IEThingAbs (depr, an) thing doc) = do+    depr' <- markAnnotated depr+    thing' <- markAnnotated thing+    doc' <- markAnnotated doc+    return (IEThingAbs (depr', an) thing' doc')+  exact (IEThingAll (depr, an) thing doc) = do+    depr' <- markAnnotated depr+    thing' <- markAnnotated thing+    an0 <- markEpAnnL an  lidl AnnOpenP+    an1 <- markEpAnnL an0 lidl AnnDotdot+    an2 <- markEpAnnL an1 lidl AnnCloseP+    doc' <- markAnnotated doc+    return (IEThingAll (depr', an2) thing' doc')++  exact (IEThingWith (depr, an) thing wc withs doc) = do+    depr' <- markAnnotated depr+    thing' <- markAnnotated thing+    an0 <- markEpAnnL an lidl AnnOpenP+    (an1, wc', withs') <-+      case wc of+        NoIEWildcard -> do+          withs'' <- markAnnotated withs+          return (an0, wc, withs'')+        IEWildcard pos -> do+          let (bs, as) = splitAt pos withs+          bs' <- markAnnotated bs+          an1 <- markEpAnnL an0 lidl AnnDotdot+          an2 <- markEpAnnL an1 lidl AnnComma+          as' <- markAnnotated as+          return (an2, wc, bs'++as')+    an2 <- markEpAnnL an1 lidl AnnCloseP+    doc' <- markAnnotated doc+    return (IEThingWith (depr', an2) thing' wc' withs' doc')++  exact (IEModuleContents (depr, an) m) = do+    depr' <- markAnnotated depr+    an0 <- markEpAnnL an lidl AnnModule+    m' <- markAnnotated m+    return (IEModuleContents (depr', an0) m')++  -- These three exist to not error out, but are no-ops The contents+  -- appear as "normal" comments too, which we process instead.+  exact (IEGroup x lev doc) = do+    return (IEGroup x lev doc)+  exact (IEDoc x doc) = do+    return (IEDoc x doc)+  exact (IEDocNamed x str) = do+    return (IEDocNamed x str)++-- ---------------------------------------------------------------------++instance ExactPrint (IEWrappedName GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (IEName x n) = do+    n' <- markAnnotated n+    return (IEName x n')+  exact (IEPattern r n) = do+    r' <- printStringAtAA r "pattern"+    n' <- markAnnotated n+    return (IEPattern r' n')+  exact (IEType r n) = do+    r' <- printStringAtAA r "type"+    n' <- markAnnotated n+    return (IEType r' n')++-- ---------------------------------------------------------------------++instance ExactPrint (Pat GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (WildPat w) = do+    anchor' <- getAnchorU+    debugM $ "WildPat:anchor'=" ++ show anchor'+    _ <- printStringAtRs anchor' "_"+    return (WildPat w)+  exact (VarPat x n) = do+    -- The parser inserts a placeholder value for a record pun rhs. This must be+    -- filtered.+    let pun_RDR = "pun-right-hand-side"+    n' <- if (showPprUnsafe n /= pun_RDR)+      then markAnnotated n+      else return n+    return (VarPat x n')+  exact (LazyPat an pat) = do+    an0 <- markEpAnnL an lidl AnnTilde+    pat' <- markAnnotated pat+    return (LazyPat an0 pat')+  exact (AsPat at n pat) = do+    n' <- markAnnotated n+    at' <- markEpToken at+    pat' <- markAnnotated pat+    return (AsPat at' n' pat')+  exact (ParPat (lpar, rpar) pat) = do+    lpar' <- markEpToken lpar+    pat' <- markAnnotated pat+    rpar' <- markEpToken rpar+    return (ParPat (lpar', rpar') pat')++  exact (BangPat an pat) = do+    an0 <- markEpAnnL an lidl AnnBang+    pat' <- markAnnotated pat+    return (BangPat an0 pat')++  exact (ListPat an pats) = do+    (an', pats') <- markAnnList' an (markAnnotated pats)+    return (ListPat an' pats')++  exact (TuplePat an pats boxity) = do+    an0 <- case boxity of+             Boxed   -> markEpAnnL an lidl AnnOpenP+             Unboxed -> markEpAnnL an lidl AnnOpenPH+    pats' <- markAnnotated pats+    an1 <- case boxity of+             Boxed   -> markEpAnnL an0 lidl AnnCloseP+             Unboxed -> markEpAnnL an0 lidl AnnClosePH+    return (TuplePat an1 pats' boxity)++  exact (SumPat an pat alt arity) = do+    an0 <- markEpAnnL an lsumPatParens AnnOpenPH+    an1 <- markAnnKwAllL an0 lsumPatVbarsBefore AnnVbar+    pat' <- markAnnotated pat+    an2 <- markAnnKwAllL an1 lsumPatVbarsAfter AnnVbar+    an3 <- markEpAnnL an2 lsumPatParens AnnClosePH+    return (SumPat an3 pat' alt arity)++  exact (ConPat an con details) = do+    (an', con', details') <- exactUserCon an con details+    return (ConPat an' con' details')+  exact (ViewPat an expr pat) = do+    expr' <- markAnnotated expr+    an0 <- markEpAnnL an lidl AnnRarrow+    pat' <- markAnnotated pat+    return (ViewPat an0 expr' pat')+  exact (SplicePat x splice) = do+    splice' <- markAnnotated splice+    return (SplicePat x splice')+  exact p@(LitPat _ lit) = printStringAdvance (hsLit2String lit) >> return p+  exact (NPat an ol mn z) = do+    an0 <- if (isJust mn)+      then markEpAnnL an lidl AnnMinus+      else return an+    ol' <- markAnnotated ol+    return (NPat an0 ol' mn z)++  exact (NPlusKPat an n k lit2 a b) = do+    n' <- markAnnotated n+    an' <- printStringAtAAL an lid "+"+    k' <- markAnnotated k+    return (NPlusKPat an' n' k' lit2 a b)++  exact (SigPat an pat sig) = do+    pat' <- markAnnotated pat+    an0 <- markEpAnnL an lidl AnnDcolon+    sig' <- markAnnotated sig+    return (SigPat an0 pat' sig')++  exact (EmbTyPat toktype tp) = do+    toktype' <- markEpToken toktype+    tp' <- markAnnotated tp+    return (EmbTyPat toktype' tp')++  exact (InvisPat tokat tp) = do+    tokat' <- markEpToken tokat+    tp' <- markAnnotated tp+    pure (InvisPat tokat' tp')++-- ---------------------------------------------------------------------++-- Note: Keep this section, for backport to GHC 9.10++-- instance ExactPrint (ArgPat GhcPs) where+--   getAnnotationEntry (VisPat _ pat) = getAnnotationEntry pat+--   getAnnotationEntry InvisPat{}     = NoEntryVal++--   setAnnotationAnchor (VisPat x pat) anc ts cs = VisPat x (setAnnotationAnchor pat anc ts cs)+--   setAnnotationAnchor a@(InvisPat _ _) _ _ _   = a++--   exact (VisPat x pat) = do+--     pat' <- markAnnotated pat+--     pure (VisPat x pat')++--   exact (InvisPat tokat tp) = do+--     tokat' <- markEpToken tokat+--     tp' <- markAnnotated tp+--     pure (InvisPat tokat' tp')++-- ---------------------------------------------------------------------++instance ExactPrint (HsPatSigType GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsPS an ty) = do+    ty' <- markAnnotated ty+    return (HsPS an ty')++instance ExactPrint (HsTyPat GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact (HsTP an ty) = do+    ty' <- markAnnotated ty+    return (HsTP an ty')++-- ---------------------------------------------------------------------++instance ExactPrint (HsOverLit GhcPs) where+  getAnnotationEntry = const NoEntryVal+  setAnnotationAnchor a _ _ _ = a++  exact ol =+    let str = case ol_val ol of+                HsIntegral   (IL src _ _) -> src+                HsFractional (FL{ fl_text = src }) -> src+                HsIsString src _ -> src+    in+      case str of+        SourceText s -> printStringAdvance (unpackFS s) >> return ol+        NoSourceText -> return ol++-- ---------------------------------------------------------------------++hsLit2String :: HsLit GhcPs -> String+hsLit2String lit =+  case lit of+    HsChar       src v   -> toSourceTextWithSuffix src v ""+    HsCharPrim   src p   -> toSourceTextWithSuffix src p ""+    HsString     src v   -> toSourceTextWithSuffix src v ""+    HsStringPrim src v   -> toSourceTextWithSuffix src v ""+    HsInt        _ (IL src _ v)   -> toSourceTextWithSuffix src v ""+    HsIntPrim    src v   -> toSourceTextWithSuffix src v ""+    HsWordPrim   src v   -> toSourceTextWithSuffix src v ""+    HsInt8Prim   src v   -> toSourceTextWithSuffix src v ""+    HsInt16Prim  src v   -> toSourceTextWithSuffix src v ""+    HsInt32Prim  src v   -> toSourceTextWithSuffix src v ""+    HsInt64Prim  src v   -> toSourceTextWithSuffix src v ""+    HsWord8Prim  src v   -> toSourceTextWithSuffix src v ""+    HsWord16Prim src v   -> toSourceTextWithSuffix src v ""+    HsWord32Prim src v   -> toSourceTextWithSuffix src v ""+    HsWord64Prim src v   -> toSourceTextWithSuffix src v ""+    HsInteger    src v _ -> toSourceTextWithSuffix src v ""+    HsRat        _ fl@(FL{fl_text = src }) _ -> toSourceTextWithSuffix src fl ""+    HsFloatPrim  _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "#"+    HsDoublePrim _ fl@(FL{fl_text = src })   -> toSourceTextWithSuffix src fl "##"++toSourceTextWithSuffix :: (Show a) => SourceText -> a -> String -> String+toSourceTextWithSuffix (NoSourceText)    alt suffix = show alt ++ suffix+toSourceTextWithSuffix (SourceText txt) _alt suffix = unpackFS txt ++ suffix++sourceTextToString :: SourceText -> String -> String+sourceTextToString NoSourceText alt   = alt+sourceTextToString (SourceText txt) _ = unpackFS txt++-- ---------------------------------------------------------------------++exactUserCon :: (Monad m, Monoid w, ExactPrint con)+  => [AddEpAnn] -> con -> HsConPatDetails GhcPs+  -> EP w m ([AddEpAnn], con, HsConPatDetails GhcPs)+exactUserCon an c (InfixCon p1 p2) = do+  p1' <- markAnnotated p1+  c' <- markAnnotated c+  p2' <- markAnnotated p2+  return (an, c', InfixCon p1' p2')+exactUserCon an c details = do+  c' <- markAnnotated c+  an0 <- markEpAnnL an lidl AnnOpenC+  details' <- exactConArgs details+  an1 <- markEpAnnL an0 lidl AnnCloseC+  return (an1, c', details')++instance ExactPrint (HsConPatTyArg GhcPs) where+  getAnnotationEntry _ = NoEntryVal+  setAnnotationAnchor a _ _ _ = a+  exact (HsConPatTyArg at tyarg) = do+    at' <- markEpToken at+    tyarg' <- markAnnotated tyarg+    return (HsConPatTyArg at' tyarg')++exactConArgs :: (Monad m, Monoid w)+  => HsConPatDetails GhcPs -> EP w m (HsConPatDetails GhcPs)+exactConArgs (PrefixCon tyargs pats) = do+  tyargs' <- markAnnotated tyargs+  pats' <- markAnnotated pats+  return (PrefixCon tyargs' pats')+exactConArgs (InfixCon p1 p2) = do+  p1' <- markAnnotated p1+  p2' <- markAnnotated p2+  return (InfixCon p1' p2')+exactConArgs (RecCon rpats) = do+  rpats' <- markAnnotated rpats+  return (RecCon rpats')++-- ---------------------------------------------------------------------++entryFromLocatedA :: (HasTrailing ann) => LocatedAn ann a -> Entry+entryFromLocatedA (L la _) = fromAnn la++-- =====================================================================+-- Utility stuff+-- ---------------------------------------------------------------------++-- |This should be the final point where things are mode concrete,+-- before output.+-- NOTE: despite the name, this is the ghc-exactprint final output for+-- the PRINT phase.+printStringAtLsDelta :: (Monad m, Monoid w) => DeltaPos -> String -> EP w m ()+printStringAtLsDelta cl s = do+  p <- getPosP+  colOffset <- getLayoutOffsetP+  if isGoodDeltaWithOffset cl colOffset+    then do+      printStringAt (undelta p cl colOffset) s+      p' <- getPosP+      d <- getPriorEndD+      debugM $ "printStringAtLsDelta:(pos,p,p',d,s):" ++ show (undelta p cl colOffset,p,p',d,s)+    else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))++-- ---------------------------------------------------------------------++isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool+isGoodDeltaWithOffset dp colOffset = isGoodDelta (deltaPos l c)+  where (l,c) = undelta (0,0) dp colOffset++-- | Print a comment, using the current layout offset to convert the+-- @DeltaPos@ to an absolute position.+printQueuedComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m ()+printQueuedComment Comment{commentContents} dp = do+  p <- getPosP+  d <- getPriorEndD+  colOffset <- getLayoutOffsetP+  let (dr,dc) = undelta (0,0) dp colOffset+  -- do not lose comments against the left margin+  when (isGoodDelta (deltaPos dr (max 0 dc))) $ do+    printCommentAt (undelta p dp colOffset) commentContents+  p' <- getPosP+  d' <- getPriorEndD+  debugM $ "printQueuedComment: (p,p',d,d')=" ++ show (p,p',d,d')+  debugM $ "printQueuedComment: (p,p',dp,colOffset,undelta)=" ++ show (p,p',dp,colOffset,undelta p dp colOffset)++------------------------------------------------------------------------++setLayoutBoth :: (Monad m, Monoid w) => EP w m a -> EP w m a+setLayoutBoth k = do+  oldLHS <- getLayoutOffsetD+  oldAnchorOffset <- getLayoutOffsetP+  debugM $ "setLayoutBoth: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)+  modify (\a -> a { dMarkLayout = True+                  , pMarkLayout = True } )+  let reset = do+        debugM $ "setLayoutBoth:reset: (oldLHS,oldAnchorOffset)=" ++ show (oldLHS,oldAnchorOffset)+        modify (\a -> a { dMarkLayout = False+                        , dLHS = oldLHS+                        , pMarkLayout = False+                        , pLHS = oldAnchorOffset} )+  k <* reset++-- Use 'local', designed for this+setLayoutTopLevelP :: (Monad m, Monoid w) => EP w m a -> EP w m a+setLayoutTopLevelP k = do+  debugM $ "setLayoutTopLevelP entered"+  oldAnchorOffset <- getLayoutOffsetP+  modify (\a -> a { pMarkLayout = False+                  , pLHS = 0} )+  r <- k+  debugM $ "setLayoutTopLevelP:resetting"+  setLayoutOffsetP oldAnchorOffset+  return r++------------------------------------------------------------------------++getPosP :: (Monad m, Monoid w) => EP w m Pos+getPosP = gets epPos++setPosP :: (Monad m, Monoid w) => Pos -> EP w m ()+setPosP l = do+  debugM $ "setPosP:" ++ show l+  modify (\s -> s {epPos = l})++getExtraDP :: (Monad m, Monoid w) => EP w m (Maybe Anchor)+getExtraDP = gets uExtraDP++setExtraDP :: (Monad m, Monoid w) => Maybe Anchor -> EP w m ()+setExtraDP md = do+  debugM $ "setExtraDP:" ++ show md+  modify (\s -> s {uExtraDP = md})++getExtraDPReturn :: (Monad m, Monoid w) => EP w m (Maybe DeltaPos)+getExtraDPReturn = gets uExtraDPReturn++setExtraDPReturn :: (Monad m, Monoid w) => Maybe DeltaPos -> EP w m ()+setExtraDPReturn md = do+  debugM $ "setExtraDPReturn:" ++ show md+  modify (\s -> s {uExtraDPReturn = md})++getPriorEndD :: (Monad m, Monoid w) => EP w m Pos+getPriorEndD = gets dPriorEndPosition++getAnchorU :: (Monad m, Monoid w) => EP w m RealSrcSpan+getAnchorU = gets uAnchorSpan++getAcceptSpan ::(Monad m, Monoid w) => EP w m Bool+getAcceptSpan = gets pAcceptSpan++setAcceptSpan ::(Monad m, Monoid w) => Bool -> EP w m ()+setAcceptSpan f =+  modify (\s -> s { pAcceptSpan = f })++setPriorEndD :: (Monad m, Monoid w) => Pos -> EP w m ()+setPriorEndD pe = do+  setPriorEndNoLayoutD pe++setPriorEndNoLayoutD :: (Monad m, Monoid w) => Pos -> EP w m ()+setPriorEndNoLayoutD pe = do+  debugM $ "setPriorEndNoLayoutD:pe=" ++ show pe+  modify (\s -> s { dPriorEndPosition = pe })++setPriorEndASTD :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()+setPriorEndASTD pe = setPriorEndASTPD (rs2range pe)++setPriorEndASTPD :: (Monad m, Monoid w) => (Pos,Pos) -> EP w m ()+setPriorEndASTPD pe@(fm,to) = do+  debugM $ "setPriorEndASTD:pe=" ++ show pe+  setLayoutStartD (snd fm)+  modify (\s -> s { dPriorEndPosition = to } )++setLayoutStartD :: (Monad m, Monoid w) => Int -> EP w m ()+setLayoutStartD p = do+  EPState{dMarkLayout} <- get+  when dMarkLayout $ do+    debugM $ "setLayoutStartD: setting dLHS=" ++ show p+    modify (\s -> s { dMarkLayout = False+                    , dLHS = LayoutStartCol p})++getLayoutOffsetD :: (Monad m, Monoid w) => EP w m LayoutStartCol+getLayoutOffsetD = gets dLHS++setAnchorU :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()+setAnchorU rss = do+  debugM $ "setAnchorU:" ++ show (rs2range rss)+  modify (\s -> s { uAnchorSpan = rss })++getEofPos :: (Monad m, Monoid w) => EP w m (Maybe (RealSrcSpan, RealSrcSpan))+getEofPos = gets epEof++setEofPos :: (Monad m, Monoid w) => Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()+setEofPos l = modify (\s -> s {epEof = l})++-- ---------------------------------------------------------------------++getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]+getUnallocatedComments = gets epComments++putUnallocatedComments :: (Monad m, Monoid w) => [Comment] -> EP w m ()+putUnallocatedComments !cs = modify (\s -> s { epComments = cs } )++-- | Push a fresh stack frame for the applied comments gatherer+pushAppliedComments  :: (Monad m, Monoid w) => EP w m ()+pushAppliedComments = modify (\s -> s { epCommentsApplied = []:(epCommentsApplied s) })++-- | Return the comments applied since the last call+-- takeAppliedComments, and clear them, not popping the stack+takeAppliedComments :: (Monad m, Monoid w) => EP w m [Comment]+takeAppliedComments = do+  !ccs <- gets epCommentsApplied+  case ccs of+    [] -> do+      modify (\s -> s { epCommentsApplied = [] })+      return []+    h:t -> do+      modify (\s -> s { epCommentsApplied = []:t })+      return (reverse h)++-- | Return the comments applied since the last call+-- takeAppliedComments, and clear them, popping the stack+takeAppliedCommentsPop :: (Monad m, Monoid w) => EP w m [Comment]+takeAppliedCommentsPop = do+  !ccs <- gets epCommentsApplied+  case ccs of+    [] -> do+      modify (\s -> s { epCommentsApplied = [] })+      return []+    h:t -> do+      modify (\s -> s { epCommentsApplied = t })+      return (reverse h)++-- | Mark a comment as being applied.  This is used to update comments+-- when doing delta processing+applyComment :: (Monad m, Monoid w) => Comment -> EP w m ()+applyComment c = do+  !ccs <- gets epCommentsApplied   case ccs of     []    -> modify (\s -> s { epCommentsApplied = [[c]] } )     (h:t) -> modify (\s -> s { epCommentsApplied = (c:h):t } )
− src/Language/Haskell/GHC/ExactPrint/Orphans.hs 
@@ -1,97 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Language.Haskell.GHC.ExactPrint.Orphans where--import Data.Default-import GHC hiding (EpaComment)-import GHC.Types.SrcLoc---- ------------------------------------------------------------------------- ------------------------------------------------------------------------ Orphan Default instances. See https://gitlab.haskell.org/ghc/ghc/-/issues/20372--{--instance Default [a] where-  def = []--}-instance Default NameAnn where-  def = mempty--instance Default AnnList where-  def = mempty--instance Default AnnListItem where-  def = mempty--instance Default AnnPragma where-  def = AnnPragma def def def--instance Semigroup EpAnnImportDecl where-  (<>) = error "unimplemented"-instance Default EpAnnImportDecl where-  def = EpAnnImportDecl def  Nothing  Nothing  Nothing  Nothing  Nothing--instance Default HsRuleAnn where-  def = HsRuleAnn Nothing Nothing def--instance Default AnnSig where-  def = AnnSig def  def--instance Default GrhsAnn where-  def = GrhsAnn Nothing  def--instance Default EpAnnUnboundVar where-  def = EpAnnUnboundVar def  def--{--instance (Default a, Default b) => Default (a, b) where-  def = (def, def)--}--instance Default NoEpAnns where-  def = NoEpAnns--instance Default AnnParen where-  def = AnnParen AnnParens def  def--instance Default AnnExplicitSum where-  def = AnnExplicitSum def  def  def  def--instance Default EpAnnHsCase where-  def = EpAnnHsCase def def def--instance Default AnnsIf where-  def = AnnsIf def def def def def--{--instance Default (Maybe a) where-  def = Nothing--}--instance Default AnnProjection where-  def = AnnProjection def def--instance Default AnnFieldLabel where-  def = AnnFieldLabel Nothing--instance Default EpaLocation where-  def = EpaDelta (SameLine 0) []--instance Default AddEpAnn where-  def = AddEpAnn def def--instance Default AnnKeywordId where-  def = Annlarrowtail  {- gotta pick one -}--instance Default AnnContext where-  def = AnnContext Nothing [] []--instance Default EpAnnSumPat where-  def = EpAnnSumPat def  def  def--instance Semigroup RealSrcSpan where-    a <> b = combineRealSrcSpans a b--instance Default AnnsModule where-  def = AnnsModule [] mempty mempty
src/Language/Haskell/GHC/ExactPrint/Parsers.hs view
@@ -279,14 +279,13 @@   where     an' = case GHC.hsmodAnn $ GHC.hsmodExt p of       (GHC.EpAnn a an ocs) -> GHC.EpAnn a an (rebalance ocs)-      unused -> unused     p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' } }      rebalance :: GHC.EpAnnComments -> GHC.EpAnnComments     rebalance cs = cs'       where         cs' = case GHC.hsmodLayout $ GHC.hsmodExt p of-          GHC.ExplicitBraces _  (GHC.L (GHC.TokenLoc (GHC.EpaSpan ss _)) _) ->+          GHC.EpExplicitBraces _ (GHC.EpTok (GHC.EpaSpan (GHC.RealSrcSpan ss _))) ->             let               pc = GHC.priorComments cs               fc = GHC.getFollowingComments cs@@ -305,8 +304,8 @@     moveComments :: GHC.EpaLocation -> GHC.LHsDecl GHC.GhcPs -> GHC.EpAnnComments                  -> (GHC.LHsDecl GHC.GhcPs, GHC.EpAnnComments)     moveComments GHC.EpaDelta{} dd cs = (dd,cs)-    moveComments _loc dd@(GHC.L (GHC.SrcSpanAnn GHC.EpAnnNotUsed _) _) cs = (dd,cs)-    moveComments (GHC.EpaSpan r _) (GHC.L (GHC.SrcSpanAnn (GHC.EpAnn anc an csd) ll) a) cs = (dd,css)+    moveComments (GHC.EpaSpan (GHC.UnhelpfulSpan _)) dd cs = (dd,cs)+    moveComments (GHC.EpaSpan (GHC.RealSrcSpan r _)) (GHC.L (GHC.EpAnn anc an csd) a) cs = (dd,css)       where         -- Move any comments on the decl that occur prior to the location         pc = GHC.priorComments csd@@ -315,7 +314,7 @@         (move,keep) = break bf pc         csd' = GHC.EpaCommentsBalanced keep fc -        dd = GHC.L (GHC.SrcSpanAnn (GHC.EpAnn anc an csd') ll) a+        dd = GHC.L (GHC.EpAnn anc an csd') a         css = cs <> GHC.EpaComments move      (ds',an') = rebalance (GHC.hsmodDecls p, GHC.hsmodAnn $ GHC.hsmodExt p)@@ -325,7 +324,6 @@      rebalance :: ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)               -> ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)-    rebalance (ds, GHC.EpAnnNotUsed) = (ds, GHC.EpAnnNotUsed)     rebalance (ds, GHC.EpAnn a an cs) = (ds1, GHC.EpAnn a an cs')       where         (ds1,cs') = case break (\(GHC.AddEpAnn k _) -> k == GHC.AnnWhere) (GHC.am_main an) of
src/Language/Haskell/GHC/ExactPrint/Preprocess.hs view
@@ -12,7 +12,6 @@     , CppOptions(..)    , defaultCppOptions-   , showErrorMessages    ) where  import qualified GHC            as GHC hiding (parseModule)@@ -60,7 +59,7 @@ defaultCppOptions = CppOptions [] [] []  -- ------------------------------------------------------------------------ | Remove GHC style line pragams (@{-# LINE .. #-}@) and convert them into comments.+-- | Remove GHC style line pragmas (@{-# LINE .. #-}@) and convert them into comments. stripLinePragmas :: String -> (String, [GHC.LEpaComment]) stripLinePragmas = unlines' . unzip . findLines . lines   where@@ -78,7 +77,6 @@            ss     = mkSrcSpan (mSrcLoc line 1) (mSrcLoc line (size+1))        in (res, Just $ mkLEpaComment pragma (GHC.spanAsAnchor ss) (GHC.realSrcSpan ss))   -- Deal with shebang/cpp directives too-  -- x |  "#" `isPrefixOf` s = ("",Just $ Comment ((line, 1), (line, length s)) s)   |  "#!" `isPrefixOf` s =     let mSrcLoc = mkSrcLoc (mkFastString "SHEBANG")         ss = mkSrcSpan (mSrcLoc line 1) (mSrcLoc line (length s))@@ -130,7 +128,6 @@     isGoodComment [Comment "" _ _ _] = False     isGoodComment _                  = True - toRealLocated :: GHC.Located a -> GHC.RealLocated a toRealLocated (GHC.L (GHC.RealSrcSpan s _) x) = GHC.L s              x toRealLocated (GHC.L _ x)                     = GHC.L badRealSrcSpan x@@ -226,8 +223,7 @@       txt <- GHC.liftIO $ readFileGhc hspp_fn       return (txt, buf, dflags') --- showErrorMessages :: GHC.Messages GHC.DriverMessage -> String-showErrorMessages :: (GHC.Diagnostic a) => GHC.Messages a -> String+showErrorMessages :: GHC.Messages GHC.DriverMessage -> String showErrorMessages msgs =   GHC.renderWithContext GHC.defaultSDocContext     $ GHC.vcat@@ -283,12 +279,7 @@ -- ---------------------------------------------------------------------  parseError :: (GHC.MonadIO m) => GHC.PState -> m b-parseError pst = do-     let-       -- (warns,errs) = GHC.getMessages pst dflags-     -- throw $ GHC.mkSrcErr (GHC.unitBag $ GHC.mkPlainErrMsg dflags sspan err)-     -- GHC.throwErrors (fmap GHC.mkParserErr (GHC.getErrorMessages pst))-     GHC.throwErrors (fmap GHC.GhcPsMessage (GHC.getPsErrorMessages pst))+parseError pst = GHC.throwErrors (fmap GHC.GhcPsMessage (GHC.getPsErrorMessages pst))  -- ---------------------------------------------------------------------
src/Language/Haskell/GHC/ExactPrint/Transform.hs view
@@ -51,7 +51,6 @@         , noAnnSrcSpanDP1         , noAnnSrcSpanDPn         , d0, d1, dn-        , m0, m1, mn         , addComma          -- ** Managing lists, Transform monad@@ -64,11 +63,11 @@         -- *** Low level operations used in 'HasDecls'         , balanceComments         , balanceCommentsList-        , balanceCommentsList'+        , balanceCommentsListA         , anchorEof          -- ** Managing lists, pure functions-        , captureOrder+        , captureOrderBinds         , captureLineSpacing         , captureMatchLineSpacing         , captureTypeSigSpacing@@ -77,7 +76,7 @@         , isUniqueSrcSpan          -- * Pure functions-        , setEntryDP+        , setEntryDP, setEntryDPDecl         , getEntryDP         , transferEntryDP         , transferEntryDP'@@ -85,10 +84,8 @@         , decl2Sig, decl2Bind         ) where -import Language.Haskell.GHC.ExactPrint.ExactPrint import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils--- import Language.Haskell.GHC.ExactPrint.Orphans (Default(..))  import Control.Monad.RWS import qualified Control.Monad.Fail as Fail@@ -96,12 +93,11 @@ import GHC  hiding (parseModule, parsedSource) import GHC.Data.Bag import GHC.Data.FastString+import GHC.Types.SrcLoc  import Data.Data-import Data.Default import Data.Maybe import Data.Generics-import Data.List (sortBy)  import Data.Functor.Identity import Control.Monad.State@@ -178,13 +174,6 @@  -- --------------------------------------------------------------------- --- |If a list has been re-ordered or had items added, capture the new order in--- the appropriate 'AnnSortKey' attached to the 'Annotation' for the list.-captureOrder :: [LocatedA b] -> AnnSortKey-captureOrder ls = AnnSortKey $ map (rs . getLocA) ls---- ---------------------------------------------------------------------- captureMatchLineSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs captureMatchLineSpacing (L l (ValD x (FunBind a b (MG c (L d ms )))))                        = L l (ValD x (FunBind a b (MG c (L d ms'))))@@ -193,83 +182,56 @@       ms' = captureLineSpacing ms captureMatchLineSpacing d = d -captureLineSpacing :: Default t-                   => [LocatedAn t e] -> [LocatedAn t e]+captureLineSpacing :: [LocatedA e] -> [LocatedA e] captureLineSpacing [] = [] captureLineSpacing [d] = [d]-captureLineSpacing (de1:d2:ds) = de1:captureLineSpacing (d2':ds)+captureLineSpacing ds = map (\(_,_,x) -> x) $ go (map to ds)   where-    (l1,_) = ss2pos $ rs $ getLocA de1-    (l2,_) = ss2pos $ rs $ getLocA d2-    d2' = setEntryDP d2 (deltaPos (l2-l1) 0)+    to :: LocatedA e -> (Int, Int, LocatedA e)+    to d = (fst $ ss2pos rss, fst $ ss2posEnd rss,d)+      where+        rss = rs $ getHasLoc d +    go :: [(Int, Int, LocatedA e)] -> [(Int, Int, LocatedA e)]+    go [] = []+    go [d] = [d]+    go ((ls1,le1,de1):(ls2,le2,d2):ds0) = (ls1,le1,de1):go ((ls2,le2,d2'):ds0)+         `debug` ("captureLineSpacing: (le1,ls2,getLoc d2,getLoc d2')=" ++ showAst (le1,ls2,getLoc d2,getLoc d2'))+      where+        d2' = setEntryDP d2 (deltaPos (ls2-le1) 0)+ -- ---------------------------------------------------------------------  captureTypeSigSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs-captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (HsWC xw ty))))-  = (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc' rs') cs) ns (HsWC xw ty'))))+captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig dc rs') ns (HsWC xw ty))))+  = (L l (SigD x (TypeSig (AnnSig dc' rs') ns (HsWC xw ty'))))   where     -- we want DPs for the distance from the end of the ns to the     -- AnnDColon, and to the start of the ty     AddEpAnn kw dca = dc     rd = case last ns of-      L (SrcSpanAnn EpAnnNotUsed   ll) _ -> realSrcSpan ll-      L (SrcSpanAnn (EpAnn anc' _ _) _) _ -> anchor anc' -- TODO MovedAnchor?+      L (EpAnn anc' _ _) _ -> anchor anc' -- TODO MovedAnchor?     dc' = case dca of-      EpaSpan r _ -> AddEpAnn kw (EpaDelta (ss2delta (ss2posEnd rd) r) [])-      EpaDelta _ _ -> AddEpAnn kw dca+      EpaSpan (RealSrcSpan r _) -> AddEpAnn kw (EpaDelta (ss2delta (ss2posEnd rd) r) [])+      _                         -> AddEpAnn kw dca      -- ---------------------------------      ty' :: LHsSigType GhcPs     ty' = case ty of-      (L (SrcSpanAnn EpAnnNotUsed    ll) b)-        -> let-             op = case dca of-               EpaSpan r _ -> MovedAnchor (ss2delta (ss2posEnd r) (realSrcSpan ll))-               EpaDelta _ _ -> MovedAnchor (SameLine 1)-           in (L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan ll) op) mempty emptyComments) ll) b)-      (L (SrcSpanAnn (EpAnn (Anchor r op) a c) ll) b)+      (L (EpAnn anc0 a c) b)         -> let-              op' = case op of-                MovedAnchor _ -> op+              anc' = case anc0 of+                EpaDelta _ _ -> anc0                 _ -> case dca of-                  EpaSpan dcr _ -> MovedAnchor (ss2delta (ss2posEnd dcr) r)-                  EpaDelta _ _ -> MovedAnchor (SameLine 1)-           in (L (SrcSpanAnn (EpAnn (Anchor r op') a c) ll) b)+                  EpaSpan _ -> EpaDelta (SameLine 1) []+                  EpaDelta _ cs0 -> EpaDelta (SameLine 1) cs0+           in (L (EpAnn anc' a c) b)  captureTypeSigSpacing s = s  -- --------------------------------------------------------------------- --- |Pure function to convert a 'LHsDecl' to a 'LHsBind'. This does--- nothing to any annotations that may be attached to either of the elements.--- It is used as a utility function in 'replaceDecls'-decl2Bind :: LHsDecl GhcPs -> [LHsBind GhcPs]-decl2Bind (L l (ValD _ s)) = [L l s]-decl2Bind _                      = []---- |Pure function to convert a 'LSig' to a 'LHsBind'. This does--- nothing to any annotations that may be attached to either of the elements.--- It is used as a utility function in 'replaceDecls'-decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]-decl2Sig (L l (SigD _ s)) = [L l s]-decl2Sig _                = []---- ------------------------------------------------------------------------- |Convert a 'LSig' into a 'LHsDecl'-wrapSig :: LSig GhcPs -> LHsDecl GhcPs-wrapSig (L l s) = L l (SigD NoExtField s)---- ------------------------------------------------------------------------- |Convert a 'LHsBind' into a 'LHsDecl'-wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs-wrapDecl (L l s) = L l (ValD NoExtField s)---- ---------------------------------------------------------------------- setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs setEntryDPDecl decl@(L _  (ValD x (FunBind a b (MG c (L d ms ))))) dp                    = L l' (ValD x (FunBind a b (MG c (L d ms'))))@@ -285,48 +247,52 @@  -- |Set the true entry 'DeltaPos' from the annotation for a given AST -- element. This is the 'DeltaPos' ignoring any comments.-setEntryDP :: Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a-setEntryDP (L (SrcSpanAnn EpAnnNotUsed l) a) dp-  = L (SrcSpanAnn-           (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) def emptyComments)-           l) a-setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r _) an (EpaComments [])) l) a) dp-  = L (SrcSpanAnn-           (EpAnn (Anchor r (MovedAnchor dp)) an (EpaComments []))-           l) a-setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r (MovedAnchor d)) an cs) l) a) dp-  = L (SrcSpanAnn-           (EpAnn (Anchor r (MovedAnchor d')) an cs')-           l) a+setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a+setEntryDP (L (EpAnn (EpaSpan (UnhelpfulSpan _)) an cs) a) dp+  = L (EpAnn (EpaDelta dp []) an cs) a+setEntryDP (L (EpAnn (EpaSpan _) an (EpaComments [])) a) dp+  = L (EpAnn (EpaDelta dp []) an (EpaComments [])) a+setEntryDP (L (EpAnn (EpaDelta d csd) an cs) a) dp+  = L (EpAnn (EpaDelta d' csd') an cs') a   where-    (d',cs') = case cs of+    (d', csd', cs') = case cs of       EpaComments (h:t) ->         let           (dp0,c') = go h         in-          (dp0, EpaComments (c':t))+          (dp0, c':t++csd, EpaComments [])+      EpaComments [] ->+          (dp, csd, cs)       EpaCommentsBalanced (h:t) ts ->         let           (dp0,c') = go h         in-          (dp0, EpaCommentsBalanced (c':t) ts)-      _ -> (dp, cs)-    go (L (Anchor rr (MovedAnchor ma)) c) = (d,  L (Anchor rr (MovedAnchor ma)) c)-    go (L (Anchor rr                _) c) = (d,  L (Anchor rr (MovedAnchor dp)) c)-setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r _) an cs) l) a) dp+          (dp0, c':t++csd, EpaCommentsBalanced [] ts)+      EpaCommentsBalanced [] ts ->+           case csd of+             [] -> (d, csd, EpaCommentsBalanced [] ts)+             (h:t) ->+                let+                  (dp0,c') = go h+                in+                  (dp0, c':t, EpaCommentsBalanced [] ts)+    go :: GenLocated NoCommentsLocation e -> (DeltaPos, GenLocated NoCommentsLocation e)+    go (L (EpaDelta _ c0) c) = (d,  L (EpaDelta dp c0) c)+    go (L (EpaSpan _)     c) = (d,  L (EpaDelta dp NoComments) c)+setEntryDP (L (EpAnn (EpaSpan (RealSrcSpan r _)) an cs) a) dp   = case sortEpaComments (priorComments cs) of       [] ->-        L (SrcSpanAnn-               (EpAnn (Anchor r (MovedAnchor dp)) an cs)-               l) a+        L (EpAnn (EpaDelta dp []) an cs) a       (L ca c:cs') ->-        L (SrcSpanAnn-               (EpAnn (Anchor r (MovedAnchor edp)) an cs'')-               l) a+        L (EpAnn (EpaDelta edp csd) an cs'') a               where-                cs'' = setPriorComments cs (L (Anchor (anchor ca) (MovedAnchor dp)) c:cs')+                cs'' = setPriorComments cs []+                csd = L (EpaDelta dp NoComments) c:commentOrigDeltas cs'                 lc = last $ (L ca c:cs')-                delta = tweakDelta $ ss2delta (ss2pos $ anchor $ getLoc lc) r+                delta = case getLoc lc of+                          EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r+                          EpaSpan _ -> (SameLine 0)+                          EpaDelta _dp _ -> DifferentLine 1 0                 line = getDeltaLine delta                 col = deltaColumn delta                 edp' = if line == 0 then SameLine col@@ -337,54 +303,44 @@ -- ---------------------------------------------------------------------  getEntryDP :: LocatedAn t a -> DeltaPos-getEntryDP (L (SrcSpanAnn (EpAnn (Anchor _ (MovedAnchor dp)) _ _) _) _) = dp+getEntryDP (L (EpAnn (EpaDelta dp _) _ _) _) = dp getEntryDP _ = SameLine 1  -- ---------------------------------------------------------------------  addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation addEpaLocationDelta _off _anc (EpaDelta d cs) = EpaDelta d cs-addEpaLocationDelta  off  anc (EpaSpan r _)+addEpaLocationDelta _off _anc (EpaSpan (UnhelpfulSpan _)) = EpaDelta (SameLine 0) []+addEpaLocationDelta  off  anc (EpaSpan (RealSrcSpan r _))   = EpaDelta (adjustDeltaForOffset off (ss2deltaEnd anc r)) []  -- Set the entry DP for an element coming after an existing keyword annotation setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t setEntryDPFromAnchor _off (EpaDelta _ _) (L la a) = L la a-setEntryDPFromAnchor  off (EpaSpan anc _) ll@(L la _) = setEntryDP ll dp'+setEntryDPFromAnchor _off (EpaSpan (UnhelpfulSpan _)) (L la a) = L la a+setEntryDPFromAnchor  off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP ll dp'   where-    r = case la of-      (SrcSpanAnn EpAnnNotUsed l) -> realSrcSpan l-      (SrcSpanAnn (EpAnn (Anchor r' _) _ _) _) -> r'-    dp' = adjustDeltaForOffset off (ss2deltaEnd anc r)+    dp' = case la of+      (EpAnn (EpaSpan (RealSrcSpan r' _)) _ _) -> adjustDeltaForOffset off (ss2deltaEnd anc r')+      (EpAnn (EpaSpan _) _ _)                  -> adjustDeltaForOffset off (SameLine 0)+      (EpAnn (EpaDelta dp _) _ _)              -> adjustDeltaForOffset off dp  -- ---------------------------------------------------------------------  -- |Take the annEntryDelta associated with the first item and associate it with the second.--- Also transfer any comments occuring before it.-transferEntryDP :: (Monad m, Monoid t2, Typeable t1, Typeable t2)+-- Also transfer any comments occurring before it.+transferEntryDP :: (Monad m, Typeable t1, Typeable t2)   => LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)-transferEntryDP (L (SrcSpanAnn EpAnnNotUsed l1) _) (L (SrcSpanAnn EpAnnNotUsed _) b) = do-  logTr $ "transferEntryDP': EpAnnNotUsed,EpAnnNotUsed"-  return (L (SrcSpanAnn EpAnnNotUsed l1) b)-transferEntryDP (L (SrcSpanAnn (EpAnn anc _an cs) _l1) _) (L (SrcSpanAnn EpAnnNotUsed l2) b) = do-  logTr $ "transferEntryDP': EpAnn,EpAnnNotUsed"-  return (L (SrcSpanAnn (EpAnn anc mempty cs) l2) b)-transferEntryDP (L (SrcSpanAnn (EpAnn anc1 an1 cs1) _l1) _) (L (SrcSpanAnn (EpAnn _anc2 an2 cs2) l2) b) = do+transferEntryDP (L (EpAnn anc1 an1 cs1) _) (L (EpAnn _anc2 an2 cs2) b) = do   logTr $ "transferEntryDP': EpAnn,EpAnn"   -- Problem: if the original had preceding comments, blindly   -- transferring the location is not correct   case priorComments cs1 of-    [] -> return (L (SrcSpanAnn (EpAnn anc1 (combine an1 an2) cs2) l2) b)+    [] -> return (L (EpAnn anc1 (combine an1 an2) cs2) b)     -- TODO: what happens if the receiving side already has comments?     (L anc _:_) -> do       logDataWithAnnsTr "transferEntryDP':priorComments anc=" anc-      return (L (SrcSpanAnn (EpAnn anc1 (combine an1 an2) (cs1 <> cs2)) l2) b)-transferEntryDP (L (SrcSpanAnn EpAnnNotUsed _l1) _) (L (SrcSpanAnn (EpAnn anc2 an2 cs2) l2) b) = do-  logTr $ "transferEntryDP': EpAnnNotUsed,EpAnn"-  return (L (SrcSpanAnn (EpAnn anc2' an2 cs2) l2) b)-    where-      anc2' = case anc2 of-        Anchor _a op   -> Anchor (realSrcSpan l2) op+      return (L (EpAnn anc1 (combine an1 an2) (cs1 <> cs2)) b)   -- |If a and b are the same type return first arg, else return second@@ -392,7 +348,7 @@ combine x y = fromMaybe y (cast x)  -- |Take the annEntryDelta associated with the first item and associate it with the second.--- Also transfer any comments occuring before it.+-- Also transfer any comments occurring before it. -- TODO: call transferEntryDP, and use pushDeclDP transferEntryDP' :: (Monad m) => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs) transferEntryDP' la lb = do@@ -413,15 +369,18 @@  -- --------------------------------------------------------------------- +-- | If we compile in haddock mode we get DocDecls, which we strip out+-- while exact printing. Make sure we do not balance any comments on+-- to them be stripping them out here already. balanceCommentsList :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]-balanceCommentsList ds = balanceCommentsList'' ds+balanceCommentsList decls = balanceCommentsList' (filter notDocDecl decls) -balanceCommentsList'' :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]-balanceCommentsList'' [] = return []-balanceCommentsList'' [x] = return [x]-balanceCommentsList'' (a:b:ls) = do+balanceCommentsList' :: (Monad m) => [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]+balanceCommentsList' [] = return []+balanceCommentsList' [x] = return [x]+balanceCommentsList' (a:b:ls) = do   (a',b') <- balanceComments a b-  r <- balanceCommentsList'' (b':ls)+  r <- balanceCommentsList' (b':ls)   return (a':r)  -- |The GHC parser puts all comments appearing between the end of one AST@@ -438,46 +397,61 @@     (L l (ValD x fb@(FunBind{}))) -> do       (L l' fb',second') <- balanceCommentsFB (L l fb) second       return (L l' (ValD x fb'), second')-    _ -> balanceComments' first second+    _ -> balanceCommentsA first second --- |Once 'balanceComments' has been called to move trailing comments to a+-- |Once 'balanceCommentsA has been called to move trailing comments to a -- 'FunBind', these need to be pushed down from the top level to the last -- 'Match' if that 'Match' needs to be manipulated. balanceCommentsFB :: (Monad m)   => LHsBind GhcPs -> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b) balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second = do-  logTr $ "balanceCommentsFB entered: " ++ showGhc (ss2range $ locA lf)+  debugM $ "balanceCommentsFB entered: " ++ showGhc (ss2range $ locA lf)   -- There are comments on lf.  We need to   -- + Keep the prior ones here   -- + move the interior ones to the first match,   -- + move the trailing ones to the last match.   let-    split = splitCommentsEnd (realSrcSpan $ locA lf) (epAnnComments $ ann lf)-    split2 = splitCommentsStart (realSrcSpan $ locA lf)  (EpaComments (sortEpaComments $ priorComments split))+    (before,middle,after) = case entry lf of+        EpaSpan (RealSrcSpan ss _) ->+          let+            split = splitCommentsEnd ss (comments lf)+            split2 = splitCommentsStart ss  (EpaComments (sortEpaComments $ priorComments split)) -    before = sortEpaComments $ priorComments split2-    middle = sortEpaComments $ getFollowingComments split2-    after  = sortEpaComments $ getFollowingComments split+            before0 = sortEpaComments $ priorComments split2+            middle0 = sortEpaComments $ getFollowingComments split2+            after0  = sortEpaComments $ getFollowingComments split+          in (before0,middle0,after0)+        _ -> (priorComments $ comments lf,+              [],+              getFollowingComments $ comments lf) -    lf' = setCommentsSrcAnn lf (EpaComments before)-  logTr $ "balanceCommentsFB (before, after): " ++ showAst (before, after)-  let matches' = case matches of+    lf' = setCommentsEpAnn lf (EpaComments before)+  debugM $ "balanceCommentsFB (before, after): " ++ showAst (before, after)+  debugM $ "balanceCommentsFB lf': " ++ showAst lf'+  -- let matches' = case matches of+  let matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))]+      matches' = case matches of                     (L lm' m':ms') ->-                      (L (addCommentsToSrcAnn lm' (EpaComments middle )) m':ms')+                      (L (addCommentsToEpAnn lm' (EpaComments middle )) m':ms')                     _ -> error "balanceCommentsFB"-  matches'' <- balanceCommentsList' matches'+  matches'' <- balanceCommentsListA matches'   let (m,ms) = case reverse matches'' of                  (L lm' m':ms') ->-                   (L (addCommentsToSrcAnn lm' (EpaCommentsBalanced [] after)) m',ms')-                 _ -> error "balanceCommentsFB"-  (m',second') <- balanceComments' m second+                   (L (addCommentsToEpAnn lm' (EpaCommentsBalanced [] after)) m',ms')+                   -- (L (addCommentsToEpAnnS lm' (EpaCommentsBalanced [] after)) m',ms')+                 _ -> error "balanceCommentsFB4"+  debugM $ "balanceCommentsFB: (m,ms):" ++ showAst (m,ms)+  (m',second') <- balanceCommentsA m second   m'' <- balanceCommentsMatch m'   let (m''',lf'') = case ms of         [] -> moveLeadingComments m'' lf'         _  -> (m'',lf')-  logTr $ "balanceCommentsMatch done"-  balanceComments' (L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms)))))) second'-balanceCommentsFB f s = balanceComments' f s+  debugM $ "balanceCommentsFB: (lf'', m'''):" ++ showAst (lf'',m''')+  debugM $ "balanceCommentsFB done"+  let bind = L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms)))))+  debugM $ "balanceCommentsFB returning:" ++ showAst bind+  balanceCommentsA (packFunBind bind) second'+balanceCommentsFB f s = balanceCommentsA f s  -- | Move comments on the same line as the end of the match into the -- GRHS, prior to the binds@@ -488,32 +462,29 @@   return (L l'' (Match am mctxt pats (GRHSs xg grhss' binds')))   where     simpleBreak (r,_) = r /= 0-    (SrcSpanAnn an1 _loc1) = l-    anc1 = addCommentOrigDeltas $ epAnnComments an1+    an1 = l+    anc1 = comments an1     cs1f = getFollowingComments anc1     (move',stay') = break simpleBreak (trailingCommentsDeltas (anchorFromLocatedA (L l ())) cs1f)     move = map snd move'     stay = map snd stay'     (l'', grhss', binds', logInfo)       = case reverse grhss of-          [] -> (l, [], binds,                 (EpaComments [], SrcSpanAnn EpAnnNotUsed noSrcSpan))-          (L lg g@(GRHS EpAnnNotUsed _grs _rhs):gs)-            -> (l, reverse (L lg g:gs), binds, (EpaComments [], SrcSpanAnn EpAnnNotUsed noSrcSpan))+          [] -> (l, [], binds,                 (EpaComments [], noSrcSpanA))           (L lg (GRHS ag grs rhs):gs) ->             let               anc1' = setFollowingComments anc1 stay-              an1' = setCommentsSrcAnn l anc1'+              an1' = setCommentsEpAnn l anc1'                -- ---------------------------------               (moved,bindsm) = pushTrailingComments WithWhere (EpaCommentsBalanced [] move) binds               -- ---------------------------------                (EpAnn anc an lgc) = ag-              lgc' = splitCommentsEnd (realSrcSpan $ locA lg) $ addCommentOrigDeltas lgc+              lgc' = splitCommentsEnd (realSrcSpan $ locA lg) lgc               ag' = if moved                       then EpAnn anc an lgc'                       else EpAnn anc an (lgc' <> (EpaCommentsBalanced [] move))-              -- ag' = EpAnn anc an lgc'              in (an1', (reverse $ (L lg (GRHS ag' grs rhs):gs)), bindsm, (anc1',an1')) @@ -523,22 +494,22 @@ pushTrailingComments w cs lb@(HsValBinds an _)   = (True, HsValBinds an' vb)   where-    (decls, _, _ws1) = runTransform (hsDeclsValBinds lb)+    decls = hsDeclsLocalBinds lb     (an', decls') = case reverse decls of-      [] -> (addCommentsToEpAnn (spanHsLocaLBinds lb) an cs, decls)-      (L la d:ds) -> (an, L (addCommentsToSrcAnn la cs) d:ds)+      [] -> (addCommentsToEpAnn an cs, decls)+      (L la d:ds) -> (an, L (addCommentsToEpAnn la cs) d:ds)     (vb,_ws2) = case runTransform (replaceDeclsValbinds w lb (reverse decls')) of       ((HsValBinds _ vb'), _, ws2') -> (vb', ws2')       _ -> (ValBinds NoAnnSortKey emptyBag [], [])  -balanceCommentsList' :: (Monad m) => [LocatedA a] -> TransformT m [LocatedA a]-balanceCommentsList' [] = return []-balanceCommentsList' [x] = return [x]-balanceCommentsList' (a:b:ls) = do-  logTr $ "balanceCommentsList' entered"-  (a',b') <- balanceComments' a b-  r <- balanceCommentsList' (b':ls)+balanceCommentsListA :: (Monad m) => [LocatedA a] -> TransformT m [LocatedA a]+balanceCommentsListA [] = return []+balanceCommentsListA [x] = return [x]+balanceCommentsListA (a:b:ls) = do+  logTr $ "balanceCommentsListA entered"+  (a',b') <- balanceCommentsA a b+  r <- balanceCommentsListA (b':ls)   return (a':r)  -- |Prior to moving an AST element, make sure any trailing comments belonging to@@ -547,41 +518,48 @@ -- with a passed-in decision function. -- The initial situation is that all comments for a given anchor appear as prior comments -- Many of these should in fact be following comments for the previous anchor-balanceComments' :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)-balanceComments' la1 la2 = do-  logTr $ "balanceComments': (loc1,loc2)=" ++ showGhc (ss2range loc1,ss2range loc2)-  logTr $ "balanceComments': (anc1)=" ++ showAst (anc1)-  logTr $ "balanceComments': (cs1s)=" ++ showAst (cs1s)-  logTr $ "balanceComments': (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move)-  logTr $ "balanceComments': (an1',an2')=" ++ showAst (an1',an2')+balanceCommentsA :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b)+balanceCommentsA la1 la2 = do+  debugM $ "balanceCommentsA: anchors=" ++ showAst (an1, an2)+  -- debugM $ "balanceCommentsA: (anc1)=" ++ showAst (anc1)+  -- debugM $ "balanceCommentsA: (anc2)=" ++ showAst (anc2)+  debugM $ "balanceCommentsA: (cs1f)=" ++ showAst (cs1f)+  debugM $ "balanceCommentsA: (cs2p, cs2f)=" ++ showAst (cs2p, cs2f)+  debugM $ "balanceCommentsA: (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move)+  debugM $ "balanceCommentsA: (an1',an2')=" ++ showAst (an1',an2')   return (la1', la2')   where     simpleBreak n (r,_) = r > n-    L (SrcSpanAnn an1 loc1) f = la1-    L (SrcSpanAnn an2 loc2) s = la2-    anc1 = addCommentOrigDeltas $ epAnnComments an1-    anc2 = addCommentOrigDeltas $ epAnnComments an2+    L an1 f = la1+    L an2 s = la2+    anc1 = comments an1+    anc2 = comments an2 -    cs1s = splitCommentsEnd (anchorFromLocatedA la1) anc1-    cs1p = priorCommentsDeltas    (anchorFromLocatedA la1) (priorComments        cs1s)-    cs1f = trailingCommentsDeltas (anchorFromLocatedA la1) (getFollowingComments cs1s)+    (p1,m1,f1) = splitComments (anchorFromLocatedA la1) anc1+    cs1p = priorCommentsDeltas    (anchorFromLocatedA la1) p1 -    cs2s = splitCommentsEnd (anchorFromLocatedA la2) anc2-    cs2p = priorCommentsDeltas    (anchorFromLocatedA la2) (priorComments        cs2s)-    cs2f = trailingCommentsDeltas (anchorFromLocatedA la2) (getFollowingComments cs2s)+    -- Split cs1 following comments into those before any+    -- TrailingAnn's on an1, and any after+    cs1f = splitCommentsEnd (fullSpanFromLocatedA la1) $ EpaComments f1+    cs1fp = priorCommentsDeltas    (anchorFromLocatedA la1) (priorComments        cs1f)+    cs1ff = trailingCommentsDeltas (anchorFromLocatedA la1) (getFollowingComments cs1f) -    -- Split cs1f into those that belong on an1 and ones that must move to an2-    (cs1move,cs1stay) = break (simpleBreak 1) cs1f+    -- Split cs1ff into those that belong on an1 and ones that must move to an2+    (cs1move,cs1stay) = break (simpleBreak 1) cs1ff +    (p2,m2,f2) = splitComments (anchorFromLocatedA la2) anc2+    cs2p = priorCommentsDeltas    (anchorFromLocatedA la2) p2+    cs2f = trailingCommentsDeltas (anchorFromLocatedA la2) f2+     (stay'',move') = break (simpleBreak 1) cs2p     -- Need to also check for comments more closely attached to la1,     -- ie trailing on the same line     (move'',stay') = break (simpleBreak 0) (trailingCommentsDeltas (anchorFromLocatedA la1) (map snd stay''))-    move = sortEpaComments $ map snd (cs1move ++ move'' ++ move')-    stay = sortEpaComments $ map snd (cs1stay ++ stay')+    move = sortEpaComments $ map snd (cs1fp ++ cs1move ++ move'' ++ move')+    stay = sortEpaComments $ m2 ++ map snd (cs1stay ++ stay') -    an1' = setCommentsSrcAnn (getLoc la1) (EpaCommentsBalanced (map snd cs1p) move)-    an2' = setCommentsSrcAnn (getLoc la2) (EpaCommentsBalanced stay (map snd cs2f))+    an1' = setCommentsEpAnn (getLoc la1) (epaCommentsBalanced (m1 ++ map snd cs1p) move)+    an2' = setCommentsEpAnn (getLoc la2) (epaCommentsBalanced stay (map snd cs2f))     la1' = L an1' f     la2' = L an2' s @@ -589,81 +567,101 @@ trailingCommentsDeltas :: RealSrcSpan -> [LEpaComment]                -> [(Int, LEpaComment)] trailingCommentsDeltas _ [] = []-trailingCommentsDeltas anc (la@(L l _):las)-  = deltaComment anc la : trailingCommentsDeltas (anchor l) las+trailingCommentsDeltas r (la@(L (EpaDelta dp _) _):las)+  = (getDeltaLine dp, la): trailingCommentsDeltas r las+trailingCommentsDeltas r (la@(L l _):las)+  = deltaComment r la : trailingCommentsDeltas (anchor l) las   where-    deltaComment anc' (L loc c) = (abs(ll - al), L loc c)+    deltaComment rs' (L loc c) = (abs(ll - al), L loc c)       where-        (al,_) = ss2posEnd anc'+        (al,_) = ss2posEnd rs'         (ll,_) = ss2pos (anchor loc) --- AZ:TODO: this is identical to commentsDeltas priorCommentsDeltas :: RealSrcSpan -> [LEpaComment]                     -> [(Int, LEpaComment)]-priorCommentsDeltas anc cs = go anc (reverse $ sortEpaComments cs)+priorCommentsDeltas r cs = go r (sortEpaComments cs)   where     go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]-    go _ [] = []-    go anc' (la@(L l _):las) = deltaComment anc' la : go (anchor l) las+    go _   [] = []+    go _   (la@(L l@(EpaDelta dp _) _):las) = (deltaLine dp, la) : go (anchor l) las+    go rs' (la@(L l _):las) = deltaComment rs' la : go (anchor l) las      deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)-    deltaComment anc' (L loc c) = (abs(ll - al), L loc c)+    deltaComment rs' (L loc c) = (abs(ll - al), L loc c)       where-        (al,_) = ss2pos anc'+        (al,_) = ss2pos rs'         (ll,_) = ss2pos (anchor loc)   -- --------------------------------------------------------------------- --- | Split comments into ones occuring before the end of the reference+-- | Split comments into ones occurring before the end of the reference -- span, and those after it.+splitComments :: RealSrcSpan -> EpAnnComments -> ([LEpaComment], [LEpaComment], [LEpaComment])+splitComments p cs = (before, middle, after)+  where+    cmpe (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p+    cmpe (L _ _) = True++    cmpb (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2pos p+    cmpb (L _ _) = True++    (beforeEnd, after) = break cmpe ((priorComments cs) ++ (getFollowingComments cs))+    (before, middle) = break cmpb beforeEnd+++-- | Split comments into ones occurring before the end of the reference+-- span, and those after it. splitCommentsEnd :: RealSrcSpan -> EpAnnComments -> EpAnnComments splitCommentsEnd p (EpaComments cs) = cs'   where-    cmp (L (Anchor l _) _) = ss2pos l > ss2posEnd p+    cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p+    cmp (L _ _) = True     (before, after) = break cmp cs     cs' = case after of       [] -> EpaComments cs-      _ -> EpaCommentsBalanced before after-splitCommentsEnd p (EpaCommentsBalanced cs ts) = EpaCommentsBalanced cs' ts'+      _ -> epaCommentsBalanced before after+splitCommentsEnd p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts'   where-    cmp (L (Anchor l _) _) = ss2pos l > ss2posEnd p+    cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p+    cmp (L _ _) = True     (before, after) = break cmp cs     cs' = before     ts' = after <> ts --- | Split comments into ones occuring before the start of the reference+-- | Split comments into ones occurring before the start of the reference -- span, and those after it. splitCommentsStart :: RealSrcSpan -> EpAnnComments -> EpAnnComments splitCommentsStart p (EpaComments cs) = cs'   where-    cmp (L (Anchor l _) _) = ss2pos l > ss2pos p+    cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p+    cmp (L _ _) = True     (before, after) = break cmp cs     cs' = case after of       [] -> EpaComments cs-      _ -> EpaCommentsBalanced before after-splitCommentsStart p (EpaCommentsBalanced cs ts) = EpaCommentsBalanced cs' ts'+      _ -> epaCommentsBalanced before after+splitCommentsStart p (EpaCommentsBalanced cs ts) = epaCommentsBalanced cs' ts'   where-    cmp (L (Anchor l _) _) = ss2pos l > ss2pos p+    cmp (L (EpaSpan (RealSrcSpan l _)) _) = ss2pos l > ss2posEnd p+    cmp (L _ _) = True     (before, after) = break cmp cs     cs' = before     ts' = after <> ts -moveLeadingComments :: (Data t, Data u, Monoid t, Monoid u)-  => LocatedAn t a -> SrcAnn u -> (LocatedAn t a, SrcAnn u)-moveLeadingComments from@(L (SrcSpanAnn EpAnnNotUsed _) _) to = (from, to)+moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u)+  => LocatedAn t a -> EpAnn u -> (LocatedAn t a, EpAnn u) moveLeadingComments (L la a) lb = (L la' a, lb')   `debug` ("moveLeadingComments: (before, after, la', lb'):" ++ showAst (before, after, la', lb'))   where-    split = splitCommentsEnd (realSrcSpan $ locA la) (epAnnComments $ ann la)+    split = splitCommentsEnd (realSrcSpan $ locA la) (comments la)     before = sortEpaComments $ priorComments split     after = sortEpaComments $ getFollowingComments split      -- TODO: need to set an entry delta on lb' to zero, and move the     -- original spacing to the first comment. -    la' = setCommentsSrcAnn la (EpaComments after)-    lb' = addCommentsToSrcAnn lb (EpaCommentsBalanced before [])+    la' = setCommentsEpAnn la (epaCommentsBalanced [] after)+    lb' = addCommentsToEpAnn lb (epaCommentsBalanced before [])  -- | A GHC comment includes the span of the preceding (non-comment) -- token.  Takes an original list of comments, and converts the@@ -679,36 +677,26 @@   = EpaCommentsBalanced (commentOrigDeltas pcs) (commentOrigDeltas fcs)  addCommentOrigDeltasAnn :: (EpAnn a) -> (EpAnn a)-addCommentOrigDeltasAnn EpAnnNotUsed   = EpAnnNotUsed addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) + -- TODO: this is replicating functionality in ExactPrint. Sort out the -- import loop` anchorFromLocatedA :: LocatedA a -> RealSrcSpan-anchorFromLocatedA (L (SrcSpanAnn an loc) _)-  = case an of-      EpAnnNotUsed    -> realSrcSpan loc-      (EpAnn anc _ _) -> anchor anc+anchorFromLocatedA (L (EpAnn anc _ _) _) = anchor anc --- | A GHC comment includes the span of the preceding token.  Take an--- original comment, and convert the 'Anchor to have a have a--- `MovedAnchor` operation based on the original location, only if it--- does not already have one.-commentOrigDelta :: LEpaComment -> LEpaComment-commentOrigDelta (L (GHC.Anchor la _) (GHC.EpaComment t pp))-  = (L (GHC.Anchor la op) (GHC.EpaComment t pp))-                  `debug` ("commentOrigDelta: (la, pp, r,c, op)=" ++ showAst (la, pp, r,c, op))+-- | Get the full span of interest for comments from a LocatedA.+-- This extends up to the last TrailingAnn+fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan+fullSpanFromLocatedA (L (EpAnn anc (AnnListItem tas)  _) _) = rr   where-        (r,c) = ss2posEnd pp--        op' = if r == 0-               then MovedAnchor (ss2delta (r,c+1) la)-               -- then MovedAnchor (ss2delta (r,c+0) la)-               -- else MovedAnchor (ss2delta (r,c)   la)-               else MovedAnchor (tweakDelta $ ss2delta (r,c)   la)-        op = if t == EpaEofComment && op' == MovedAnchor (SameLine 0)-               then MovedAnchor (DifferentLine 1 0)-               else op'+    r = anchor anc+    trailing_loc ta = case ta_location ta of+        EpaSpan (RealSrcSpan s _) -> [s]+        _ -> []+    rr = case reverse (concatMap trailing_loc tas) of+        [] -> r+        (s:_) -> combineRealSrcSpans r s  -- --------------------------------------------------------------------- @@ -722,11 +710,9 @@     simpleBreak n (r,_) = r > n     (la',grhss', logInfo) = case reverse grhss of       [] -> (la,grhss,[])-      (L lg g@(GRHS EpAnnNotUsed _gs _rhs):grs) -> (la,reverse $ (L lg g):grs,[])       (L lg (GRHS ga gs rhs):grs) -> (la'',reverse $ (L lg (GRHS ga' gs rhs)):grs,[(gac,(csp,csf))])         where-          (SrcSpanAnn an1 _loc1) = la-          anc1 = addCommentOrigDeltas $ epAnnComments an1+          anc1 = comments la           (EpAnn anc an _) = ga :: EpAnn GrhsAnn           (csp,csf) = case anc1 of             EpaComments cs -> ([],cs)@@ -734,15 +720,14 @@           (move',stay') = break (simpleBreak 0) (trailingCommentsDeltas (anchor anc) csf)           move = map snd move'           stay = map snd stay'-          cs1 = EpaCommentsBalanced csp stay+          cs1 = epaCommentsBalanced csp stay -          gac = addCommentOrigDeltas $ epAnnComments ga+          gac = epAnnComments ga           gfc = getFollowingComments gac           gac' = setFollowingComments gac (sortEpaComments $ gfc ++ move)           ga' = (EpAnn anc an gac') -          an1' = setCommentsSrcAnn la cs1-          la'' = an1'+          la'' = setCommentsEpAnn la cs1  -- --------------------------------------------------------------------- @@ -753,27 +738,19 @@  -- --------------------------------------------------------------------- -commentsOrigDeltasDecl :: LHsDecl GhcPs -> LHsDecl GhcPs-commentsOrigDeltasDecl (L (SrcSpanAnn an l) d) = L (SrcSpanAnn an' l) d-  where-    an' = addCommentOrigDeltasAnn an---- ---------------------------------------------------------------------- -- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the -- given @DeltaPos@.-noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)-noAnnSrcSpanDP l dp-  = SrcSpanAnn (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty emptyComments) l+noAnnSrcSpanDP :: (NoAnn ann) => DeltaPos -> EpAnn ann+noAnnSrcSpanDP dp = EpAnn (EpaDelta dp []) noAnn emptyComments -noAnnSrcSpanDP0 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)-noAnnSrcSpanDP0 l = noAnnSrcSpanDP l (SameLine 0)+noAnnSrcSpanDP0 :: (NoAnn ann) => EpAnn ann+noAnnSrcSpanDP0 = noAnnSrcSpanDP (SameLine 0) -noAnnSrcSpanDP1 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)-noAnnSrcSpanDP1 l = noAnnSrcSpanDP l (SameLine 1)+noAnnSrcSpanDP1 :: (NoAnn ann) => EpAnn ann+noAnnSrcSpanDP1 = noAnnSrcSpanDP (SameLine 1) -noAnnSrcSpanDPn :: (Monoid ann) => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann)-noAnnSrcSpanDPn l s = noAnnSrcSpanDP l (SameLine s)+noAnnSrcSpanDPn :: (NoAnn ann) => Int -> EpAnn ann+noAnnSrcSpanDPn s = noAnnSrcSpanDP (SameLine s)  d0 :: EpaLocation d0 = EpaDelta (SameLine 0) []@@ -784,20 +761,9 @@ dn :: Int -> EpaLocation dn n = EpaDelta (SameLine n) [] -m0 :: AnchorOperation-m0 = MovedAnchor $ SameLine 0--m1 :: AnchorOperation-m1 = MovedAnchor $ SameLine 1--mn :: Int -> AnchorOperation-mn n = MovedAnchor $ SameLine n- addComma :: SrcSpanAnnA -> SrcSpanAnnA-addComma (SrcSpanAnn EpAnnNotUsed l)-  = (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnListItem [AddCommaAnn d0]) emptyComments) l)-addComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)-  = (SrcSpanAnn (EpAnn anc (AnnListItem (AddCommaAnn d0:as)) cs) l)+addComma (EpAnn anc (AnnListItem as) cs)+  = EpAnn anc (AnnListItem (AddCommaAnn d0:as)) cs  -- --------------------------------------------------------------------- @@ -813,7 +779,7 @@ insertAt f t decl = do   oldDecls <- hsDecls t   oldDeclsb <- balanceCommentsList oldDecls-  let oldDecls' = map commentsOrigDeltasDecl oldDeclsb+  let oldDecls' = oldDeclsb   replaceDecls t (f decl oldDecls')  -- |Insert a declaration at the beginning or end of the subdecls of the given@@ -823,9 +789,17 @@               -> LHsDecl GhcPs               -> Transform ast -insertAtStart = insertAt (:) insertAtEnd   = insertAt (\x xs -> xs ++ [x]) +insertAtStart = insertAt insertFirst+  where+    insertFirst x xs =+      case xs of+        [] -> [x]+        (h:t) -> x:setEntryDP h (DifferentLine 2 0):t+                   `debug` ("insertAtStart:h=" ++ showAst h)++ -- |Insert a declaration at a specific location in the subdecls of the given -- AST item insertAfter, insertBefore :: (HasDecls (LocatedA ast))@@ -840,8 +814,6 @@         ([],[]) -> [x]         (fs,[]) -> fs++[x]         (fs, b:bs) -> fs ++ (b : x : bs)-      -- let (fs, b:bs) = span (\(L l _) -> locA l /= k) xs-      -- in fs ++ (b : x : bs) insertBefore (getLocA -> k) = insertAt findBefore   where     findBefore x xs =@@ -852,7 +824,7 @@ -- start of HasDecls instances -- ===================================================================== --- |Provide a means to get and process the immediate child declartions of a+-- |Provide a means to get and process the immediate child declarations of a -- given AST element. class (Data t) => HasDecls t where -- ++AZ++: TODO: add tests to confirm that hsDecls followed by replaceDecls is idempotent@@ -888,16 +860,28 @@  instance HasDecls ParsedSource where   hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _mn _exps _imps decls)) = return decls+   replaceDecls (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps _decls)) decls     = do         logTr "replaceDecls LHsModule"-        -- modifyAnnsT (captureOrder m decls)         return (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps decls))  -- --------------------------------------------------------------------- +instance HasDecls (LocatedA (HsDecl GhcPs)) where+  hsDecls (L _ (TyClD _ c@ClassDecl{}))  = return $ hsDeclsClassDecl c+  hsDecls decl = do+    error $ "hsDecls:decl=" ++ showAst decl+  replaceDecls (L l (TyClD e dec@ClassDecl{})) decls = do+    let decl' = replaceDeclsClassDecl dec decls+    return (L l (TyClD e decl'))+  replaceDecls decl _decls = do+    error $ "replaceDecls:decl=" ++ showAst decl++-- ---------------------------------------------------------------------+ instance HasDecls (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where-  hsDecls (L _ (Match _ _ _ (GRHSs _ _ lb))) = hsDeclsValBinds lb+  hsDecls (L _ (Match _ _ _ (GRHSs _ _ lb))) = return $ hsDeclsLocalBinds lb    replaceDecls (L l (Match xm c p (GRHSs xr rhs binds))) []     = do@@ -926,40 +910,40 @@ -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (HsExpr GhcPs)) where-  hsDecls (L _ (HsLet _ _ decls _ _ex)) = hsDeclsValBinds decls-  hsDecls _                             = return []+  hsDecls (L _ (HsLet _ decls _ex)) = return $ hsDeclsLocalBinds decls+  hsDecls _                         = return [] -  replaceDecls (L ll (HsLet x tkLet binds tkIn ex)) newDecls+  replaceDecls (L ll (HsLet (tkLet, tkIn) binds ex)) newDecls     = do         logTr "replaceDecls HsLet"         let lastAnc = realSrcSpan $ spanHsLocaLBinds binds         -- TODO: may be an intervening comment, take account for lastAnc         let (tkLet', tkIn', ex',newDecls') = case (tkLet, tkIn) of-              (L (TokenLoc l) ls, L (TokenLoc i) is) ->+              (EpTok l, EpTok i) ->                 let                   off = case l of-                          (EpaSpan r _) -> LayoutStartCol $ snd $ ss2pos r+                          (EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r+                          (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0                           (EpaDelta (SameLine _) _) -> LayoutStartCol 0                           (EpaDelta (DifferentLine _ c) _) -> LayoutStartCol c                   ex'' = setEntryDPFromAnchor off i ex                   newDecls'' = case newDecls of                     [] -> newDecls                     (d:ds) -> setEntryDPDecl d (SameLine 0) : ds-                -- in ( EpAnn a (AnnsLet l (addEpaLocationDelta off lastAnc i)) cs-                in ( L (TokenLoc l) ls-                   , L (TokenLoc (addEpaLocationDelta off lastAnc i)) is+                in ( EpTok l+                   , EpTok (addEpaLocationDelta off lastAnc i)                    , ex''                    , newDecls'')               (_,_) -> (tkLet, tkIn, ex, newDecls)         binds' <- replaceDeclsValbinds WithoutWhere binds newDecls'-        return (L ll (HsLet x tkLet' binds' tkIn' ex'))+        return (L ll (HsLet (tkLet', tkIn') binds' ex'))    -- TODO: does this make sense? Especially as no hsDecls for HsPar-  replaceDecls (L l (HsPar x lpar e rpar)) newDecls+  replaceDecls (L l (HsPar x e)) newDecls     = do         logTr "replaceDecls HsPar"         e' <- replaceDecls e newDecls-        return (L l (HsPar x lpar e' rpar))+        return (L l (HsPar x e'))   replaceDecls old _new = error $ "replaceDecls (LHsExpr GhcPs) undefined for:" ++ showGhc old  -- ---------------------------------------------------------------------@@ -968,7 +952,7 @@ -- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is -- idempotent.-hsDeclsPatBindD :: (Monad m) => LHsDecl GhcPs -> TransformT m [LHsDecl GhcPs]+hsDeclsPatBindD :: LHsDecl GhcPs -> [LHsDecl GhcPs] hsDeclsPatBindD (L l (ValD _ d)) = hsDeclsPatBind (L l d) hsDeclsPatBindD x = error $ "hsDeclsPatBindD called for:" ++ showGhc x @@ -976,8 +960,8 @@ -- cannot be a member of 'HasDecls' because a 'FunBind' is not idempotent -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is -- idempotent.-hsDeclsPatBind :: (Monad m) => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs]-hsDeclsPatBind (L _ (PatBind _ _ (GRHSs _ _grhs lb))) = hsDeclsValBinds lb+hsDeclsPatBind :: LHsBind GhcPs -> [LHsDecl GhcPs]+hsDeclsPatBind (L _ (PatBind _ _ _ (GRHSs _ _grhs lb))) = hsDeclsLocalBinds lb hsDeclsPatBind x = error $ "hsDeclsPatBind called for:" ++ showGhc x  -- -------------------------------------@@ -999,17 +983,17 @@ -- idempotent. replaceDeclsPatBind :: (Monad m) => LHsBind GhcPs -> [LHsDecl GhcPs]                     -> TransformT m (LHsBind GhcPs)-replaceDeclsPatBind (L l (PatBind x a (GRHSs xr rhss binds))) newDecls+replaceDeclsPatBind (L l (PatBind x a p (GRHSs xr rhss binds))) newDecls     = do         logTr "replaceDecls PatBind"         binds'' <- replaceDeclsValbinds WithWhere binds newDecls-        return (L l (PatBind x a (GRHSs xr rhss binds'')))+        return (L l (PatBind x a p (GRHSs xr rhss binds''))) replaceDeclsPatBind x _ = error $ "replaceDeclsPatBind called for:" ++ showGhc x  -- ---------------------------------------------------------------------  instance HasDecls (LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))) where-  hsDecls (L _ (LetStmt _ lb))      = hsDeclsValBinds lb+  hsDecls (L _ (LetStmt _ lb))      = return $ hsDeclsLocalBinds lb   hsDecls (L _ (LastStmt _ e _ _))  = hsDecls e   hsDecls (L _ (BindStmt _ _pat e)) = hsDecls e   hsDecls (L _ (BodyStmt _ e _ _))  = hsDecls e@@ -1039,34 +1023,73 @@ -- =====================================================================  -- ---------------------------------------------------------------------+-- A @FunBind@ is a container for @[LMatch GhcPs]@+--+-- When being used as a Bind (or Decl), the surrounding context+-- annotations must appear at the FunBind level, so it can be+-- manipulated in the context of other Binds or Decls.+--+-- Surrounding context annotations are specifically prior comments,+-- following comments and trailing annotations.+--+-- But when we unpack the container, by calling @hsDecls@ on a+-- @FunBind@, we must make sure that the component parts fully+-- represent the relationship between them and the surrounding+-- declarations.+--+-- This means pushing the prior context annotations into the first+-- match, and the following ones into the last match when returning+-- @hsDecls@, and undoing this for @replaceDecls@. --- |Look up the annotated order and sort the decls accordingly--- TODO:AZ: this should be pure-orderedDecls :: (Monad m)-             => AnnSortKey -> [LHsDecl GhcPs] -> TransformT m [LHsDecl GhcPs]-orderedDecls sortKey decls = do-  case sortKey of-    NoAnnSortKey -> do-      -- return decls-      return $ sortBy (\a b -> compare (realSrcSpan $ getLocA a) (realSrcSpan $ getLocA b)) decls-    AnnSortKey keys -> do-      let ds = map (\s -> (rs $ getLocA s,s)) decls-          ordered = map snd $ orderByKey ds keys-      return ordered+-- |Push leading and trailing top level annotations into the @[LMatch GhcPs]@+unpackFunBind :: LHsBind GhcPs -> LHsBind GhcPs+unpackFunBind (L loc (FunBind x1 fid (MG x2 (L lg (L lm m:matches)))))+  = (L loc'' (FunBind x1 fid (MG x2 (L lg (reverse (L llm' lmtch:ms))))))+     -- `debug` ("unpackFunBind: ="+     --          ++ showAst (("loc",loc), ("loc'",loc'), ("loc''",loc''),+     --                      ("lm'",lm'), ("llm",llm), ("llm'", llm')))+  where+    (loc', lm') = transferPriorCommentsA loc lm+    matches' = reverse $ L lm' m:matches+    (L llm lmtch, ms) = case matches' of+                      mm:ms0 -> (mm,ms0)+                      _ -> error "unpackFunBind" --- ---------------------------------------------------------------------+    (loc'', llm') = transferFollowingA loc' llm -hsDeclsValBinds :: (Monad m) => HsLocalBinds GhcPs -> TransformT m [LHsDecl GhcPs]-hsDeclsValBinds lb = case lb of-    HsValBinds _ (ValBinds sortKey bs sigs) -> do-      let-        bds = map wrapDecl (bagToList bs)-        sds = map wrapSig sigs-      orderedDecls sortKey (bds ++ sds)-    HsValBinds _ (XValBindsLR _) -> error $ "hsDecls.XValBindsLR not valid"-    HsIPBinds {}       -> return []-    EmptyLocalBinds {} -> return []+unpackFunBind d = d +-- |Pull leading and trailing annotations from the @[LMatch GhcPs]@ to+-- the top level.+packFunBind :: LHsBind GhcPs -> LHsBind GhcPs+packFunBind (L loc (FunBind x1 fid (MG x2 (L lg (L lm m:matches)))))+  = (L loc'' (FunBind x1 fid (MG x2 (L lg (reverse (L llm' lmtch:ms))))))+     -- `debug` ("packFunBind: ="+     --          ++ showAst (("loc",loc), ("loc'",loc'), ("loc''",loc''),+     --                      ("lm'",lm'), ("llm",llm), ("llm'", llm')))+  where+    (lm', loc') = transferPriorCommentsA lm loc+    matches' = reverse $ L lm' m:matches+    (L llm lmtch, ms) = case matches' of+                      mm:ms0 -> (mm,ms0)+                      _ -> error "packFunBind"+    (llm', loc'') = transferFollowingA llm loc'+packFunBind d = d++packFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs+packFunDecl (L l (ValD x b)) = L l' (ValD x b')+  where+    L l' b' = packFunBind (L l b)+packFunDecl x = x++unpackFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs+unpackFunDecl (L l (ValD x b)) = L l' (ValD x b')+  where+    L l' b' = unpackFunBind (L l b)+unpackFunDecl x = x++-- ---------------------------------------------------------------------+ data WithWhere = WithWhere                | WithoutWhere                deriving (Eq,Show)@@ -1088,7 +1111,7 @@         an <- oldWhereAnnotation a w (realSrcSpan oldSpan)         let decs = listToBag $ concatMap decl2Bind new         let sigs = concatMap decl2Sig new-        let sortKey = captureOrder new+        let sortKey = captureOrderBinds new         return (HsValBinds an (ValBinds sortKey decs sigs)) replaceDeclsValbinds _ (HsIPBinds {}) _new    = error "undefined replaceDecls HsIPBinds" replaceDeclsValbinds w (EmptyLocalBinds _) new@@ -1099,25 +1122,11 @@             newSigs  = concatMap decl2Sig  new         let decs = listToBag $ newBinds         let sigs = newSigs-        let sortKey = captureOrder new+        let sortKey = captureOrderBinds new         return (HsValBinds an (ValBinds sortKey decs sigs))  oldWhereAnnotation :: (Monad m)   => EpAnn AnnList -> WithWhere -> RealSrcSpan -> TransformT m (EpAnn AnnList)-oldWhereAnnotation EpAnnNotUsed ww _oldSpan = do-  newSpan <- uniqueSrcSpanT-  let w = case ww of-        WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]-        WithoutWhere -> []-  let anc2' = Anchor (rs newSpan) (MovedAnchor (SameLine 1))-  (anc, anc2) <- do-          newSpan' <- uniqueSrcSpanT-          return ( Anchor (rs newSpan') (MovedAnchor (DifferentLine 1 2))-                 , anc2')-  let an = EpAnn anc-                  (AnnList (Just anc2) Nothing Nothing w [])-                  emptyComments-  return an oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do   -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation, change the AnnList anchor to have the correct DP too   let (AnnList ancl o c _r t) = an@@ -1135,9 +1144,8 @@  newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList) newWhereAnnotation ww = do-  newSpan <- uniqueSrcSpanT-  let anc  = Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 2))-  let anc2 = Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 4))+  let anc  = EpaDelta (DifferentLine 1 3) []+  let anc2 = EpaDelta (DifferentLine 1 5) []   let w = case ww of         WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])]         WithoutWhere -> []@@ -1163,20 +1171,21 @@ modifyValD p pb@(L ss (ValD _ (PatBind {} ))) f =   if (locA ss) == p      then do-       ds <- liftT $ hsDeclsPatBindD pb+       let ds = hsDeclsPatBindD pb        (ds',r) <- f (error "modifyValD.PatBind should not touch Match") ds        pb' <- liftT $ replaceDeclsPatBindD pb ds'        return (pb',r)      else return (pb,Nothing)-modifyValD p ast f = do-  (ast',r) <- runStateT (everywhereM (mkM doModLocal) ast) Nothing-  return (ast',r)+modifyValD p decl f = do+  (decl',r) <- runStateT (everywhereM (mkM doModLocal) (unpackFunDecl decl)) Nothing+  return (packFunDecl decl',r)   where     doModLocal :: PMatch -> StateT (Maybe t) m PMatch     doModLocal  (match@(L ss _) :: PMatch) = do          if (locA ss) == p            then do              ds <- lift $ liftT $ hsDecls match+                `debug` ("modifyValD: match=" ++ showAst match)              (ds',r) <- lift $ f match ds              put r              match' <- lift $ liftT $ replaceDecls match ds'
src/Language/Haskell/GHC/ExactPrint/Types.hs view
@@ -31,7 +31,7 @@ data Comment = Comment     {       commentContents   :: !String -- ^ The contents of the comment including separators-    , commentAnchor :: !Anchor+    , commentLoc :: !NoCommentsLocation     , commentPriorTok :: !RealSrcSpan     , commentOrigin :: !(Maybe AnnKeywordId) -- ^ We sometimes turn syntax into comments in order to process them properly.     }
src/Language/Haskell/GHC/ExactPrint/Utils.hs view
@@ -3,33 +3,77 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-} -module Language.Haskell.GHC.ExactPrint.Utils where+module Language.Haskell.GHC.ExactPrint.Utils+    -- (+    --   showAst+    -- , ss2pos, ss2posEnd+    -- , ss2delta, ss2deltaEnd+    -- , ss2range+    -- , rs+    -- , debug, debugM+    -- , adjustDeltaForOffset+    -- , sortEpaComments+    -- , epaCommentsBalanced+    -- , notDocDecl+    -- , notIEDoc+    -- , hsDeclsLocalBinds+    -- , hsDeclsClassDecl+    -- , hsDeclsValBinds+    -- , captureOrderBinds+    -- , wrapSig, wrapDecl+    -- , decl2Sig+    -- , mkLEpaComment+    -- , mkEpaComments+    -- , mkKWComment+    -- , tokComment+    -- , comment2LEpaComment+    -- , commentOrigDelta+    -- , replaceDeclsClassDecl+    -- , decl2Bind+    -- , badRealSrcSpan+    -- , rs2range+    -- , origDelta+    -- , dedentDocChunk+    -- , orderedDecls+    -- , needsWhere+    -- , undelta+    -- , spanLength+    -- , isGoodDelta+    -- , dpFromString+    -- , insertCppComments+    -- )+    where  import Control.Monad (when)+-- import Control.Monad.State.Lazy+import GHC.Utils.Monad.State.Strict+import Data.Data hiding ( Fixity ) import Data.Function+import Data.Generics.Aliases+import Data.Generics.Schemes import Data.List-import Data.Maybe-import Data.Ord (comparing)--import Language.Haskell.GHC.ExactPrint.Lookup--import qualified Language.Haskell.GHC.ExactPrint.Orphans()+import qualified Data.Map.Strict as Map -import GHC hiding (EpaComment) import qualified GHC+import GHC hiding (EpaComment)+import GHC.Base (NonEmpty(..))+import GHC.Data.Bag+import GHC.Data.FastString+import qualified GHC.Data.Strict as Strict+import GHC.Driver.Ppr+import GHC.Hs.Dump+import GHC.Parser.Lexer (allocateComments) import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.SrcLoc-import GHC.Driver.Ppr-import GHC.Data.FastString-import qualified GHC.Data.Strict as Strict-import GHC.Base (NonEmpty(..)) -import Debug.Trace+import Language.Haskell.GHC.ExactPrint.Lookup import Language.Haskell.GHC.ExactPrint.Types-import Data.Default +import Debug.Trace+ -- ---------------------------------------------------------------------  -- |Global switch to enable debug tracing in ghc-exactprint Delta / Print@@ -46,12 +90,32 @@ debugM :: Monad m => String -> m () debugM s = when debugEnabledFlag $ traceM s --- ---------------------------------------------------------------------- warn :: c -> String -> c -- warn = flip trace warn c _ = c +-- ---------------------------------------------------------------------++captureOrderBinds :: [LHsDecl GhcPs] -> AnnSortKey BindTag+captureOrderBinds ls = AnnSortKey $ map go ls+  where+    go (L _ (ValD _ _))       = BindTag+    go (L _ (SigD _ _))       = SigDTag+    go d      = error $ "captureOrderBinds:" ++ showGhc d++-- ---------------------------------------------------------------------++notDocDecl :: LHsDecl GhcPs -> Bool+notDocDecl (L _ DocD{}) = False+notDocDecl _ = True++notIEDoc :: LIE GhcPs -> Bool+notIEDoc (L _ IEGroup {})    = False+notIEDoc (L _ IEDoc {})      = False+notIEDoc (L _ IEDocNamed {}) = False+notIEDoc _ = True++-- --------------------------------------------------------------------- -- | A good delta has no negative values. isGoodDelta :: DeltaPos -> Bool isGoodDelta (SameLine co) = co >= 0@@ -106,9 +170,9 @@     fc = co + dc  undeltaSpan :: RealSrcSpan -> AnnKeywordId -> DeltaPos -> AddEpAnn-undeltaSpan anchor kw dp = AddEpAnn kw (EpaSpan sp Strict.Nothing)+undeltaSpan anc kw dp = AddEpAnn kw (EpaSpan (RealSrcSpan sp Strict.Nothing))   where-    (l,c) = undelta (ss2pos anchor) dp (LayoutStartCol 0)+    (l,c) = undelta (ss2pos anc) dp (LayoutStartCol 0)     len = length (keywordToString kw)     sp = range2rs ((l,c),(l,c+len)) @@ -150,6 +214,12 @@ spanLength :: RealSrcSpan -> Int spanLength = (-) <$> srcSpanEndCol <*> srcSpanStartCol ++-- | Useful for debug dumps+eloc2str :: EpaLocation -> String+eloc2str (EpaSpan r) = "EpaSpan " ++ show (ss2range r)+eloc2str epaLoc = show epaLoc+ -- --------------------------------------------------------------------- -- | Checks whether a SrcSpan has zero length. isPointSrcSpan :: RealSrcSpan -> Bool@@ -158,39 +228,24 @@  -- --------------------------------------------------------------------- -origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos-origDelta pos pp = op+-- | A GHC comment includes the span of the preceding token.  Take an+-- original comment, and convert the 'Anchor to have a have a+-- `MovedAnchor` operation based on the original location, only if it+-- does not already have one.+commentOrigDelta :: LEpaComment -> LEpaComment+commentOrigDelta (L (EpaSpan (RealSrcSpan la _)) (GHC.EpaComment t pp))+  = (L (EpaDelta dp NoComments) (GHC.EpaComment t pp))+                  `debug` ("commentOrigDelta: (la, pp, r,c, dp)=" ++ showAst (la, pp, r,c, dp))   where-    (r,c) = ss2posEnd pp--    op = if r == 0-           then (             ss2delta (r,c+1) pos)-           else (tweakDelta $ ss2delta (r,c  ) pos)---- ------------------------------------------------------------------------- | For comment-related deltas starting on a new line we have an--- off-by-one problem. Adjust-tweakDelta :: DeltaPos  -> DeltaPos-tweakDelta (SameLine d) = SameLine d-tweakDelta (DifferentLine l d) = DifferentLine l (d-1)---- ------------------------------------------------------------------------- |Given a list of items and a list of keys, returns a list of items--- ordered by their position in the list of keys.-orderByKey :: [(RealSrcSpan,a)] -> [RealSrcSpan] -> [(RealSrcSpan,a)]-orderByKey keys order-    -- AZ:TODO: if performance becomes a problem, consider a Map of the order-    -- SrcSpan to an index, and do a lookup instead of elemIndex.--    -- Items not in the ordering are placed to the start- = sortBy (comparing (flip elemIndex order . fst)) keys+        (r,c) = ss2posEnd pp --- ---------------------------------------------------------------------+        dp = if r == 0+               then (ss2delta (r,c+1) la)+               else (ss2delta (r,c)   la)+commentOrigDelta c = c -isListComp :: HsDoFlavour -> Bool-isListComp = isDoComprehensionContext+origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos+origDelta pos pp = ss2delta (ss2posEnd pp) pos  -- --------------------------------------------------------------------- @@ -202,16 +257,215 @@  -- --------------------------------------------------------------------- +-- | Insert the comments at the appropriate places in the AST insertCppComments ::  ParsedSource -> [LEpaComment] -> ParsedSource-insertCppComments (L l p) cs = L l p'+-- insertCppComments p [] = p+insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining   where-    an' = case GHC.hsmodAnn $ GHC.hsmodExt p of-      (EpAnn a an ocs) -> EpAnn a an (EpaComments cs')-        where-          cs' = sortEpaComments $ priorComments ocs ++ getFollowingComments ocs ++ cs-      unused -> unused+    (EpAnn anct ant cst) = hsmodAnn $ hsmodExt p+    cs = sortEpaComments $ priorComments cst ++ getFollowingComments cst ++ cs0+    p0 = p { hsmodExt = (hsmodExt p) { hsmodAnn = EpAnn anct ant emptyComments }}+    -- Comments embedded within spans+    -- everywhereM is a bottom-up traversal+    (p1, toplevel) = runState (everywhereM (mkM   addCommentsListItem+                                           `extM` addCommentsGrhs+                                           `extM` addCommentsList) p0) cs+    (p2, remaining) = insertTopLevelCppComments p1 toplevel++    addCommentsListItem :: EpAnn AnnListItem -> State [LEpaComment] (EpAnn AnnListItem)+    addCommentsListItem = addComments++    addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList)+    addCommentsList = addComments++    addCommentsGrhs :: EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)+    addCommentsGrhs = addComments++    addComments :: forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)+    addComments (EpAnn anc an ocs) = do+      case anc of+        EpaSpan (RealSrcSpan s _) -> do+          unAllocated <- get+          let+            (rest, these) = GHC.Parser.Lexer.allocateComments s unAllocated+            cs' = workInComments ocs these+          put rest+          return $ EpAnn anc an cs'++        _ -> return $ EpAnn anc an ocs++workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments+workInComments ocs [] = ocs+workInComments ocs new = cs'+  where+    pc = priorComments ocs+    fc = getFollowingComments ocs+    cs' = case fc of+      [] -> EpaComments $ sortEpaComments $ pc ++ fc ++ new+      (L ac _:_) -> epaCommentsBalanced (sortEpaComments $ pc ++ cs_before)+                                        (sortEpaComments $ fc ++ cs_after)+             where+               (cs_before,cs_after)+                   = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ anchor ac) )+                           new++insertTopLevelCppComments ::  HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])+insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs+  = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3)+    -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs))+    -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs))+  where+    -- Comments at the top level.+    (an0, cs0) =+      case mmn of+        Nothing -> (an, cs)+        Just _ ->+            -- We have a module name. Capture all comments up to the `where`+            let+              (these, remaining) = splitOnWhere Before (am_main $ anns an) cs+              (EpAnn a anno ocs) = an :: EpAnn AnnsModule+              anm = EpAnn a anno (workInComments ocs these)+            in+              (anm, remaining)+    (an1,cs0a) = case lo of+        EpExplicitBraces (EpTok (EpaSpan (RealSrcSpan s _))) _close ->+            let+                (stay,cs0a') = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ s)) cs0+                cs' = workInComments (comments an0) stay+            in (an0 { comments = cs' }, cs0a')+        _ -> (an0,cs0)+    -- Deal with possible leading semis+    (an2, cs0b) = case am_decls $ anns an1 of+        (AddSemiAnn (EpaSpan (RealSrcSpan s _)):_) -> (an1 {comments = cs'}, cs0b')+          where+            (stay,cs0b') = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ s)) cs0a+            cs' = workInComments (comments an1) stay+        _ -> (an1,cs0a)++    (mexports', an3, cs1) =+      case mexports of+        Nothing -> (Nothing, an2, cs0b)+        Just (L l exports) -> (Just (L l exports'), an3', cse)+                         where+                           hc1' = workInComments (comments an2) csh'+                           an3' = an2 { comments = hc1' }+                           (csh', cs0b') = case al_open $ anns l of+                               Just (AddEpAnn _ (EpaSpan (RealSrcSpan s _))) ->(h, n)+                                 where+                                   (h,n) = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos s) )+                                       cs0b++                               _ -> ([], cs0b)+                           (exports', cse) = allocPreceding exports cs0b'+    (imports0, cs2) = allocPreceding imports cs1+    (imports', hc0i) = balanceFirstLocatedAComments imports0++    (decls0, cs3) = allocPreceding decls cs2+    (decls', hc0d) = balanceFirstLocatedAComments decls0++    -- Either hc0i or hc0d should have comments. Combine them+    hc0 = hc0i ++ hc0d++    (hc1,hc_cs) = if null ( am_main $ anns an3)+        then (hc0,[])+        else splitOnWhere After (am_main $ anns an3)  hc0+    hc2 = workInComments (comments an3) hc1+    an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 }++    allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])+    allocPreceding [] cs' = ([], cs')+    allocPreceding (L (EpAnn anc4 an5 cs4) a:xs) cs' = ((L (EpAnn anc4 an5 cs4') a:xs'), rest')+      where+        (rest, these) =+          case anc4 of+            EpaSpan (RealSrcSpan s _) ->+                allocatePriorComments (ss2pos s) cs'+            _ -> (cs', [])+        cs4' = workInComments cs4 these+        (xs',rest') = allocPreceding xs rest++data SplitWhere = Before | After+splitOnWhere :: SplitWhere -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])+splitOnWhere _ [] csIn = (csIn,[])+splitOnWhere w (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc)+  where+    splitFunc Before anc_pos c_pos = c_pos < anc_pos+    splitFunc After  anc_pos c_pos = anc_pos < c_pos+    (hc,fc) = break (\(L ll _) ->  splitFunc w (ss2pos $ anchor ll) (ss2pos s)) csIn+splitOnWhere _ (AddEpAnn AnnWhere _:_) csIn = (csIn, [])+splitOnWhere f (_:as) csIn = splitOnWhere f as csIn++balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment])+balanceFirstLocatedAComments [] = ([],[])+balanceFirstLocatedAComments ((L (EpAnn anc an csd) a):ds) = (L (EpAnn anc an csd0) a:ds, hc')+  where+    (csd0, hc') = case anc of+        EpaSpan (RealSrcSpan s _) -> (csd', hc)+               `debug` ("balanceFirstLocatedAComments: (csd,csd',attached,header)=" ++ showAst (csd,csd',attached,header))+          where+            (priors, inners) =  break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos s) )+                                       (priorComments csd)+            pcds = priorCommentsDeltas' s priors+            (attached, header) = break (\(d,_c) -> d /= 1) pcds+            csd' = setPriorComments csd (reverse (map snd attached) ++ inners)+            hc = reverse (map snd header)+        _ -> (csd, [])++++priorCommentsDeltas' :: RealSrcSpan -> [LEpaComment]+                    -> [(Int, LEpaComment)]+priorCommentsDeltas' r cs = go r (reverse cs)+  where+    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]+    go _   [] = []+    go _   (la@(L l@(EpaDelta dp _) _):las) = (deltaLine dp, la) : go (anchor l) las+    go rs' (la@(L l _):las) = deltaComment rs' la : go (anchor l) las++    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)+    deltaComment rs' (L loc c) = (abs(ll - al), L loc c)+      where+        (al,_) = ss2pos rs'+        (ll,_) = ss2pos (anchor loc)++allocatePriorComments+  :: Pos+  -> [LEpaComment]+  -> ([LEpaComment], [LEpaComment])+allocatePriorComments ss_loc comment_q =+  let+    cmp (L l _) = ss2pos (anchor l) <= ss_loc+    (newAnns,after) = partition cmp comment_q+  in+    (after, newAnns)++insertRemainingCppComments ::  ParsedSource -> [LEpaComment] -> ParsedSource+insertRemainingCppComments (L l p) cs = L l p'+    -- `debug` ("insertRemainingCppComments: (cs,an')=" ++ showAst (cs,an'))+  where+    (EpAnn a an ocs) = GHC.hsmodAnn $ GHC.hsmodExt p+    an' = EpAnn a an (addTrailingComments end_loc ocs cs)     p' = p { GHC.hsmodExt = (GHC.hsmodExt p) { GHC.hsmodAnn = an' } }+    end_loc = case GHC.hsmodLayout $ GHC.hsmodExt p of+        EpExplicitBraces _open close -> case close of+            EpTok (EpaSpan (RealSrcSpan s _)) -> ss2pos s+            _ -> (1,1)+        _ -> (1,1)+    (new_before, new_after) = break (\(L ll _) -> (ss2pos $ anchor ll) > end_loc ) cs +    addTrailingComments end_loc' cur new = epaCommentsBalanced pc' fc'+      where+        pc = priorComments cur+        fc = getFollowingComments cur+        (pc', fc') = case reverse pc of+            [] -> (sortEpaComments $ pc ++ new_before, sortEpaComments $ fc ++ new_after)+            (L ac _:_) -> (sortEpaComments $ pc ++ cs_before, sortEpaComments $ fc ++ cs_after)+              where+               (cs_before,cs_after)+                   = if (ss2pos $ anchor ac) > end_loc'+                       then break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ anchor ac) ) new+                       else (new_before, new_after)+ -- ---------------------------------------------------------------------  ghcCommentText :: LEpaComment -> String@@ -219,12 +473,11 @@ ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _))      = s ghcCommentText (L _ (GHC.EpaComment (EpaLineComment s) _))     = s ghcCommentText (L _ (GHC.EpaComment (EpaBlockComment s) _))    = s-ghcCommentText (L _ (GHC.EpaComment (EpaEofComment) _))        = ""  tokComment :: LEpaComment -> [Comment] tokComment t@(L lt c) =   case c of-    (GHC.EpaComment (EpaDocComment dc) pt) -> hsDocStringComments lt pt dc+    (GHC.EpaComment (EpaDocComment dc) pt) -> hsDocStringComments (noCommentsToEpaLocation lt) pt dc     _ -> [mkComment (normaliseCommentText (ghcCommentText t)) lt (ac_prior_tok c)]  hsDocStringComments :: Anchor -> RealSrcSpan -> GHC.HsDocString -> [Comment]@@ -239,13 +492,12 @@   in     (Comment str (spanAsAnchor lx) pt Nothing : docChunk (rs lx) (map dedentDocChunk xs)) hsDocStringComments anc pt (NestedDocString dec@(HsDocStringNamed _) (L _ chunk))-  = [Comment ("{- " ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ]+  = [Comment ("{- " ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") (epaToNoCommentsLocation anc) pt Nothing ] hsDocStringComments anc pt (NestedDocString dec (L _ chunk))-  = [Comment ("{-" ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ]+  = [Comment ("{-" ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") (epaToNoCommentsLocation anc) pt Nothing ]  hsDocStringComments _ _ (GeneratedDocString _) = [] -- Should not appear in user-written code --- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/23459 is landed -- At the moment the locations of the 'HsDocStringChunk's are from the start of -- the string part, leaving aside the "--". So we need to subtract 2 columns from it dedentDocChunk :: LHsDocStringChunk -> LHsDocStringChunk@@ -264,34 +516,31 @@  dedentDocChunkBy _ x = x --- Temporary until https://gitlab.haskell.org/ghc/ghc/-/issues/23459 is landed-printDecorator :: HsDocStringDecorator -> String-printDecorator HsDocStringNext = "|"-printDecorator HsDocStringPrevious = "^"-printDecorator (HsDocStringNamed n) = '$':n-printDecorator (HsDocStringGroup n) = replicate n '*' -+epaCommentsBalanced :: [LEpaComment] -> [LEpaComment] -> EpAnnComments+epaCommentsBalanced priorCs     [] = EpaComments priorCs+epaCommentsBalanced priorCs postCs = EpaCommentsBalanced priorCs postCs  mkEpaComments :: [Comment] -> [Comment] -> EpAnnComments mkEpaComments priorCs []   = EpaComments (map comment2LEpaComment priorCs) mkEpaComments priorCs postCs-  = EpaCommentsBalanced (map comment2LEpaComment priorCs) (map comment2LEpaComment postCs)+  = epaCommentsBalanced (map comment2LEpaComment priorCs) (map comment2LEpaComment postCs)  comment2LEpaComment :: Comment -> LEpaComment comment2LEpaComment (Comment s anc r _mk) = mkLEpaComment s anc r -mkLEpaComment :: String -> Anchor -> RealSrcSpan -> LEpaComment-mkLEpaComment "" anc r = (L anc (GHC.EpaComment (EpaEofComment) r))-mkLEpaComment s anc r = (L anc (GHC.EpaComment (EpaLineComment s) r))+mkLEpaComment :: String -> NoCommentsLocation -> RealSrcSpan -> LEpaComment+mkLEpaComment s loc r = (L loc (GHC.EpaComment (EpaLineComment s) r)) -mkComment :: String -> Anchor -> RealSrcSpan -> Comment-mkComment c anc r = Comment c anc r Nothing+mkComment :: String -> NoCommentsLocation -> RealSrcSpan -> Comment+mkComment c loc r = Comment c loc r Nothing  -- Windows comments include \r in them from the lexer. normaliseCommentText :: String -> String-normaliseCommentText = filter (/= '\r')+normaliseCommentText [] = []+normaliseCommentText ('\r':xs) = normaliseCommentText xs+normaliseCommentText (x:xs) = x:normaliseCommentText xs  -- |Must compare without span filenames, for CPP injected comments with fake filename cmpComments :: Comment -> Comment -> Ordering@@ -308,18 +557,13 @@     cmp (L l1 _) (L l2 _) = compare (ss2pos $ anchor l1) (ss2pos $ anchor l2)  -- | Makes a comment which originates from a specific keyword.-mkKWComment :: AnnKeywordId -> EpaLocation -> Comment-mkKWComment kw (EpaSpan ss _)-  = Comment (keywordToString kw) (Anchor ss UnchangedAnchor) ss (Just kw)-mkKWComment kw (EpaDelta dp _)-  = Comment (keywordToString kw) (Anchor placeholderRealSpan (MovedAnchor dp)) placeholderRealSpan (Just kw)---- | Detects a comment which originates from a specific keyword.-isKWComment :: Comment -> Bool-isKWComment c = isJust (commentOrigin c)--noKWComments :: [Comment] -> [Comment]-noKWComments = filter (\c -> not (isKWComment c))+mkKWComment :: AnnKeywordId -> NoCommentsLocation -> Comment+mkKWComment kw (EpaSpan (RealSrcSpan ss mb))+  = Comment (keywordToString kw) (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)+mkKWComment kw (EpaSpan (UnhelpfulSpan _))+  = Comment (keywordToString kw) (EpaDelta (SameLine 0) NoComments) placeholderRealSpan (Just kw)+mkKWComment kw (EpaDelta dp cs)+  = Comment (keywordToString kw) (EpaDelta dp cs) placeholderRealSpan (Just kw)  sortAnchorLocated :: [GenLocated Anchor a] -> [GenLocated Anchor a] sortAnchorLocated = sortBy (compare `on` (anchor . getLoc))@@ -356,113 +600,178 @@ name2String :: Name -> String name2String = showPprUnsafe - -- -----------------------------------------------------------------------locatedAnAnchor :: LocatedAn a t -> RealSrcSpan-locatedAnAnchor (L (SrcSpanAnn EpAnnNotUsed l) _) = realSrcSpan l-locatedAnAnchor (L (SrcSpanAnn (EpAnn a _ _) _) _) = anchor a- -- --------------------------------------------------------------------- --- Note: moved to Language.Haskell.GHC.ExactPrint.ExactPrint as a hack--- to avoid import loop problems while we have to use the local--- version of Dump--- showAst :: (Data a) => a -> String--- showAst ast---   = showSDocUnsafe---     $ showAstData NoBlankSrcSpan NoBlankEpAnnotations ast---- -----------------------------------------------------------------------setAnchorAn :: (Default an) => LocatedAn an a -> Anchor -> EpAnnComments -> LocatedAn an a-setAnchorAn (L (SrcSpanAnn EpAnnNotUsed l)    a) anc cs-  = (L (SrcSpanAnn (EpAnn anc def cs) l) a)-     -- `debug` ("setAnchorAn: anc=" ++ showAst anc)-setAnchorAn (L (SrcSpanAnn (EpAnn _ an _) l) a) anc cs-  = (L (SrcSpanAnn (EpAnn anc an cs) l) a)-     -- `debug` ("setAnchorAn: anc=" ++ showAst anc)--setAnchorEpa :: (Default an) => EpAnn an -> Anchor -> EpAnnComments -> EpAnn an-setAnchorEpa EpAnnNotUsed   anc cs = EpAnn anc def cs-setAnchorEpa (EpAnn _ an _) anc cs = EpAnn anc an          cs--setAnchorEpaL :: EpAnn AnnList -> Anchor -> EpAnnComments -> EpAnn AnnList-setAnchorEpaL EpAnnNotUsed   anc cs = EpAnn anc mempty cs-setAnchorEpaL (EpAnn _ an _) anc cs = EpAnn anc (an {al_anchor = Nothing}) cs--setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs-setAnchorHsModule hsmod anc cs = hsmod { hsmodExt = (hsmodExt hsmod) {hsmodAnn = an'} }-  where-    anc' = anc { anchor_op = UnchangedAnchor }-    an' = setAnchorEpa (hsmodAnn $ hsmodExt hsmod) anc' cs---- |Version of l2l that preserves the anchor, immportant if it has an--- updated AnchorOperation-moveAnchor :: Monoid b => SrcAnn a -> SrcAnn b-moveAnchor (SrcSpanAnn EpAnnNotUsed l) = noAnnSrcSpan l-moveAnchor (SrcSpanAnn (EpAnn anc _ cs) l) = SrcSpanAnn (EpAnn anc mempty cs) l---- ---------------------------------------------------------------------- trailingAnnLoc :: TrailingAnn -> EpaLocation trailingAnnLoc (AddSemiAnn ss)    = ss trailingAnnLoc (AddCommaAnn ss)   = ss trailingAnnLoc (AddVbarAnn ss)    = ss+trailingAnnLoc (AddDarrowAnn ss)  = ss+trailingAnnLoc (AddDarrowUAnn ss) = ss  setTrailingAnnLoc :: TrailingAnn -> EpaLocation -> TrailingAnn setTrailingAnnLoc (AddSemiAnn _)    ss = (AddSemiAnn ss) setTrailingAnnLoc (AddCommaAnn _)   ss = (AddCommaAnn ss) setTrailingAnnLoc (AddVbarAnn _)    ss = (AddVbarAnn ss)+setTrailingAnnLoc (AddDarrowAnn _)  ss = (AddDarrowAnn ss)+setTrailingAnnLoc (AddDarrowUAnn _) ss = (AddDarrowUAnn ss)  addEpAnnLoc :: AddEpAnn -> EpaLocation addEpAnnLoc (AddEpAnn _ l) = l  -- --------------------------------------------------------------------- --- TODO: move this to GHC-anchorToEpaLocation :: Anchor -> EpaLocation-anchorToEpaLocation (Anchor r UnchangedAnchor) = EpaSpan r Strict.Nothing-anchorToEpaLocation (Anchor _ (MovedAnchor dp)) = EpaDelta dp []+type DeclsByTag a = Map.Map DeclTag [(RealSrcSpan, a)] +orderedDecls+  :: AnnSortKey DeclTag+  -> DeclsByTag a+  -> [(RealSrcSpan, a)]+orderedDecls sortKey declGroup  =+  case sortKey of+    NoAnnSortKey ->+      sortBy (\a b -> compare (fst a) (fst b)) (concat $ Map.elems declGroup)+    AnnSortKey keys ->+      let+        go :: [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]+        go [] _                      = []+        go (tag:ks) dbt = d : go ks dbt'+          where+            dbt' = Map.adjust (\ds -> drop 1 ds) tag dbt+            d = case Map.lookup tag dbt of+              Just (d':_) -> d'+              _           -> error $ "orderedDecls: could not look up "+                                       ++ show tag ++ " in " ++ show (Map.keys dbt)+      in+        go keys declGroup++hsDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs]+hsDeclsClassDecl dec = case dec of+  ClassDecl { tcdCExt = (_an2, _layout, sortKey),+              tcdSigs = sigs,tcdMeths = methods,+              tcdATs = ats, tcdATDefs = at_defs+            } -> map snd decls+    where+      srs :: EpAnn a -> RealSrcSpan+      srs a = realSrcSpan $ locA a+      decls+          = orderedDecls sortKey $ Map.fromList+              [(ClsSigTag,    map (\(L l s) -> (srs l, L l (SigD noExtField s))) sigs),+               (ClsMethodTag, map (\(L l s) -> (srs l, L l (ValD noExtField s))) (bagToList methods)),+               (ClsAtTag,     map (\(L l s) -> (srs l, L l (TyClD noExtField $ FamDecl noExtField s))) ats),+               (ClsAtdTag,    map (\(L l s) -> (srs l, L l (InstD noExtField $ TyFamInstD noExtField s))) at_defs)+              ]+  _ -> error $ "hsDeclsClassDecl:dec=" ++ showAst dec++replaceDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs+replaceDeclsClassDecl decl decls = case decl of+  ClassDecl { tcdCExt = (an2, layout, _) } -> decl'+    where+      (tags, methods', sigs', ats', at_defs', _, _docs) = partitionWithSortKey decls+      decl' = decl { tcdCExt = (an2, layout, AnnSortKey tags),+                     tcdSigs = sigs',tcdMeths = methods',+                     tcdATs = ats', tcdATDefs = at_defs'+                   }++  _ -> error $ "replaceDeclsClassDecl:decl=" ++ showAst decl++partitionWithSortKey+  :: [LHsDecl GhcPs]+  -> ([DeclTag], LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],+      [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])+partitionWithSortKey = go+  where+    go [] = ([], emptyBag, [], [], [], [], [])+    go ((L l decl) : ds) =+      let (tags, bs, ss, ts, tfis, dfis, docs) = go ds in+      case decl of+        ValD _ b+          -> (ClsMethodTag:tags, L l b `consBag` bs, ss, ts, tfis, dfis, docs)+        SigD _ s+          -> (ClsSigTag:tags, bs, L l s : ss, ts, tfis, dfis, docs)+        TyClD _ (FamDecl _ t)+          -> (ClsAtTag:tags, bs, ss, L l t : ts, tfis, dfis, docs)+        InstD _ (TyFamInstD { tfid_inst = tfi })+          -> (ClsAtdTag:tags, bs, ss, ts, L l tfi : tfis, dfis, docs)+        InstD _ (DataFamInstD { dfid_inst = dfi })+          -> (tags, bs, ss, ts, tfis, L l dfi : dfis, docs)+        DocD _ d+          -> (tags, bs, ss, ts, tfis, dfis, L l d : docs)+        _ -> error $ "partitionBindsAndSigs" ++ (showAst decl)++ -- ------------------------------------------------------------------------ Horrible hack for dealing with some things still having a SrcSpan,--- not an Anchor. -{--A SrcSpan is defined as+orderedDeclsBinds+  :: AnnSortKey BindTag+  -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]+  -> [LHsDecl GhcPs]+orderedDeclsBinds sortKey binds sigs =+  case sortKey of+    NoAnnSortKey ->+      sortBy (\a b -> compare (realSrcSpan $ getLocA a)+                              (realSrcSpan $ getLocA b)) (binds ++ sigs)+    AnnSortKey keys ->+      let+        go [] _ _                      = []+        go (BindTag:ks) (b:bs) ss = b : go ks bs ss+        go (SigDTag:ks) bs (s:ss) = s : go ks bs ss+        go (_:ks) bs ss           =     go ks bs ss+      in+        go keys binds sigs -data SrcSpan =-    RealSrcSpan !RealSrcSpan !(Maybe BufSpan)  -- See Note [Why Maybe BufPos]-  | UnhelpfulSpan !UnhelpfulSpanReason+hsDeclsLocalBinds :: HsLocalBinds GhcPs -> [LHsDecl GhcPs]+hsDeclsLocalBinds lb = case lb of+    HsValBinds _ (ValBinds sortKey bs sigs) ->+      let+        bds = map wrapDecl (bagToList bs)+        sds = map wrapSig sigs+      in+        orderedDeclsBinds sortKey bds sds+    HsValBinds _ (XValBindsLR _) -> error $ "hsDecls.XValBindsLR not valid"+    HsIPBinds {}       -> []+    EmptyLocalBinds {} -> [] -data BufSpan =-  BufSpan { bufSpanStart, bufSpanEnd :: {-# UNPACK #-} !BufPos }-  deriving (Eq, Ord, Show)+hsDeclsValBinds :: (HsValBindsLR GhcPs GhcPs) -> [LHsDecl GhcPs]+hsDeclsValBinds (ValBinds sortKey bs sigs) =+      let+        bds = map wrapDecl (bagToList bs)+        sds = map wrapSig sigs+      in+        orderedDeclsBinds sortKey bds sds+hsDeclsValBinds XValBindsLR{} = error "hsDeclsValBinds" -newtype BufPos = BufPos { bufPos :: Int }+-- --------------------------------------------------------------------- +-- |Pure function to convert a 'LHsDecl' to a 'LHsBind'. This does+-- nothing to any annotations that may be attached to either of the elements.+-- It is used as a utility function in 'replaceDecls'+decl2Bind :: LHsDecl GhcPs -> [LHsBind GhcPs]+decl2Bind (L l (ValD _ s)) = [L l s]+decl2Bind _                      = [] -We use the BufPos to encode a delta, using bufSpanStart for the line,-and bufSpanEnd for the col.+-- |Pure function to convert a 'LSig' to a 'LHsBind'. This does+-- nothing to any annotations that may be attached to either of the elements.+-- It is used as a utility function in 'replaceDecls'+decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]+decl2Sig (L l (SigD _ s)) = [L l s]+decl2Sig _                = [] -To be absolutely sure, we make the delta versions use -ve values.+-- --------------------------------------------------------------------- --}+-- |Convert a 'LSig' into a 'LHsDecl'+wrapSig :: LSig GhcPs -> LHsDecl GhcPs+wrapSig (L l s) = L l (SigD NoExtField s) -hackSrcSpanToAnchor :: SrcSpan -> Anchor-hackSrcSpanToAnchor (UnhelpfulSpan s) = error $ "hackSrcSpanToAnchor : UnhelpfulSpan:" ++ show s-hackSrcSpanToAnchor (RealSrcSpan r Strict.Nothing) = Anchor r UnchangedAnchor-hackSrcSpanToAnchor (RealSrcSpan r (Strict.Just (BufSpan (BufPos s) (BufPos e))))-  = if s <= 0 && e <= 0-    then Anchor r (MovedAnchor (deltaPos (-s) (-e)))-    else Anchor r UnchangedAnchor+-- --------------------------------------------------------------------- -hackAnchorToSrcSpan :: Anchor -> SrcSpan-hackAnchorToSrcSpan (Anchor r UnchangedAnchor) = RealSrcSpan r Strict.Nothing-hackAnchorToSrcSpan (Anchor r (MovedAnchor dp))-  = RealSrcSpan r (Strict.Just (BufSpan (BufPos s) (BufPos e)))-  where-    s = - (getDeltaLine dp)-    e = - (deltaColumn dp)+-- |Convert a 'LHsBind' into a 'LHsDecl'+wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs+wrapDecl (L l s) = L l (ValD NoExtField s)  -- ---------------------------------------------------------------------++showAst :: (Data a) => a -> String+showAst ast+  = showSDocUnsafe+    $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast
− tests/PrepareHackage.hs 
@@ -1,172 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}  ----import Data.Char--- import Data.Monoid-import System.Directory-import System.FilePath.Posix--- import System.IO-import Test.CommonUtils-import Turtle hiding (FilePath,(<.>))-import qualified Data.Set as Set-import qualified Data.Text as T-import qualified Data.Text.IO as T---- import qualified GHC.IO.Handle.Text as GHC--import Test.HUnit--main :: IO ()-main = do-  packages <- allCabalPackages-  -- packages <- allCabalPackagesTest-  myecho (T.pack $ "number of packages:" ++ (show $ length packages))-  packageDirsFull <- drop 2 <$> getDirectoryContents hackageWorkDir-  let cond c = c == '.' || c == '-' || isDigit c-  let packageDirs = map (T.dropWhileEnd cond . T.pack) packageDirsFull-  isBadPackages <- doesFileExist badpackagesFile-  badPackages <- if isBadPackages-                   then T.lines <$> T.readFile badpackagesFile-                   else return []-  let alreadyUnpacked = Set.fromList $ packageDirs ++ badPackages-  _ <- shell ("mkdir -p " <> (T.pack hackageWorkDir)) empty-  mapM_ (preparePackage alreadyUnpacked) packages---- -----------------------------------------------------------------------preparePackage :: Set.Set Text -> Text -> IO ()-preparePackage alreadyUnpacked package = do-  myecho $ "preparePackage:" <> package-  if Set.member package alreadyUnpacked-     then myecho $ "already unpacked:" <> package-     else preparePackage' package--preparePackage' :: Text -> IO ()-preparePackage' package = do-  (ec,dir) <- shellStrict ("cabal get --destdir=" <> T.pack hackageWorkDir <> " " <> package) empty-  myecho (T.pack $ "cabal get:" ++ show dir)-  -- cabal get:"Unpacking to\n./hackage-roundtrip-work/amazonka-kinesis-video-archived-media-2.0/\n"-  myecho (T.pack $ show ec)-  when (ec == ExitSuccess) $ do-    let bits = T.splitOn " " (last $ T.lines dir)-    myecho (T.pack $ "cabal get:dir=" ++ show (last bits))-    cleanPackage (last bits)-  return ()---- ------------------------------------------------------------------------- |Clean up whitespace in a package--cleanPackage :: Text -> IO ()-cleanPackage dir = do-  myecho ("cleaning:" <> dir)-  fs <- findSrcFiles (T.unpack dir)-  let-    doOne :: FilePath -> IO ()-    doOne fn = do-      myecho ("doOne:" <> T.pack fn)-      let tmpFn = fn <.> "clean"-      clean <- cleanupWhiteSpace fn-      writeFile tmpFn clean-      removeFile fn-      renameFile tmpFn fn-      return ()-  mapM_ doOne fs-  myecho ("cleaned up:" <> dir)---- ------------------------------------------------------------------------ | The computation 'writeFile' @file str@ function writes the string @str@,--- to the file @file@.--- writeFileUtf8 :: FilePath -> String -> IO ()--- writeFileUtf8 ff txt = withFile ff WriteMode (\ hdl -> hSetEncoding hdl utf8 >> GHC.hPutStr hdl txt)---- ------------------------------------------------------------------------- allCabalPackagesTest :: IO [Text]--- allCabalPackagesTest---   = return ["3d-graphics-examples","3dmodels","4Blocks","AAI","ABList"]---   -- = return ["airship"]---allCabalPackages :: IO [Text]-allCabalPackages = do-  -- let cmd = "cabal list --simple-output | awk '{ print $1 }' | uniq"-  let cmd = "cabal list --simple-output | awk '{ print $1 }' | sort | uniq"-  (_ec,r) <- shellStrict cmd empty-  let packages = T.lines r-  myecho (T.pack $ show $ take 5 packages)-  return packages---- ------------------------------------------------------------------------- |strip trailing whitespace, and turn tabs into spaces-cleanupWhiteSpace :: FilePath -> IO String-cleanupWhiteSpace file = do-  contents <- readFileGhc file-  let cleaned = map cleanupOneLine (lines $ contents)-  return (unlines cleaned)--tabWidth :: Int-tabWidth = 8---- nonBreakingSpace :: Char--- nonBreakingSpace = '\xa0'--cleanupOneLine :: String -> String-cleanupOneLine str = str'-  where-    numSpacesForTab n = tabWidth - (n `mod` tabWidth)-    -- loop over the line, keeping current pos. Where a tab is found, insert-    -- spaces until the next tab stop. Discard any trailing whitespace.-    go col res cur =-      case cur of-        [] -> res-        ('\t':cur') -> go (col + toAdd) ((replicate toAdd ' ') ++ res) cur'-                where-                  toAdd = numSpacesForTab col-        ('\xa0':cur') -> go (col + 1) (' ':res) cur'--        -- convert ISO 8859-16 euro symbol to the UTF8 equivalent-        -- ('\xa4':cur') -> go (col + 1) ('\x20ac':res) cur'-        (c:cur') ->go (col + 1) (c:res) cur'-    str1 = go 0 [] str-    str' = reverse $ dropWhile isSpace str1---- -----------------------------------------------------------------------tt :: IO Counts-tt = runTestTT $ TestList-                  [ testCleanupOneLine-                  , testTabs-                  ]--testCleanupOneLine :: Test-testCleanupOneLine = do-  let-    makeCase n = (show n-                 ,(replicate n ' ') <> "\t|" <> replicate n ' ' <> "\t"-                 ,(replicate 8 ' ' <> "|"))-    mkTest n = TestCase $ assertEqual name outp (cleanupOneLine inp)-      where (name,inp,outp) = makeCase n-  testList "cleanupOneLine" $ map mkTest [1..7]--testTabs :: Test-testTabs = TestCase $ assertEqual "testTabs" t2tabsExpected (cleanupOneLine t2tabs)-  where-    t2tabs = "import Data.Foldable\t\t    ( foldMap )"-    t2tabsExpected ="import Data.Foldable                ( foldMap )"--testList :: String -> [Test] -> Test-testList str ts = TestLabel str (TestList ts)---- -----------------------------------------------------------------------myecho :: T.Text -> IO ()-myecho t = mapM_ echo (textToLines t)---- -----------------------------------------------------------------------pwd :: IO FilePath-pwd = getCurrentDirectory--mcd :: FilePath -> IO ()-mcd = setCurrentDirectory
tests/Test.hs view
@@ -28,25 +28,26 @@  -- --------------------------------------------------------------------- -data GHCVersion = GHC96-           | GHC98+data GHCVersion = GHC98+           | GHC910      deriving (Eq, Ord, Show)  ghcVersion :: GHCVersion-#if MIN_VERSION_ghc(9,8,0)-ghcVersion = GHC98+#if MIN_VERSION_ghc(9,10,0)+ghcVersion = GHC910 #else-ghcVersion = GHC96+ghcVersion = GHC98 #endif  -- | Directories to automatically find roundtrip tests testDirs :: [FilePath] testDirs =   case ghcVersion of-    GHC96  -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96"]-    GHC98  -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96", "ghc98"]-    -- GHC98  -> ["ghc98"]-    -- GHC98  -> ["ghc98-copied"]+    GHC98 -> ["pre-ghc910"]+    GHC910 -> ["pre-ghc910", "ghc910"]+    -- GHC910  -> ["ghc910"]+    -- GHC910  -> ["ghc910-copied"]+    -- GHC910  -> ["ghc910",  "ghc910-copied"]  -- --------------------------------------------------------------------- @@ -60,14 +61,10 @@      then exitFailure      else return () -- exitSuccess -transform :: IO ()-transform = hSilence [stderr] $ do+transform :: IO (Counts,Int)+transform = do   let libdir = GHC.Paths.libdir-  cnts <- fst <$> runTestText (putTextToHandle stdout True) (transformTestsTT libdir)-  putStrLn $ show cnts-  if errors cnts > 0 || failures cnts > 0-     then exitFailure-     else return () -- exitSuccess+  runTestText (putTextToHandle stdout True) (transformTestsTT libdir)  -- --------------------------------------------------------------------- @@ -141,25 +138,19 @@   roundTripTests <- findTests libdir   roundTripBalanceCommentsTests <- findTestsBC libdir   roundTripMakeDeltaTests <- findTestsMD libdir-  -- prettyRoundTripTests <- findPrettyTests libdir   return $ TestList [                       internalTests,                       roundTripTests                    ,                      (transformTests libdir)-                   , (failingTests libdir)                    ,+                      (failingTests libdir)+                   ,                      roundTripBalanceCommentsTests                    ,                      roundTripMakeDeltaTests                     ] --- Tests that are no longer needed-                    -- , noAnnotationTests-                    -- ,-                    --   prettyRoundTripTests-                    -- ,- failingTests :: LibDir -> Test failingTests libdir = testList "Failing tests"   [@@ -167,6 +158,8 @@    -- We do not capture EOF location very well any more     mkTestModBad libdir "T10970a.hs"+  -- Injecting CPP comments adjacent to existing ones is a problem+  , mkTestModBad libdir "CppComment.hs"   ]  @@ -201,24 +194,22 @@ tt' = do   let libdir = GHC.Paths.libdir   runTestText (putTextToHandle stdout True) $ TestList [-    -- mkParserTest libdir "ghc92" "TopLevelSemis.hs"-    -- mkParserTestBC libdir "ghc92" "TopLevelSemis.hs"-    -- mkParserTestMD libdir "ghc92" "TopLevelSemis.hs" -    -- mkParserTest libdir "ghc96" "T11671_run.hs"--    -- mkParserTest libdir "ghc96" "LexerM.hs"-    -- mkParserTestBC libdir "ghc96" "LexerM.hs"--    -- mkParserTest libdir "ghc94" "Haddock.hs"-    -- mkParserTest libdir "ghc94" "Haddock1.hs"-    -- mkParserTest libdir "ghc94" "Haddock2.hs"-    -- mkParserTestBC libdir "ghc94" "Haddock1.hs"+    -- mkParserTest libdir "ghc98" "ModuleComments1.hs"+    -- mkParserTestBC libdir "ghc98" "MonoidsFD1.hs"+    -- mkParserTestMD libdir "ghc98" "ModuleComments1.hs" -    -- mkParserTest libdir "ghc98" "IndentedModule2.hs"-    mkParserTest libdir "ghc98" "ModuleComments.hs"+    -- mkParserTest libdir "ghc910" "LinearLet.hs"+    -- mkParserTest libdir "ghc910" "Generic.hs"+    -- mkParserTest libdir "ghc910" "Expression.hs"+    -- mkParserTest libdir "ghc910" "ConstructorArgs.hs"+    -- mkParserTest libdir "ghc910" "CppComment.hs"+    -- mkParserTest libdir "ghc910" "Class.hs"+    -- mkParserTest libdir "ghc910" "Test138.hs"+    mkParserTest libdir "vect" "DiophantineVect.hs"     -- Needs GHC changes+       ]
tests/Test/Common.hs view
@@ -36,8 +36,12 @@ import Language.Haskell.GHC.ExactPrint.Preprocess  import qualified Control.Monad.IO.Class as GHC-import qualified GHC hiding (parseModule)+import GHC hiding (moduleName)+import GHC.Driver.Errors.Types import qualified GHC.Driver.Session    as GHC+import GHC.Types.Error+import GHC.Utils.Error+import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, vcat)  import qualified GHC.LanguageExtensions as LangExt @@ -105,8 +109,8 @@  changeBalanceComments :: Changer changeBalanceComments _libdir top = do-  let (GHC.L l p) = makeDeltaAst top-  -- let (GHC.L l p) = top+  -- let (GHC.L l p) = makeDeltaAst top+  let (GHC.L l p) = top   let decls0 = GHC.hsmodDecls p       (decls,_,w) = runTransform (balanceCommentsList decls0)   let p2 = p { GHC.hsmodDecls = decls}@@ -143,6 +147,14 @@               cppStatus = if useCpp then Just orig else Nothing           return $ Right Report {..} +showErrorMessages :: Messages GhcMessage -> String+showErrorMessages msgs =+  renderWithContext defaultSDocContext+    $ vcat+    $ pprMsgEnvelopeBagWithLocDefault+    $ getMessages+    $ msgs+ -- showErrorMessages :: Messages GhcMessage -> String -- showErrorMessages msgs = --   renderWithContext defaultSDocContext@@ -151,6 +163,7 @@ --     $ getMessages --     $ msgs + mkDebugOutput :: FilePath -> String -> String               -> GHC.ParsedSource -> String mkDebugOutput filename printed original parsed =@@ -172,7 +185,9 @@              -> [GHC.LEpaComment]              -> IO (String, GHC.ParsedSource) runRoundTrip libdir f !parsedOrig cs = do+  -- putStrLn $ "comments:" ++ showAst cs   let !parsedOrigWithComments = insertCppComments parsedOrig cs+  -- putStrLn $ "parsedOrigWithComments:" ++ showAst parsedOrigWithComments   pmod <- f libdir parsedOrigWithComments   let !printed = exactPrint pmod   return (printed, pmod)
tests/Test/NoAnnotations.hs view
@@ -5,26 +5,19 @@ {-# LANGUAGE TupleSections #-} module Test.NoAnnotations where --- import Control.Monad.State import Data.Algorithm.Diff import Data.Algorithm.DiffOutput--- import Data.Data (Data, toConstr, showConstr, cast)--- import Data.Generics (extQ, ext1Q, ext2Q, gmapQ) import Data.List--- import Data.Ord (comparing)--- import qualified Data.ByteString as B  import Language.Haskell.GHC.ExactPrint--- import Language.Haskell.GHC.ExactPrint.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils -import qualified GHC.Utils.Outputable   as GHC import qualified Control.Monad.IO.Class as GHC import qualified GHC                    as GHC hiding (parseModule)--- import qualified GHC.Driver.Ppr         as GHC import qualified GHC.Hs.Dump            as GHC+import qualified GHC.Utils.Outputable   as GHC  import System.Directory import System.FilePath
tests/Test/Transform.hs view
@@ -30,7 +30,7 @@ transformTestsTT :: LibDir -> Test transformTestsTT libdir = TestLabel "transformTestsTT" $ TestList   [-   mkTestModChange libdir addLocaLDecl5  "AddLocalDecl5.hs"+    mkTestModChange libdir changeWhereIn3b   "WhereIn3b.hs"   ]  transformTests :: LibDir -> Test@@ -62,6 +62,7 @@   , mkTestModChange libdir changeLocalDecls  "LocalDecls.hs"   , mkTestModChange libdir changeLocalDecls2 "LocalDecls2.hs"   , mkTestModChange libdir changeWhereIn3a   "WhereIn3a.hs"+  , mkTestModChange libdir changeWhereIn3b   "WhereIn3b.hs" --  , mkTestModChange changeCifToCase  "C.hs"          "C"   ] @@ -107,11 +108,11 @@ changeWhereIn3b _libdir (L l p) = do   let decls0 = hsmodDecls p       (decls,_,w) = runTransform (balanceCommentsList decls0)-      (de0:_:de1:d2:_) = decls+      (de0:tdecls@(_:de1:d2:_)) = decls       de0' = setEntryDP de0 (DifferentLine 2 0)       de1' = setEntryDP de1 (DifferentLine 2 0)       d2' = setEntryDP d2 (DifferentLine 2 0)-      decls' = d2':de1':de0':(tail decls)+      decls' = d2':de1':de0':tdecls   debugM $ unlines w   debugM $ "changeWhereIn3b:de1':" ++ showAst de1'   let p2 = p { hsmodDecls = decls'}@@ -122,44 +123,41 @@ -- | Add a local declaration with signature to LocalDecl, where there was no -- prior local decl. So it adds a "where" annotation. changeLocalDecls2 :: Changer-changeLocalDecls2 libdir top = do+changeLocalDecls2 libdir (L l p) = do   Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   Right s@(L ls (SigD _ sig))  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")-  let decl' = setEntryDP (makeDeltaAst (L ld decl)) (DifferentLine 1 0)-  let  sig' = setEntryDP (makeDeltaAst (L ls  sig)) (SameLine 2)-  let (top',_,_w) = runTransform doAddLocal-      doAddLocal = everywhereM (mkM replaceLocalBinds) (makeDeltaAst top)+  let decl' = setEntryDP (L ld decl) (DifferentLine 1 0)+  let  sig' = setEntryDP (L ls  sig) (SameLine 2)+  let (p',_,_w) = runTransform doAddLocal+      doAddLocal = everywhereM (mkM replaceLocalBinds) p       replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)                         -> Transform (LMatch GhcPs (LHsExpr GhcPs))       replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do-        newSpan <- uniqueSrcSpanT-        let anc = (Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 2)))-        let anc2 = (Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 4)))+        let anc = (EpaDelta (DifferentLine 1 3) [])+        let anc2 = (EpaDelta (DifferentLine 1 5) [])         let an = EpAnn anc                         (AnnList (Just anc2) Nothing Nothing                                  [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])] [])                         emptyComments         let decls = [s,d]-        let sortKey = captureOrder decls+        let sortKey = captureOrderBinds decls         let binds = (HsValBinds an (ValBinds sortKey (listToBag $ [decl'])                                     [sig']))         return (L lm (Match ma mln pats (GRHSs emptyComments rhs binds)))       replaceLocalBinds x = return x-  -- return (L l p')-  return top'+  return (L l p')  -- ---------------------------------------------------------------------  -- | Add a local declaration with signature to LocalDecl changeLocalDecls :: Changer-changeLocalDecls libdir top = do+changeLocalDecls libdir (L l p) = do   Right s@(L ls (SigD _ sig))  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")   Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")-  let decl' = setEntryDP (makeDeltaAst (L ld decl)) (DifferentLine 1 0)-  let  sig' = setEntryDP (makeDeltaAst (L ls sig))  (SameLine 0)-  -- let (p',_,_w) = runTransform doAddLocal-  let (top',_,_w) = runTransform doAddLocal-      doAddLocal = everywhereM (mkM replaceLocalBinds) (makeDeltaAst top)+  let decl' = setEntryDP (L ld decl) (DifferentLine 1 0)+  let  sig' = setEntryDP (L ls sig)  (SameLine 0)+  let (p',_,_w) = runTransform doAddLocal+      doAddLocal = everywhereM (mkM replaceLocalBinds) p       replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)                         -> Transform (LMatch GhcPs (LHsExpr GhcPs))       replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds van (ValBinds _ binds sigs))))) = do@@ -169,19 +167,19 @@         let oldBinds     = concatMap decl2Bind oldDecls'             (os:oldSigs) = concatMap decl2Sig  oldDecls'             os' = setEntryDP os (DifferentLine 2 0)-        let sortKey = captureOrder decls-        -- let (EpAnn anc (AnnList (Just (Anchor anc2 _)) a b c dd) cs) = van-        -- let van' = (EpAnn anc (AnnList (Just (Anchor anc2 (MovedAnchor (DifferentLine 1 5)))) a b c dd) cs)-        let (EpAnn anc (AnnList _ a b c dd) cs) = van-        let van' = (EpAnn anc (AnnList (Just (Anchor (anchor anc) (MovedAnchor (DifferentLine 1 4)))) a b c dd) cs)+        let sortKey = captureOrderBinds decls+        let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van+        let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 5) [])) a b c dd) cs)+        -- let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van+        -- let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 5) [])) a b c dd) cs)         let binds' = (HsValBinds van'-                          (ValBinds sortKey-                                    (listToBag $ decl':oldBinds)-                                    (sig':os':oldSigs)))+                          (ValBinds sortKey (listToBag $ decl':oldBinds)+                                          (sig':os':oldSigs)))         return (L lm (Match an mln pats (GRHSs emptyComments rhs binds')))+                   `debug` ("oldDecls=" ++ showAst oldDecls)       replaceLocalBinds x = return x-  -- return (L l p')-  return top'+  debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"+  return (L l p')  -- --------------------------------------------------------------------- @@ -189,11 +187,9 @@ changeAddDecl :: Changer changeAddDecl libdir top = do   Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")-  -- let decl' = setEntryDP decl (DifferentLine 2 0)-  let decl' = setEntryDP (makeDeltaAst decl) (DifferentLine 2 0)+  let decl' = setEntryDP decl (DifferentLine 2 0) -  let (p',_,_) = runTransform doAddDecl-      -- doAddDecl = everywhereM (mkM replaceTopLevelDecls) (makeDeltaAst top)+  let (p',_,_w) = runTransform doAddDecl       doAddDecl = everywhereM (mkM replaceTopLevelDecls) top       replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource       replaceTopLevelDecls m = insertAtStart m decl'@@ -235,9 +231,9 @@ changeLayoutLet5 _libdir parsed = return (rename "x" [((7,5),(7,8)),((9,14),(9,17))] parsed)  -rename :: (ExactPrint a, Data a) => String -> [(Pos, Pos)] -> a -> a+rename :: (Data a) => String -> [(Pos, Pos)] -> a -> a rename newNameStr spans' a-  = everywhere (mkT replaceRdr) (makeDeltaAst a)+  = everywhere (mkT replaceRdr) a   where     newName = mkRdrUnqual (mkVarOcc newNameStr) @@ -253,7 +249,7 @@  changeWhereIn4 :: Changer changeWhereIn4 _libdir parsed-  = return (everywhere (mkT replace) (makeDeltaAst parsed))+  = return (everywhere (mkT replace) parsed)   where     replace :: LocatedN RdrName -> LocatedN RdrName     replace (L ln _n)@@ -264,20 +260,20 @@  changeLetIn1 :: Changer changeLetIn1 _libdir parsed-  = return (everywhere (mkT replace) (makeDeltaAst parsed))+  = return (everywhere (mkT replace) parsed)   where     replace :: HsExpr GhcPs -> HsExpr GhcPs-    replace (HsLet an tkLet localDecls _ expr)+    replace (HsLet (tkLet, _) localDecls expr)       =          let (HsValBinds x (ValBinds xv bagDecls sigs)) = localDecls              [l2,_l1] = map wrapDecl $ bagToList bagDecls              bagDecls' = listToBag $ concatMap decl2Bind [l2]-             (L (SrcSpanAnn _ le) e) = expr-             a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (SameLine 1))) mempty emptyComments) le)+             (L _ e) = expr+             a = EpAnn (EpaDelta (SameLine 1) []) noAnn emptyComments              expr' = L a e-             tkIn' = L (TokenLoc (EpaDelta (DifferentLine 1 0) [])) HsTok-         in (HsLet an tkLet-                (HsValBinds x (ValBinds xv bagDecls' sigs)) tkIn' expr')+             tkIn' = EpTok (EpaDelta (DifferentLine 1 0) [])+         in (HsLet (tkLet, tkIn')+                (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')      replace x = x @@ -319,7 +315,7 @@   Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   let decl' = setEntryDP (L ld decl) (DifferentLine 1 5)       doAddLocal = do-        let lp = makeDeltaAst top+        let lp = top         (de1:d2:d3:_) <- hsDecls lp         (de1'',d2') <- balanceComments de1 d2         (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do@@ -359,12 +355,12 @@   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")   let       doAddLocal = do-         let lp = makeDeltaAst top+         let lp = top          (de1:d2:_) <- hsDecls lp          (de1'',d2') <- balanceComments de1 d2           (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do-           let newDecl' = setEntryDP (makeDeltaAst newDecl) (DifferentLine 1 0)+           let newDecl' = setEntryDP newDecl (DifferentLine 1 0)            return (((d:ds) ++ [newDecl']),Nothing)           replaceDecls (anchorEof lp) [parent',d2']@@ -401,7 +397,7 @@ addLocaLDecl5 _libdir lp = do   let       doAddLocal = do-         decls <- hsDecls (makeDeltaAst lp)+         decls <- hsDecls lp          [s1,de1,d2,d3] <- balanceCommentsList decls           let d3' = setEntryDP d3 (DifferentLine 2 0)@@ -498,8 +494,7 @@ rmDecl4 _libdir lp = do   let       doRmDecl = do-         let lpd = (makeDeltaAst lp)-         [de1] <- hsDecls lpd+         [de1] <- hsDecls lp           (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> do            sd2' <- transferEntryDP' sd1 sd2@@ -507,7 +502,7 @@            let sd1' = setEntryDP sd1 (DifferentLine 2 0)            return ([sd2'],Just sd1') -         replaceDecls (anchorEof lpd) [de1',sd1]+         replaceDecls (anchorEof lp) [de1',sd1]    (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"@@ -521,12 +516,13 @@       doRmDecl = do         let           go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)-          go (HsLet a tkLet lb tkIn expr) = do-            decs <- hsDeclsValBinds lb+          go (HsLet (tkLet, tkIn) lb expr) = do+            let decs = hsDeclsLocalBinds lb+            let hdecs : _ = decs             let dec = last decs-            -- _ <- transferEntryDPT (head decs) dec+            _ <- transferEntryDP hdecs dec             lb' <- replaceDeclsValbinds WithoutWhere lb [dec]-            return (HsLet a tkLet lb' tkIn expr)+            return (HsLet (tkLet, tkIn) lb' expr)           go x = return x          everywhereM (mkM go) lp@@ -541,10 +537,11 @@ rmDecl6 _libdir lp = do   let       doRmDecl = do-         [de1] <- hsDecls (makeDeltaAst lp)+         [de1] <- hsDecls lp           (de1',_) <- modifyValD (getLocA de1) de1 $ \_m subDecs -> do-           let (ss1:_sd1:sd2:sds) = subDecs+           let subDecs' = captureLineSpacing subDecs+           let (ss1:_sd1:sd2:sds) = subDecs'            sd2' <- transferEntryDP' ss1 sd2             return (sd2':sds,Nothing)@@ -554,6 +551,7 @@   (lp',_,_w) <- runTransformT doRmDecl   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp'+ -- ---------------------------------------------------------------------  rmDecl7 :: Changer@@ -576,13 +574,12 @@ rmTypeSig1 :: Changer rmTypeSig1 _libdir lp = do   let doRmDecl = do-         -- tlDecs <- hsDecls (makeDeltaAst lp)          tlDecs <- hsDecls lp          let (s0:de1:d2) = tlDecs              s1 = captureTypeSigSpacing s0              (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1-         n2' <- transferEntryDP n1 n2-         let s1' = (L l (SigD x1 (TypeSig x2 [n2'] typ)))+         L ln n2' <- transferEntryDP n1 n2+         let s1' = (L l (SigD x1 (TypeSig x2 [L (noTrailingN ln) n2'] typ)))          replaceDecls lp (s1':de1:d2)    let (lp',_,_w) = runTransform doRmDecl@@ -611,50 +608,48 @@ addHiding1 :: Changer addHiding1 _libdir (L l p) = do   let doTransform = do-        l0 <- uniqueSrcSpanT-        l1 <- uniqueSrcSpanT-        l2 <- uniqueSrcSpanT         let           [L li imp1,imp2] = hsmodImports p-          n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1"))-          n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2"))-          v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar Nothing (L (noAnnSrcSpanDP0 l1) (IEName noExtField n1)))-          v2 = L (           noAnnSrcSpanDP0 l2) (IEVar Nothing (L (noAnnSrcSpanDP0 l2) (IEName noExtField n2)))-          impHiding = L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan l0) m0)-                                     (AnnList Nothing-                                              (Just (AddEpAnn AnnOpenP  d1))-                                              (Just (AddEpAnn AnnCloseP d0))-                                              [(AddEpAnn AnnHiding d1)]-                                              [])-                                       emptyComments) l0) [v1,v2]+          n1 = L noAnnSrcSpanDP0 (mkVarUnqual (mkFastString "n1"))+          n2 = L noAnnSrcSpanDP0 (mkVarUnqual (mkFastString "n2"))+          v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)) Nothing)+          v2 = L (           noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)) Nothing)+          impHiding = L (EpAnn d0+                               (AnnList Nothing+                                        (Just (AddEpAnn AnnOpenP  d1))+                                        (Just (AddEpAnn AnnCloseP d0))+                                        [(AddEpAnn AnnHiding d1)]+                                        [])+                                 emptyComments) [v1,v2]           imp1' = imp1 { ideclImportList = Just (EverythingBut,impHiding)}-          p' = p { hsmodImports = [L li imp1',imp2]}+          imp2' = setEntryDP imp2 (DifferentLine 2 0)+          p' = p { hsmodImports = [L li imp1',imp2']}         return (L l p')    let (lp',_,_w) = runTransform doTransform   debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"   return lp'+ -- ---------------------------------------------------------------------  addHiding2 :: Changer-addHiding2 _libdir (L l p) = do+addHiding2 _libdir top = do   let doTransform = do-        l1 <- uniqueSrcSpanT-        l2 <- uniqueSrcSpanT+        let (L l p) = top         let           [L li imp1] = hsmodImports p-          Just (_,L lh ns) = ideclImportList imp1-          lh' = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan (locA lh)) m1)-                                     (AnnList Nothing-                                              (Just (AddEpAnn AnnOpenP  d1))-                                              (Just (AddEpAnn AnnCloseP d0))-                                              [(AddEpAnn AnnHiding d0)]-                                              [])-                                       emptyComments) (locA lh))-          n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1"))-          n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2"))-          v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar Nothing (L (noAnnSrcSpanDP0 l1) (IEName noExtField n1)))-          v2 = L (           noAnnSrcSpanDP0 l2) (IEVar Nothing (L (noAnnSrcSpanDP0 l2) (IEName noExtField n2)))+          Just (_,L _lh ns) = ideclImportList imp1+          lh' = (EpAnn d0+                       (AnnList Nothing+                                (Just (AddEpAnn AnnOpenP  d1))+                                (Just (AddEpAnn AnnCloseP d0))+                                [(AddEpAnn AnnHiding d1)]+                                [])+                         emptyComments)+          n1 = L (noAnnSrcSpanDP0) (mkVarUnqual (mkFastString "n1"))+          n2 = L (noAnnSrcSpanDP0) (mkVarUnqual (mkFastString "n2"))+          v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)) Nothing)+          v2 = L (           noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)) Nothing)           L ln n = last ns           n' = L (addComma ln) n           imp1' = imp1 { ideclImportList = Just (EverythingBut, L lh' (init ns ++ [n',v1,v2]))}
+ tests/examples/failing/CppComment.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}+module CppComment where++trace_options =+-- c1+#if 0+    x+#endif+    y
+ tests/examples/failing/CppComment.hs.bad view
@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}+module CppComment where++trace_options =++#if 0+    x+#endif+    y
− tests/examples/ghc710-only/DataDecl.hs 
@@ -1,34 +0,0 @@-{-# Language DatatypeContexts #-}-{-# Language ExistentialQuantification #-}-{-# LAnguage GADTs #-}-{-# LAnguage KindSignatures #-}--data Foo = A-         | B-         | C----         | data_or_newtype capi_ctype tycl_hdr constrs deriving-data {-# Ctype "Foo" "bar" #-} F1 = F1-data {-# Ctype       "baz" #-} Eq a =>  F2 a = F2 a--data (Eq a,Ord a) => F3 a = F3 Int a--data F4 a = forall x y. (Eq x,Eq y) => F4 a x y-          | forall x y. (Eq x,Eq y) => F4b a x y---data G1 a :: * where-  G1A,  G1B :: Int -> G1 a-  G1C :: Double -> G1 a--data G2 a :: * where-  G2A { g2a :: a, g2b :: Int } :: G2 a-  G2C :: Double -> G2 a----data (Eq a,Ord a) => G3 a = G3-  { g3A :: Int-  , g3B :: Bool-  , g3a :: a-  } deriving (Eq,Ord)
− tests/examples/ghc710-only/HashQQ.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}--module Web.Maid.ApacheMimeTypes where---import qualified Data.Text as T-import Air.TH----apache_mime_types :: T.Text-apache_mime_types = [here|--# This file maps Internet media types to unique file extension(s).-# Although created for httpd, this file is used by many software systems-# and has been placed in the public domain for unlimited redisribution.-#-# The table below contains both registered and (common) unregistered types.-# A type that has no unique extension can be ignored -- they are listed-# here to guide configurations toward known types and to make it easier to-# identify "new" types.  File extensions are also commonly used to indicate-# content languages and encodings, so choose them carefully.-#-# Internet media types should be registered as described in RFC 4288.-# The registry is at .-#-# MIME type (lowercased)      Extensions-# ============================================  ==========-# application/1d-interleaved-parityfec-# application/3gpp-ims+xml-# application/activemessage-application/andrew-inset      ez |]---testComplex    = assertBool "" ([$istr|-        ok-#{Foo 4 "Great!" : [Foo 3 "Scott!"]}-        then-|] == ("\n" ++-    "        ok\n" ++-    "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++-    "        then\n"))-
− tests/examples/ghc710-only/QuasiQuote.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module QuasiQuote where--import T7918A--ex1 = [qq|e1|]-ex2 = [qq|e2|]-ex3 = [qq|e3|]-ex4 = [qq|e4|]--tx1 = undefined :: [qq|t1|]-tx2 = undefined :: [qq|t2|]-tx3 = undefined :: [qq|t3|]-tx4 = undefined :: [qq|t4|]--px1 [qq|p1|] = undefined-px2 [qq|p2|] = undefined-px3 [qq|p3|] = undefined-px4 [qq|p4|] = undefined--{-# LANGUAGE QuasiQuotes #-}--testComplex    = assertBool "" ([$istr|-        ok-#{Foo 4 "Great!" : [Foo 3 "Scott!"]}-        then-|] == ("\n" ++-    "        ok\n" ++-    "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++-    "        then\n"))-
− tests/examples/ghc710-only/TypeFamilies.hs 
@@ -1,77 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}---- From https://ocharles.org.uk/blog/posts/2014-12-12-type-families.html--import Control.Concurrent.STM-import Control.Concurrent.MVar-import Data.Foldable (forM_)-import Data.IORef--class IOStore store where-  newIO :: a -> IO (store a)-  getIO :: store a -> IO a-  putIO :: store a -> a -> IO ()--instance IOStore MVar where-  newIO = newMVar-  getIO = readMVar-  putIO mvar a = modifyMVar_ mvar (return . const a)--instance IOStore IORef where-  newIO = newIORef-  getIO = readIORef-  putIO ioref a = modifyIORef ioref (const a)--type Present = String-storePresentsIO :: IOStore store => [Present] -> IO (store [Present])-storePresentsIO xs = do-  store <- newIO []-  forM_ xs $ \x -> do-    old <- getIO store-    putIO store (x : old)-  return store---- Type family version--class Store store where-  type StoreMonad store :: * -> *-  new :: a -> (StoreMonad store) (store a)-  get :: store a -> (StoreMonad store) a-  put :: store a -> a -> (StoreMonad store) ()--instance Store IORef where-  type StoreMonad IORef = IO-  new = newIORef-  get = readIORef-  put ioref a = modifyIORef ioref (const a)--instance Store TVar where-  type StoreMonad TVar = STM-  new = newTVar-  get = readTVar-  put ioref a = modifyTVar ioref (const a)--storePresents :: (Store store, Monad (StoreMonad store))-              => [Present] -> (StoreMonad store) (store [Present])-storePresents xs = do-  store <- new []-  forM_ xs $ \x -> do-    old <- get store-    put store (x : old)-  return store--type family (++) (a :: [k]) (b :: [k]) :: [k] where-    '[]       ++ b = b-    (a ': as) ++ b = a ': (as ++ b)--type family (f :: * -> *) |> (s :: * -> *) :: * -> *--type instance f |> Union s = Union (f :> s)--type family Compare (a :: k) (b :: k') :: Ordering where-  Compare '() '() = EQ--type family (r1 :++: r2); infixr 5 :++:-type instance r :++: Nil = r-type instance r1 :++: r2 :> a = (r1 :++: r2) :> a
− tests/examples/ghc710/AddAndOr3.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE PartialTypeSignatures #-}-module AddAndOr3 where--addAndOr3 :: _ -> _ -> _-addAndOr3 (a, b) (c, d) = (a `plus` d, b || c)-  where plus :: Int -> Int -> Int-        x `plus` y = x + y
− tests/examples/ghc710/AltsSemis.hs 
@@ -1,11 +0,0 @@---foo x =-  case x of-   { ;;; -- leading-     0 -> 'a';  -- case 0-     1 -> 'b'   -- case 1-   ; 2 -> 'c' ; -- case 2-   ; 3 -> 'd'   -- case 3-          ;;;   -- case 4-   }
− tests/examples/ghc710/Ann01.hs 
@@ -1,38 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Ann01 where--{-# ANN module (1 :: Int) #-}-{-# ANN module (1 :: Integer) #-}-{-# ANN module (1 :: Double) #-}-{-# ANN module $([| 1 :: Int |]) #-}-{-# ANN module "Hello" #-}-{-# ANN module (Just (1 :: Int)) #-}-{-# ANN module [1 :: Int, 2, 3] #-}-{-# ANN module ([1..10] :: [Integer]) #-}-{-# ANN module ''Foo #-}-{-# ANN module (-1 :: Int) #-}--{-# ANN type Foo (1 :: Int) #-}-{-# ANN type Foo (1 :: Integer) #-}-{-# ANN type Foo (1 :: Double) #-}-{-# ANN type Foo $([| 1 :: Int |]) #-}-{-# ANN type Foo "Hello" #-}-{-# ANN type Foo (Just (1 :: Int)) #-}-{-# ANN type Foo [1 :: Int, 2, 3] #-}-{-# ANN type Foo ([1..10] :: [Integer]) #-}-{-# ANN type Foo ''Foo #-}-{-# ANN type Foo (-1 :: Int) #-}-data Foo = Bar Int--{-# ANN f (1 :: Int) #-}-{-# ANN f (1 :: Integer) #-}-{-# ANN f (1 :: Double) #-}-{-# ANN f $([| 1 :: Int |]) #-}-{-# ANN f "Hello" #-}-{-# ANN f (Just (1 :: Int)) #-}-{-# ANN f [1 :: Int, 2, 3] #-}-{-# ANN f ([1..10] :: [Integer]) #-}-{-# ANN f 'f #-}-{-# ANN f (-1 :: Int) #-}-f x = x
− tests/examples/ghc710/AnnPackageName.hs 
@@ -1,4 +0,0 @@---import "base" Prelude-import "base" Data.Data
− tests/examples/ghc710/Annotations.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Annotations where--{-# ANN module (1 :: Int) #-}-{-# ANN module (1 :: Integer) #-}-{-# ANN module (1 :: Double) #-}-{-# ANN module $([| 1 :: Int |]) #-}-{-# ANN module "Hello" #-}-{-# ANN module (Just (1 :: Int)) #-}-{-# ANN module [1 :: Int, 2, 3] #-}-{-# ANN module ([1..10] :: [Integer]) #-}-{-# ANN module ''Foo #-}-{-# ANN module (-1 :: Int) #-}--{-# ANN type Foo (1 :: Int) #-}-{-# ANN type Foo (1 :: Integer) #-}-{-# ANN type Foo (1 :: Double) #-}-{-# ANN type Foo $([| 1 :: Int |]) #-}-{-# ANN type Foo "Hello" #-}-{-# ANN type Foo (Just (1 :: Int)) #-}-{-# ANN type Foo [1 :: Int, 2, 3] #-}-{-# ANN type Foo ([1..10] :: [Integer]) #-}-{-# ANN type Foo ''Foo #-}-{-# ANN type Foo (-1 :: Int) #-}-data Foo = Bar Int--{-# ANN f (1 :: Int) #-}-{-# ANN f (1 :: Integer) #-}-{-# ANN f (1 :: Double) #-}-{-# ANN f $([| 1 :: Int |]) #-}-{-# ANN f "Hello" #-}-{-# ANN f (Just (1 :: Int)) #-}-{-# ANN f [1 :: Int, 2, 3] #-}-{-# ANN f ([1..10] :: [Integer]) #-}-{-# ANN f 'f #-}-{-# ANN f (-1 :: Int) #-}-f x = x--{-# ANN foo "HLint: ignore" #-};foo = map f (map g x)
− tests/examples/ghc710/Arrow.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE Arrows #-}-module Arrow where--import Control.Arrow-import qualified Control.Category as Cat--addA :: Arrow a => a b Int -> a b Int -> a b Int-addA f g = proc x -> do-                y <- f -< x-                z <- g -< x-                returnA -< y + z--newtype Circuit a b = Circuit { unCircuit :: a -> (Circuit a b, b) }--instance Cat.Category Circuit where-    id = Circuit $ \a -> (Cat.id, a)-    (.) = dot-      where-        (Circuit cir2) `dot` (Circuit cir1) = Circuit $ \a ->-            let (cir1', b) = cir1 a-                (cir2', c) = cir2 b-            in  (cir2' `dot` cir1', c)--instance Arrow Circuit where-    arr f = Circuit $ \a -> (arr f, f a)-    first (Circuit cir) = Circuit $ \(b, d) ->-        let (cir', c) = cir b-        in  (first cir', (c, d))---- | Accumulator that outputs a value determined by the supplied function.-accum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b-accum acc f = Circuit $ \input ->-    let (output, acc') = input `f` acc-    in  (accum acc' f, output)---- | Accumulator that outputs the accumulator value.-accum' :: b -> (a -> b -> b) -> Circuit a b-accum' acc f = accum acc (\a b -> let b' = a `f` b in (b', b'))--total :: Num a => Circuit a a-total = accum' 0 (+)--mean3 :: Fractional a => Circuit a a-mean3 = proc value -> do-    (t, n) <- (| (&&&) (total -< value) (total -< 1) |)-    returnA -< t / n
− tests/examples/ghc710/Arrows.hs 
@@ -1,87 +0,0 @@-{-# LANGUAGE Arrows #-}--- from https://ocharles.org.uk/blog/guest-posts/2014-12-21-arrows.html--import Control.Monad (guard)-import Control.Monad.Identity (Identity, runIdentity)-import Control.Arrow (returnA, Kleisli(Kleisli), runKleisli)--f :: Int -> (Int, Int)-f = \x ->-  let y  = 2 * x-      z1 = y + 3-      z2 = y - 5-  in (z1, z2)---- ghci> f 10--- (23, 15)--fM :: Int -> Identity (Int, Int)-fM = \x -> do-  y  <- return (2 * x)-  z1 <- return (y + 3)-  z2 <- return (y - 5)-  return (z1, z2)---- ghci> runIdentity (fM 10)--- (23,15)---fA :: Int -> (Int, Int)-fA = proc x -> do-  y  <- (2 *) -< x-  z1 <- (+ 3) -< y-  z2 <- (subtract 5) -< y-  returnA -< (z1, z2)---- ghci> fA 10--- (23,15)--range :: Int -> [Int]-range r = [-r..r]--cM :: Int -> [(Int, Int)]-cM = \r -> do-  x <- range 5-  y <- range 5-  guard (x*x + y*y <= r*r)-  return (x, y)---- ghci> take 10 (cM 5)--- [(-5,0),(-4,-3),(-4,-2),(-4,-1),(-4,0),(-4,1),(-4,2),(-4,3),(-3,-4),(-3,-3)]---type K = Kleisli--k :: (a -> m b) -> Kleisli m a b-k = Kleisli--runK :: Kleisli m a b -> (a -> m b)-runK = runKleisli--cA :: Kleisli [] Int (Int, Int)-cA = proc r -> do-  x <- k range -< 5-  y <- k range -< 5-  k guard -< (x*x + y*y <= r*r)-  returnA -< (x, y)---- ghci> take 10 (runK cA 5)--- [(-5,0),(-4,-3),(-4,-2),(-4,-1),(-4,0),(-4,1),(-4,2),(-4,3),(-3,-4),(-3,-3)]--getLineM :: String -> IO String-getLineM prompt = do-  print prompt-  getLine--printM :: String -> IO ()-printM = print--writeFileM :: (FilePath, String) -> IO ()-writeFileM  (filePath, string) = writeFile filePath string--procedureM :: String -> IO ()-procedureM = \prompt -> do-  input <- getLineM prompt-  if input == "Hello"-    then printM "You said 'Hello'"-    else writeFileM ("/tmp/output", "The user said '" ++ input ++ "'")
− tests/examples/ghc710/Associated.hs 
@@ -1,81 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE GADTs #-}---- From https://www.haskell.org/haskellwiki/GHC/Type_families#An_associated_data_type_example--import qualified Data.IntMap-import Prelude hiding (lookup)-import Data.Char (ord)--class GMapKey k where-  data GMap k :: * -> *-  empty       :: GMap k v-  lookup      :: k -> GMap k v -> Maybe v-  insert      :: k -> v -> GMap k v -> GMap k v---- An Int instance-instance GMapKey Int where-  data GMap Int v        = GMapInt (Data.IntMap.IntMap v)-  empty                  = GMapInt Data.IntMap.empty-  lookup k   (GMapInt m) = Data.IntMap.lookup k m-  insert k v (GMapInt m) = GMapInt (Data.IntMap.insert k v m)---- A Char instance-instance GMapKey Char where-  data GMap Char v        = GMapChar (GMap Int v)-  empty                   = GMapChar empty-  lookup k (GMapChar m)   = lookup (ord k) m-  insert k v (GMapChar m) = GMapChar (insert (ord k) v m)---- A Unit instance-instance GMapKey () where-  data GMap () v           = GMapUnit (Maybe v)-  empty                    = GMapUnit Nothing-  lookup () (GMapUnit v)   = v-  insert () v (GMapUnit _) = GMapUnit $ Just v---- Product and sum instances-instance (GMapKey a, GMapKey b) => GMapKey (a, b) where-  data GMap (a, b) v            = GMapPair (GMap a (GMap b v))-  empty                         = GMapPair empty-  lookup (a, b) (GMapPair gm)   = lookup a gm >>= lookup b-  insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of-                                    Nothing  -> insert a (insert b v empty) gm-                                    Just gm2 -> insert a (insert b v gm2  ) gm--instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where-  data GMap (Either a b) v                = GMapEither (GMap a v) (GMap b v)-  empty                                   = GMapEither empty empty-  lookup (Left  a) (GMapEither gm1  _gm2) = lookup a gm1-  lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2-  insert (Left  a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2-  insert (Right b) v (GMapEither gm1 gm2) = GMapEither gm1 (insert b v gm2)--myGMap :: GMap (Int, Either Char ()) String-myGMap = insert (5, Left 'c') "(5, Left 'c')"    $-         insert (4, Right ()) "(4, Right ())"    $-         insert (5, Right ()) "This is the one!" $-         insert (5, Right ()) "This is the two!" $-         insert (6, Right ()) "(6, Right ())"    $-         insert (5, Left 'a') "(5, Left 'a')"    $-         empty--main = putStrLn $ maybe "Couldn't find key!" id $ lookup (5, Right ()) myGMap---- (Type) Synonym Family--type family Elem c--type instance Elem [e] = e---- type instance Elem BitSet = Char---data family T a-data    instance T Int  = T1 Int | T2 Bool-newtype instance T Char = TC Bool--data family G a b-data instance G [a] b where-   G1 :: c -> G [Int] b-   G2 :: G [a] Bool
− tests/examples/ghc710/AssociatedType.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-class Foldable t where-  type FoldableConstraint t x :: *-  type FoldableConstraint t x = ()-
− tests/examples/ghc710/B.hs 
@@ -1,4 +0,0 @@--foo x = case (odd x) of-            True  -> "Odd"-            False -> "Even"
− tests/examples/ghc710/BCase.hs 
@@ -1,8 +0,0 @@---main =- case 1 > 10 of-   True  -> do putStrLn "hello"-               putStrLn "there"-   False -> do putStrLn "blah"-               putStrLn "blah"
− tests/examples/ghc710/BIf.hs 
@@ -1,8 +0,0 @@---main =- if 1 > 10-   then do putStrLn "hello"-           putStrLn "there"-   else do putStrLn "blah"-           putStrLn "blah"
− tests/examples/ghc710/Backquote.hs 
@@ -1,11 +0,0 @@-import Data.List--foo = do-  let genOut (f,st) = putStrLn (f ++ "\t"++go [e`div`4,e`div`2,3*e`div`4] (scanl1 (+) $ sort st))-  Just 5--f = undefined-go = undefined-e = undefined--
− tests/examples/ghc710/BangPatterns.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- From https://ocharles.org.uk/blog/posts/2014-12-05-bang-patterns.html--import Data.Function (fix)-import Data.List (foldl')--hello3 :: Bool -> String-hello3 !loud = "Hello."--mean :: [Double] -> Double-mean xs = s / fromIntegral l-  where-    (s, l) = foldl' step (0, 0) xs-    step (!s, !l) a = (s + a, l + 1)-
− tests/examples/ghc710/BootImport.hs 
@@ -1,3 +0,0 @@-module BootImport where--data Foo = Foo Int
− tests/examples/ghc710/BootImport.hs-boot 
@@ -1,3 +0,0 @@-module BootImport where--data Foo
− tests/examples/ghc710/BracesSemiDataDecl.hs 
@@ -1,7 +0,0 @@---data Nat (t :: NatKind) where-{-    ZeroNat :: Nat Zero;-    SuccNat :: Nat t -> Nat (Succ t);-};
− tests/examples/ghc710/CExpected.hs 
@@ -1,12 +0,0 @@-module CExpected where--- Test for refactor of if to case--- The comments on the then and else legs should be preserved--foo x = case (odd x) of-          True  -> -- This is an odd result-            bob x 1-          False -> -- This is an even result-            bob x 2--bob x y = x + y-
− tests/examples/ghc710/Case.hs 
@@ -1,5 +0,0 @@--foo x = case x of-          True -> "a"-          False -> "b"-
− tests/examples/ghc710/Cg008.hs 
@@ -1,21 +0,0 @@-{-# LANGUAGE MagicHash, BangPatterns #-}-{-# OPTIONS_GHC -O0 #-}---- Variant of cgrun066; compilation as a module is different.--module Cg008 (hashStr) where--import Foreign.C-import Data.Word-import Foreign.Ptr-import GHC.Exts--import Control.Exception--hashStr  :: Ptr Word8 -> Int -> Int-hashStr (Ptr a#) (I# len#) = loop 0# 0#-   where-    loop h n | isTrue# (n GHC.Exts.==# len#) = I# h-             | otherwise  = loop h2 (n GHC.Exts.+# 1#)-          where !c = ord# (indexCharOffAddr# a# n)-                !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#` 4091#
− tests/examples/ghc710/Commands.hs 
@@ -1,257 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}--commands :: [Command]-commands = [-    command "help" "display a list of all commands, and their current keybindings" $ do-      macroGuesses <- Macro.guessCommands commandNames <$> getMacros-      addTab (Other "Help") (makeHelpWidget commands macroGuesses) AutoClose--  , command "log" "show the error log" $ do-      messages <- gets logMessages-      let widget = ListWidget.moveLast (ListWidget.new $ reverse messages)-      addTab (Other "Log") (AnyWidget . LogWidget $ widget) AutoClose--  , command "map" "display a list of all commands that are currently bound to keys" $ do-      showMappings--  , command "map" "display the command that is currently bound to the key {name}" $ do-      showMapping--  , command "map" [help|-        Bind the command {expansion} to the key {name}.  The same command may-        be bound to different keys.-        |] $ do-      addMapping--  , command "unmap" "remove the binding currently bound to the key {name}" $ do-      \(MacroName m) -> removeMacro m--  , command "mapclear" "" $ do-      clearMacros--  , command "exit" "exit vimus" $ do-      eval "quit"--  , command "quit" "exit vimus" $ do-      liftIO exitSuccess :: Vimus ()--  , command "close" "close the current window (not all windows can be closed)" $ do-      void closeTab--  , command "source" "read the file {path} and interprets all lines found there as if they were entered as commands." $ do-      \(Path p) -> liftIO (expandHome p) >>= either printError source_--  , command "runtime" "" $-      \(Path p) -> liftIO (getDataFileName p) >>= source_--  , command "color" "define the fore- and background color for a thing on the screen." $ do-      \color fg bg -> liftIO (defineColor color fg bg) :: Vimus ()--  , command "repeat" "set the playlist option *repeat*. When *repeat* is set, the playlist will start over when the last song has finished playing." $ do-      MPD.repeat  True :: Vimus ()--  , command "norepeat" "Unset the playlist option *repeat*." $ do-      MPD.repeat  False :: Vimus ()--  , command "consume" "set the playlist option *consume*. When *consume* is set, songs that have finished playing are automatically removed from the playlist." $ do-      MPD.consume True :: Vimus ()--  , command "noconsume" "Unset the playlist option *consume*." $ do-      MPD.consume False :: Vimus ()--  , command "random" "set the playlist option *random*. When *random* is set, songs in the playlist are played in random order." $ do-      MPD.random  True :: Vimus ()--  , command "norandom" "Unset the playlist option *random*." $ do-      MPD.random  False :: Vimus ()--  , command "single" "Set the playlist option *single*. When *single* is set, playback does not advance automatically to the next item in the playlist. Combine with *repeat* to repeatedly play the same song." $ do-      MPD.single  True :: Vimus ()--  , command "nosingle" "Unset the playlist option *single*." $ do-      MPD.single  False :: Vimus ()--  , command "autotitle" "Set the *autotitle* option.  When *autotitle* is set, the console window title is automatically set to the currently playing song." $ do-      setAutoTitle True--  , command "noautotitle" "Unset the *autotitle* option." $ do-      setAutoTitle False--  , command "volume" "[+-] set volume to  or adjust by [+-] num" $ do-      volume :: Volume -> Vimus ()-- , command "toggle-repeat" "Toggle the *repeat* option." $ do-      MPD.status >>= MPD.repeat  . not . MPD.stRepeat :: Vimus ()--  , command "toggle-consume" "Toggle the *consume* option." $ do-      MPD.status >>= MPD.consume . not . MPD.stConsume :: Vimus ()--  , command "toggle-random" "Toggle the *random* option." $ do-      MPD.status >>= MPD.random  . not . MPD.stRandom :: Vimus ()--  , command "toggle-single" "Toggle the *single* option." $ do-      MPD.status >>= MPD.single  . not . MPD.stSingle :: Vimus ()--  , command "set-library-path" "While MPD knows where your songs are stored, vimus doesn't. If you want to use the *%* feature of the command :! you need to tell vimus where your songs are stored." $ do-      \(Path p) -> setLibraryPath p--  , command "next" "stop playing the current song, and starts the next one" $ do-      MPD.next :: Vimus ()--  , command "previous" "stop playing the current song, and starts the previous one" $ do-      MPD.previous :: Vimus ()--  , command "toggle" "toggle between play and pause" $ do-      MPDE.toggle :: Vimus ()--  , command "stop" "stop playback" $ do-      MPD.stop :: Vimus ()--  , command "update" "tell MPD to update the music database. You must update your database when you add or delete files in your music directory, or when you edit the metadata of a song.  MPD will only rescan a file already in the database if its modification time has changed." $ do-      void (MPD.update Nothing) :: Vimus ()--  , command "rescan" "" $ do-      void (MPD.rescan Nothing) :: Vimus ()--  , command "clear" "delete all songs from the playlist" $ do-      MPD.clear :: Vimus ()--  , command "search-next" "jump to the next occurrence of the search string in the current window"-      searchNext--  , command "search-prev" "jump to the previous occurrence of the search string in the current window"-      searchPrev---  , command "window-library" "open the *Library* window" $-      selectTab Library--  , command "window-playlist" "open the *Playlist* window" $-      selectTab Playlist--  , command "window-search" "open the *SearchResult* window" $-      selectTab SearchResult--  , command "window-browser" "open the *Browser* window" $-      selectTab Browser--  , command "window-next" "open the window to the right of the current one"-      nextTab--  , command "window-prev" "open the window to the left of the current one"-      previousTab--  , command "!" "execute {cmd} on the system shell. See chapter \"Using an external tag editor\" for an example."-      runShellCommand--  , command "seek" "jump to the given position in the current song"-      seek--  , command "visual" "start visual selection" $-      sendEventCurrent EvVisual--  , command "novisual" "cancel visual selection" $-      sendEventCurrent EvNoVisual--  -- Remove current song from playlist-  , command "remove" "remove the song under the cursor from the playlist" $-      sendEventCurrent EvRemove--  , command "paste" "add the last deleted song after the selected song in the playlist" $-      sendEventCurrent EvPaste--  , command "paste-prev" "" $-      sendEventCurrent EvPastePrevious--  , command "copy" "" $-      sendEventCurrent EvCopy--  , command "shuffle" "shuffle the current playlist" $ do-      MPD.shuffle Nothing :: Vimus ()--  , command "add" "append selected songs to the end of the playlist" $ do-      sendEventCurrent EvAdd--  -- insert a song right after the current song-  , command "insert" [help|-      inserts a song to the playlist. The song is inserted after the currently-      playing song.-      |] $ do-      st <- MPD.status-      case MPD.stSongPos st of-        Just n -> do-          -- there is a current song, insert after-          sendEventCurrent (EvInsert (n + 1))-        _ -> do-          -- there is no current song, just add-          sendEventCurrent EvAdd--  -- Playlist: play selected song-  -- Library:  add song to playlist and play it-  -- Browse:   either add song to playlist and play it, or :move-in-  , command "default-action" [help|-      depending on the item under the cursor, somthing different happens:--      - *Playlist* start playing the song under the cursor--      - *Library* append the song under the cursor to the playlist and start playing it--      - *Browser* on a song: append the song to the playlist and play it. On a directory: go down to that directory.-      |] $ do-      sendEventCurrent EvDefaultAction--  , command "add-album" "add all songs of the album of the selected song to the playlist" $ do-      songs <- fromCurrent MPD.Album [MPD.Disc, MPD.Track]-      maybe (printError "Song has no album metadata!") (MPDE.addMany "" . map MPD.sgFilePath) songs--  , command "add-artist" "add all songs of the artist of the selected song to the playlist" $ do-      songs <- fromCurrent MPD.Artist [MPD.Date, MPD.Album, MPD.Disc, MPD.Track]-      maybe (printError "Song has no artist metadata!") (MPDE.addMany "" . map MPD.sgFilePath) songs--  -- movement-  , command "move-up" "move the cursor one line up" $-      sendEventCurrent EvMoveUp--  , command "move-down" "move the cursor one line down" $-      sendEventCurrent EvMoveDown--  , command "move-album-prev" "move the cursor up to the first song of an album" $-      sendEventCurrent EvMoveAlbumPrev--  , command "move-album-next" "move the cursor down to the first song of an album" $-      sendEventCurrent EvMoveAlbumNext--  , command "move-in" "go down one level the directory hierarchy in the *Browser* window" $-      sendEventCurrent EvMoveIn--  , command "move-out" "go up one level in the directory hierarchy in the *Browser* window" $-      sendEventCurrent EvMoveOut--  , command "move-first" "go to the first line in the current window" $-      sendEventCurrent EvMoveFirst--  , command "move-last" "go to the last line in the current window" $-      sendEventCurrent EvMoveLast--  , command "scroll-up" "scroll the contents of the current window up one line" $-      sendEventCurrent (EvScroll (-1))--  , command "scroll-down" "scroll the contents of the current window down one line" $-      sendEventCurrent (EvScroll 1)--  , command "scroll-page-up" "scroll the contents of the current window up one page" $-      pageScroll >>= sendEventCurrent . EvScroll . negate--  , command "scroll-half-page-up" "scroll the contents of the current window up one half page" $-      pageScroll >>= sendEventCurrent . EvScroll . negate . (`div` 2)--  , command "scroll-page-down" "scroll the contents of the current window down one page" $-      pageScroll >>= sendEventCurrent . EvScroll--  , command "scroll-half-page-down" "scroll the contents of the current window down one half page" $-      pageScroll >>= sendEventCurrent . EvScroll . (`div` 2)--  , command "song-format" "set song rendering format" $-      sendEvent . EvChangeSongFormat-  ]-
− tests/examples/ghc710/Control.hs 
@@ -1,210 +0,0 @@-{-# LANGUAGE Unsafe #-}-{-# LANGUAGE CPP-           , NoImplicitPrelude-           , ScopedTypeVariables-           , BangPatterns-  #-}--module GHC.Event.Control-    (-    -- * Managing the IO manager-      Signal-    , ControlMessage(..)-    , Control-    , newControl-    , closeControl-    -- ** Control message reception-    , readControlMessage-    -- *** File descriptors-    , controlReadFd-    , controlWriteFd-    , wakeupReadFd-    -- ** Control message sending-    , sendWakeup-    , sendDie-    -- * Utilities-    , setNonBlockingFD-    ) where--#include "EventConfig.h"--import Foreign.ForeignPtr (ForeignPtr)-import GHC.Base-import GHC.Conc.Signal (Signal)-import GHC.Real (fromIntegral)-import GHC.Show (Show)-import GHC.Word (Word8)-import Foreign.C.Error (throwErrnoIfMinus1_)-import Foreign.C.Types (CInt(..), CSize(..))-import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)-import Foreign.Marshal (alloca, allocaBytes)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Ptr (castPtr)-import Foreign.Storable (peek, peekElemOff, poke)-import System.Posix.Internals (c_close, c_pipe, c_read, c_write,-                               setCloseOnExec, setNonBlockingFD)-import System.Posix.Types (Fd)--#if defined(HAVE_EVENTFD)-import Foreign.C.Error (throwErrnoIfMinus1)-import Foreign.C.Types (CULLong(..))-#else-import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno)-#endif--data ControlMessage = CMsgWakeup-                    | CMsgDie !Foo-                    | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)-                                 {-# UNPACK #-} !Signal-    deriving (Eq, Show)---- | The structure used to tell the IO manager thread what to do.-data Control = W {-      controlReadFd  :: {-# UNPACK #-} !Fd-    , controlWriteFd :: {-# UNPACK #-} !Fd-#if defined(HAVE_EVENTFD)-    , controlEventFd :: {-# UNPACK #-} !Fd-#else-    , wakeupReadFd   :: {-# UNPACK #-} !Fd-    , wakeupWriteFd  :: {-# UNPACK #-} !Fd-#endif-    , didRegisterWakeupFd :: !Bool-    } deriving (Show)--#if defined(HAVE_EVENTFD)-wakeupReadFd :: Control -> Fd-wakeupReadFd = controlEventFd-{-# INLINE wakeupReadFd #-}-#endif---- | Create the structure (usually a pipe) used for waking up the IO--- manager thread from another thread.-newControl :: Bool -> IO Control-newControl shouldRegister = allocaArray 2 $ \fds -> do-  let createPipe = do-        throwErrnoIfMinus1_ "pipe" $ c_pipe fds-        rd <- peekElemOff fds 0-        wr <- peekElemOff fds 1-        -- The write end must be non-blocking, since we may need to-        -- poke the event manager from a signal handler.-        setNonBlockingFD wr True-        setCloseOnExec rd-        setCloseOnExec wr-        return (rd, wr)-  (ctrl_rd, ctrl_wr) <- createPipe-#if defined(HAVE_EVENTFD)-  ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0-  setNonBlockingFD ev True-  setCloseOnExec ev-  when shouldRegister $ c_setIOManagerWakeupFd ev-#else-  (wake_rd, wake_wr) <- createPipe-  when shouldRegister $ c_setIOManagerWakeupFd wake_wr-#endif-  return W { controlReadFd  = fromIntegral ctrl_rd-           , controlWriteFd = fromIntegral ctrl_wr-#if defined(HAVE_EVENTFD)-           , controlEventFd = fromIntegral ev-#else-           , wakeupReadFd   = fromIntegral wake_rd-           , wakeupWriteFd  = fromIntegral wake_wr-#endif-           , didRegisterWakeupFd = shouldRegister-           }---- | Close the control structure used by the IO manager thread.--- N.B. If this Control is the Control whose wakeup file was registered with--- the RTS, then *BEFORE* the wakeup file is closed, we must call--- c_setIOManagerWakeupFd (-1), so that the RTS does not try to use the wakeup--- file after it has been closed.-closeControl :: Control -> IO ()-closeControl w = do-  _ <- c_close . fromIntegral . controlReadFd $ w-  _ <- c_close . fromIntegral . controlWriteFd $ w-  when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1)-#if defined(HAVE_EVENTFD)-  _ <- c_close . fromIntegral . controlEventFd $ w-#else-  _ <- c_close . fromIntegral . wakeupReadFd $ w-  _ <- c_close . fromIntegral . wakeupWriteFd $ w-#endif-  return ()--io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8-io_MANAGER_WAKEUP = 0xff-io_MANAGER_DIE    = 0xfe--foreign import ccall "__hscore_sizeof_siginfo_t"-    sizeof_siginfo_t :: CSize--readControlMessage :: Control -> Fd -> IO ControlMessage-readControlMessage ctrl fd-    | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \p -> do-                    throwErrnoIfMinus1_ "readWakeupMessage" $-                      c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize)-                    return CMsgWakeup-    | otherwise =-        alloca $ \p -> do-            throwErrnoIfMinus1_ "readControlMessage" $-                c_read (fromIntegral fd) p 1-            s <- peek p-            case s of-                -- Wakeup messages shouldn't be sent on the control-                -- file descriptor but we handle them anyway.-                _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup-                _ | s == io_MANAGER_DIE    -> return CMsgDie-                _ -> do  -- Signal-                    fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t)-                    withForeignPtr fp $ \p_siginfo -> do-                        r <- c_read (fromIntegral fd) (castPtr p_siginfo)-                             sizeof_siginfo_t-                        when (r /= fromIntegral sizeof_siginfo_t) $-                            error "failed to read siginfo_t"-                        let !s' = fromIntegral s-                        return $ CMsgSignal fp s'--  where wakeupBufferSize =-#if defined(HAVE_EVENTFD)-            8-#else-            4096-#endif--sendWakeup :: Control -> IO ()-#if defined(HAVE_EVENTFD)-sendWakeup c =-  throwErrnoIfMinus1_ "sendWakeup" $-  c_eventfd_write (fromIntegral (controlEventFd c)) 1-#else-sendWakeup c = do-  n <- sendMessage (wakeupWriteFd c) CMsgWakeup-  case n of-    _ | n /= -1   -> return ()-      | otherwise -> do-                   errno <- getErrno-                   when (errno /= eAGAIN && errno /= eWOULDBLOCK) $-                     throwErrno "sendWakeup"-#endif--sendDie :: Control -> IO ()-sendDie c = throwErrnoIfMinus1_ "sendDie" $-            sendMessage (controlWriteFd c) CMsgDie--sendMessage :: Fd -> ControlMessage -> IO Int-sendMessage fd msg = alloca $ \p -> do-  case msg of-    CMsgWakeup        -> poke p io_MANAGER_WAKEUP-    CMsgDie           -> poke p io_MANAGER_DIE-    CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS"-  fromIntegral `fmap` c_write (fromIntegral fd) p 1--#if defined(HAVE_EVENTFD)-foreign import ccall unsafe "sys/eventfd.h eventfd"-   c_eventfd :: CInt -> CInt -> IO CInt--foreign import ccall unsafe "sys/eventfd.h eventfd_write"-   c_eventfd_write :: CInt -> CULLong -> IO CInt-#endif--foreign import ccall unsafe "setIOManagerWakeupFd"-   c_setIOManagerWakeupFd :: CInt -> IO ()
− tests/examples/ghc710/CoreIr.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-module Llvm.Data.CoreIr-       ( module Llvm.Data.CoreIr-       , module Llvm.Data.Shared-       , module Llvm.Data.IrType-       , module Data.Word-       , Label-       ) where-import Llvm.Data.Shared-import Llvm.Data.IrType-import Compiler.Hoopl (Label)-import Data.Int-import Data.Word (Word8, Word16, Word32, Word64)-import Data.DoubleWord--data Conversion s v where {-  AddrSpaceCast :: T (Type s P) v -> Type s P -> Conversion s v;-  } deriving (Eq, Ord, Show)-
− tests/examples/ghc710/CorePragma.hs 
@@ -1,6 +0,0 @@-{-# INLINE strictStream #-}-strictStream (Bitstream l v)-    = {-# CORE "Strict Bitstream stream" #-}-      S.concatMap stream (GV.stream v)-      `S.sized`-      Exact l
− tests/examples/ghc710/Cpp.hs 
@@ -1,17 +0,0 @@-{-# Language CPP #-}--#if __GLASGOW_HASKELL__ > 704-foo :: Int-#else-foo :: Integer-#endif-foo = 3--bar :: (-#if __GLASGOW_HASKELL__ > 704-    Int)-#else-    Integer)-#endif-bar = 4-
− tests/examples/ghc710/DataDecl.hs 
@@ -1,34 +0,0 @@-{-# Language DatatypeContexts #-}-{-# Language ExistentialQuantification #-}-{-# LAnguage GADTs #-}-{-# LAnguage KindSignatures #-}--data Foo = A-         | B-         | C----         | data_or_newtype capi_ctype tycl_hdr constrs deriving-data {-# Ctype "Foo" "bar" #-} F1 = F1-data {-# Ctype       "baz" #-} Eq a =>  F2 a = F2 a--data (Eq a,Ord a) => F3 a = F3 Int a--data F4 a = forall x y. (Eq x,Eq y) => F4 a x y-          | forall x y. (Eq x,Eq y) => F4b a x y---data G1 a :: * where-  G1A,  G1B :: Int -> G1 a-  G1C :: Double -> G1 a--data G2 a :: * where-  G2A :: { g2a :: a, g2b :: Int } -> G2 a-  G2C :: Double -> G2 a----data (Eq a,Ord a) => G3 a = G3-  { g3A :: Int-  , g3B :: Bool-  , g3a :: a-  } deriving (Eq,Ord)
− tests/examples/ghc710/DataFamilies.hs 
@@ -1,50 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- Based on https://www.haskell.org/haskellwiki/GHC/Type_families#Detailed_definition_of_data_families--module DataFamilies-  (-    GMap-  , GMapKey(type GMapK)-  ) where---- Type 1, Top level--data family GMap k :: * -> *--data family Array e--data family ArrayK :: * -> *----- Type 2, associated types--class GMapKey k where-  data GMapK k :: * -> *--class C a b c where { data T1 c a :: * }  -- OK--- class C a b c where { data T a a :: * }  -- Bad: repeated variable--- class D a where { data T a x :: * }      -- Bad: x is not a class variable-class D a where { data T2 a :: * -> * }   -- OK---- Instances--data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v)--data family T3 a-data instance T3 Int  = A-data instance T3 Char = B-nonsense :: T3 a -> Int--- nonsense A = 1             -- WRONG: These two equations together...--- nonsense B = 2             -- ...will produce a type error.-nonsense = undefined---instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where-  data GMapK (Either a b) v = GMapEitherK (GMap a v) (GMap b v)---- data GMap () v = GMapUnit (Maybe v)---               deriving Show--
− tests/examples/ghc710/Dead1.hs 
@@ -1,42 +0,0 @@-{-# OPTIONS  -O -ddump-stranal #-}--module Dead1(foo) where--foo :: Int -> Int-foo n = baz (n+1) (bar1 n)--{-# NOINLINE bar1 #-}-bar1 n = 1 + bar n--bar :: Int -> Int-{-# NOINLINE bar #-}-{-# RULES-"bar/foo" forall n. bar (foo n) = n-   #-}-bar n = n-1--baz :: Int -> Int -> Int-{-# INLINE [0] baz #-}-baz m n = m---{- Ronam writes (Feb08)--    Note that bar becomes dead as soon as baz gets inlined. But strangely,-    the simplifier only deletes it after full laziness and CSE. That is, it-    is not deleted in the phase in which baz gets inlined. In fact, it is-    still there after w/w and the subsequent simplifier run. It gets deleted-    immediately if I comment out the rule.--    I stumbled over this when I removed one simplifier run after SpecConstr-    (at the moment, it runs twice at the end but I don't think that should-    be necessary). With this change, the original version of a specialised-    loop (the one with the rules) is not longer deleted even if it isn't-    used any more. I'll reenable the second simplifier run for now but-    should this really be necessary?--No, it should not be necessary.  A refactoring in OccurAnal makes-this work right. Look at the simplifier output just before strictness-analysis; there should be a binding for 'foo', but for nothing else.---}
− tests/examples/ghc710/Default.hs 
@@ -1,8 +0,0 @@-default (Integer, Double) -- "default default"--mag :: Float -> Float -> Float-mag x y = sqrt( x^2 + y^2 )--main = do--print $ mag 1 1
− tests/examples/ghc710/DefaultTypeInstance.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies #-}---class Foldable t where-  type FoldableConstraint t x :: Constraint-  type FoldableConstraint t x = ()
− tests/examples/ghc710/Deriving.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE DeriveDataTypeable #-}--import Data.Data--data Foo = FooA | FooB--deriving instance Show Foo--deriving instance {-# Overlappable #-} Eq Foo-deriving instance {-# Overlapping  #-} Ord Foo-deriving instance {-# Overlaps     #-} Typeable Foo-deriving instance {-# Incoherent   #-} Data Foo-
− tests/examples/ghc710/DerivingOC.hs 
@@ -1,36 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- from https://ocharles.org.uk/blog/guest-posts/2014-12-15-deriving.html--import Data.Data-import Control.Monad.IO.Class-import Control.Monad.Reader-import Control.Monad.State--data MiniIoF a = Terminate-               | PrintLine String a-               | ReadLine (String -> a)-               deriving (Functor)----- data List a = Nil | Cons a (List a)---               deriving (Eq, Show, Functor, Foldable, Traversable)----data List a = Nil | Cons a (List a)-              deriving ( Eq, Show-                       , Functor, Foldable, Traversable-                       , Typeable, Data)--data Config = C String String-data AppState = S Int Bool--newtype App a = App { unApp :: ReaderT Config (StateT AppState IO) a }-                deriving (Monad, MonadReader Config,-                          MonadState AppState, MonadIO,-                          Applicative,Functor)
− tests/examples/ghc710/DoParens.hs 
@@ -1,4 +0,0 @@--foo = do-  (-) <- Just 5-  return ()
− tests/examples/ghc710/DoPatBind.hs 
@@ -1,4 +0,0 @@-module Main where--bar = do-  foo :: String <- baz
− tests/examples/ghc710/DocDecls.hs 
@@ -1,7 +0,0 @@-module DocDecls where---- | A document before-data Foo = A Int | B Char-         deriving (Show)--
− tests/examples/ghc710/DoubleForall.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---extremumNewton :: (Eq a, Fractional a) =>-                  (forall tag. forall tag1.-                          Tower tag1 (Tower tag a)-                              -> Tower tag1 (Tower tag a))-                      -> a -> [a]-extremumNewton f x0 = zeroNewton (diffUU f) x0
− tests/examples/ghc710/DroppedComma.hs 
@@ -1,5 +0,0 @@---foo =-  let (xs, ys) = ([1,2..3], [4,5..6]) in-  bar
− tests/examples/ghc710/DroppedDoSpace.hs 
@@ -1,26 +0,0 @@-import FooBarBaz -- non-existent import, check that we can still parse--save :: C -> IO ()-save state = saveFileDialog "Save file " (maybe Nothing (Just . (++) "*.") (filesuffix state)) $-             do \fileName ->-                    case onSaveCB state of-                      Nothing ->-                          return ()-                      Just callback ->-                          do-                            c <- callback-                            case c of-                              Nothing ->-                                   return ()-                              Just c' ->-                                  let realfn = maybe-                                                fileName-                                                (extendFileName fileName)-                                                (filesuffix state)-                                  in do-                                    L.writeFile realfn c'-                                    postGUIAsync $ labelSetText (View.statusL $ gui state) $ realfn ++ " Saved."-    where-      extendFileName fileName suffix = if isSuffixOf suffix fileName-                                         then fileName-                                         else fileName ++ "." ++ suffix
− tests/examples/ghc710/DroppedDoSpace2.hs 
@@ -1,6 +0,0 @@---save state = do \fileName ->-                  4--
− tests/examples/ghc710/EmptyMostly.hs 
@@ -1,14 +0,0 @@-module EmptyMostly where-   { ;;;-     ;;x=let{;;;;;y=2;;z=3;;;;}in y;-   -- ;;;;-    class Foo a where {;;;;;;-  (--<>--) :: a -> a -> Int  ;-  infixl 5 --<>-- ;-  (--<>--) _ _ = 2 ; -- empty decl at the end.-};--- ;;;;;;;;;;;;--- foo = a where {;;;;;;;;;;;;;;;;;;;;;;;a=1;;;;;;;;}--- ;;-   }--- really trailing
− tests/examples/ghc710/EmptyMostly2.hs 
@@ -1,8 +0,0 @@-module EmptyMostly2 where-   {-;;;;;;;;;;;;-;-class Baz a where {;;;;;;;;;- ; baz :: a -> Int;;;-}-   }
− tests/examples/ghc710/EmptyMostlyInst.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module EmptyMostlyInst where-   {-;;;;;;;;;;;;-;-instance Eq (Int,Integer) where {;;;;;;;;;-;;;;;;; a == b = False;;;;;;;;;;;-}-   }
− tests/examples/ghc710/EmptyMostlyNoSemis.hs 
@@ -1,8 +0,0 @@-module EmptyMostlyNoSemis where--x=let{y=2}in y-class Foo a where {-  (--<>--) :: a -> a -> Int;-  infixl 5 --<>--;-  (--<>--) _ _ = 2 ; -- empty decl at the end.- }
− tests/examples/ghc710/Existential.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}---- from https://ocharles.org.uk/blog/guest-posts/2014-12-19-existential-quantification.html--data HashMap k v = HM  -- ... -- actual implementation--class Hashable v where-  h :: v -> Int--data HashMapM hm = HashMapM-  { empty  :: forall k v . hm k v-  , lookup :: Hashable k => k -> hm k v -> Maybe v-  , insert :: Hashable k => k -> v -> hm k v -> hm k v-  , union  :: Hashable k => hm k v -> hm k v -> hm k v-  }---data HashMapE = forall hm . HashMapE (HashMapM hm)---- public-mkHashMapE :: Int -> HashMapE-mkHashMapE = HashMapE . mkHashMapM---- private-mkHashMapM :: Int -> HashMapM HashMap-mkHashMapM salt = HashMapM { {- implementation -} }--instance Hashable String where--type Name = String-data Gift = G String--giraffe :: Gift-giraffe = G "giraffe"--addGift :: HashMapM hm -> hm Name Gift -> hm Name Gift-addGift mod gifts =-  let-    HashMapM{..} = mod-  in-    insert "Ollie" giraffe gifts---- ---------------------------------santa'sSecretSalt = undefined-sendGiftToOllie = undefined-traverse_ = undefined--sendGifts =-  case mkHashMapE santa'sSecretSalt of-    HashMapE (mod@HashMapM{..}) ->-      let-        gifts = addGift mod empty-      in-        traverse_ sendGiftToOllie $ lookup "Ollie" gifts
− tests/examples/ghc710/ExplicitNamespaces.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}--module CLaSH.Prelude.BitIndex where--import GHC.TypeLits                   (KnownNat, type (+), type (-))
− tests/examples/ghc710/Expr.hs 
@@ -1,132 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Expr where--import Data.Generics-import Language.Haskell.TH as TH-import Language.Haskell.TH.Quote---- import Text.ParserCombinators.Parsec--- import Text.ParserCombinators.Parsec.Char--data Expr  =  IntExpr Integer-           |  AntiIntExpr String-           |  BinopExpr BinOp Expr Expr-           |  AntiExpr String-    deriving(Typeable, Data,Show)--data BinOp  =  AddOp-            |  SubOp-            |  MulOp-            |  DivOp-    deriving(Typeable, Data,Show)--eval :: Expr -> Integer-eval (IntExpr n)        = n-eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y)-  where-    opToFun AddOp = (+)-    opToFun SubOp = (-)-    opToFun MulOp = (*)-    opToFun DivOp = (div)--small   = lower <|> char '_'-large   = upper-idchar  = small <|> large <|> digit <|> char '\''--lexeme p    = do{ x <- p; spaces; return x  }-symbol name = lexeme (string name)-parens p    = undefined -- between (symbol "(") (symbol ")") p--_expr :: CharParser st Expr-_expr   = term   `chainl1` mulop--term :: CharParser st Expr-term    = factor `chainl1` addop--factor :: CharParser st Expr-factor  = parens _expr <|> integer <|> anti--mulop   =  undefined-{--           do{ symbol "*"; return $ BinopExpr MulOp }-        <|> do{ symbol "/"; return $ BinopExpr DivOp }--}-addop   = undefined-{--  do{ symbol "+"; return $ BinopExpr AddOp }-        <|> do{ symbol "-"; return $ BinopExpr SubOp }--}--integer :: CharParser st Expr-integer  = lexeme $ do{ ds <- many1 digit ; return $ IntExpr (read ds) }--anti   = undefined-{--  lexeme $-         do  symbol "$"-             c <- small-             cs <- many idchar-             return $ AntiIntExpr (c : cs)--}--parseExpr :: Monad m => TH.Loc -> String -> m Expr-parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s =-    case runParser p () "" s of-      Left err  -> fail $ "baz"-      Right e   -> return e-  where-    p = do  pos <- getPosition-            setPosition $ setSourceName (setSourceLine (setSourceColumn pos col) line) file-            spaces-            e <- _expr-            eof-            return e--expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat }--parseExprExp :: String -> Q Exp-parseExprExp s =  do  loc <- location-                      expr <- parseExpr loc s-                      dataToExpQ (const Nothing `extQ` antiExprExp) expr--antiExprExp :: Expr -> Maybe (Q Exp)-antiExprExp  (AntiIntExpr v)  = Just $ appE  (conE (mkName "IntExpr"))-                                                (varE (mkName v))-antiExprExp  (AntiExpr v)     = Just $ varE  (mkName v)-antiExprExp  _                = Nothing--parseExprPat :: String -> Q Pat-parseExprPat s =  do  loc <- location-                      expr <- parseExpr loc s-                      dataToPatQ (const Nothing `extQ` antiExprPat) expr--antiExprPat :: Expr -> Maybe (Q Pat)-antiExprPat  (AntiIntExpr v)  = Just $ conP  (mkName "IntExpr")-                                                [varP (mkName v)]-antiExprPat  (AntiExpr v)     = Just $ varP  (mkName v)-antiExprPat  _                = Nothing---- keep parser happy-runParser = undefined-getPosition = undefined-setPosition = undefined-setSourceName = undefined-setSourceLine = undefined-setSourceColumn = undefined-spaces = undefined-eof = undefined-many = undefined-digit = undefined-many1 = undefined-data CharParser a b = F a b-(<|>) = undefined-chainl1 = undefined-string = undefined-char = undefined-lower = undefined-upper = undefined-between = undefined-instance Monad (CharParser a) where-instance Applicative (CharParser a) where-instance Functor (CharParser a) where-
− tests/examples/ghc710/ExprPragmas.hs 
@@ -1,7 +0,0 @@-module ExprPragmas where--a = {-# SCC "name"   #-}  0x5--b = {-# SCC foo   #-} 006--c = {-# GENERATED "foobar" 1 : 2  -  3 :   4 #-} 0.00
− tests/examples/ghc710/ExtraConstraints1.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE PartialTypeSignatures #-}-module ExtraConstraints1 where--arbitCs1 :: _ => a -> String-arbitCs1 x = show (succ x) ++ show (x == x)--arbitCs2 :: (Show a, _) => a -> String-arbitCs2 x = arbitCs1 x--arbitCs3 :: (Show a, Enum a, _) => a -> String-arbitCs3 x = arbitCs1 x--arbitCs4 :: (Eq a, _) => a -> String-arbitCs4 x = arbitCs1 x--arbitCs5 :: (Eq a, Enum a, Show a, _) => a -> String-arbitCs5 x = arbitCs1 x
− tests/examples/ghc710/Field1.hs 
@@ -1,10 +0,0 @@-module Field1 where----Rename field name 'pointx' to 'pointx1'--data Point = Pt {pointx, pointy :: Float} deriving Show--absPoint :: Point -> Float-absPoint p = sqrt (pointx p * pointx p +-                  pointy p * pointy p)-
− tests/examples/ghc710/FooExpected.hs 
@@ -1,8 +0,0 @@---main =- case 1 > 10 of-   True  -> do putStrLn "hello"-               putStrLn "there"-   False -> do putStrLn "blah"-               putStrLn "blah"
− tests/examples/ghc710/ForAll.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE RankNTypes #-}-module ForAll where--import Data.Data--foo ::  (forall a. Data a => a -> a) -> forall a. Data a => a -> a-foo a = a
− tests/examples/ghc710/ForeignDecl.hs 
@@ -1,107 +0,0 @@-{-# LANGUAGE MagicHash, UnliftedFFITypes #-}-{-# LANGUAGE ForeignFunctionInterface #-}---- Based on ghc/testsuite/tests/ffi/should_compile contents-module ForeignDecl where--import Foreign-import GHC.Exts-import Data.Int-import Data.Word---- simple functions--foreign import ccall unsafe "a" a :: IO Int--foreign import ccall unsafe "b" b :: Int -> IO Int--foreign import ccall unsafe "c"-  c :: Int -> Char -> Float -> Double -> IO Float---- simple monadic code--d =     a               >>= \ x ->-        b x             >>= \ y ->-        c y 'f' 1.0 2.0---- We can't import the same function using both stdcall and ccall--- calling conventions in the same file when compiling via C (this is a--- restriction in the C backend caused by the need to emit a prototype--- for stdcall functions).-foreign import stdcall        "p" m_stdcall :: StablePtr a -> IO (StablePtr b)-foreign import ccall   unsafe "q" m_ccall   :: ByteArray# -> IO Int---- We can't redefine the calling conventions of certain functions (those from--- math.h).-foreign import stdcall "my_sin" my_sin :: Double -> IO Double-foreign import stdcall "my_cos" my_cos :: Double -> IO Double--foreign import stdcall "m1" m8  :: IO Int8-foreign import stdcall "m2" m16 :: IO Int16-foreign import stdcall "m3" m32 :: IO Int32-foreign import stdcall "m4" m64 :: IO Int64--foreign import stdcall "dynamic" d8  :: FunPtr (IO Int8) -> IO Int8-foreign import stdcall "dynamic" d16 :: FunPtr (IO Int16) -> IO Int16-foreign import stdcall "dynamic" d32 :: FunPtr (IO Int32) -> IO Int32-foreign import stdcall "dynamic" d64 :: FunPtr (IO Int64) -> IO Int64--foreign import ccall unsafe "safe_qd.h safe_qd_add" c_qd_add :: Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ();--foreign import ccall unsafe "kitchen"-   sink :: Ptr a-        -> ByteArray#-        -> MutableByteArray# RealWorld-        -> Int-        -> Int8-        -> Int16-        -> Int32-        -> Int64-        -> Word8-        -> Word16-        -> Word32-        -> Word64-        -> Float-        -> Double-        -> IO ()---type Sink2 b = Ptr b-            -> ByteArray#-            -> MutableByteArray# RealWorld-            -> Int-            -> Int8-            -> Int16-            -> Int32-            -> Word8-            -> Word16-            -> Word32-            -> Float-            -> Double-            -> IO ()--foreign import ccall unsafe "dynamic"-  sink2 :: Ptr (Sink2 b) -> Sink2 b---- exports-foreign export ccall "plusInt" (+) :: Int -> Int -> Int--listToJSArray :: ToJSRef a => [a] -> IO (JSArray a)-listToJSArray = toJSArray deconstr-        where deconstr (x : xs) = Just (x, xs)-              deconstr [] = Nothing--foreign import javascript unsafe "$r = new Float32Array($1);"-        float32Array :: JSArray Float -> IO Float32Array--foreign import javascript unsafe "$r = new Int32Array($1);"-        int32Array :: JSArray Int32 -> IO Int32Array--foreign import javascript unsafe "$r = new Uint16Array($1);"-        uint16Array :: JSArray Word16 -> IO Uint16Array--foreign import javascript unsafe "$r = new Uint8Array($1);"-        uint8Array :: JSArray Word8 -> IO Uint8Array--foreign import javascript unsafe "$r = $1.getContext(\"webgl\");"-        getCtx :: JSRef a -> IO Ctx
− tests/examples/ghc710/FromUtils.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}--import Data.Data----- -----------------------------------------------------------------------instance AnnotateP RdrName where-  annotateP l n = do-    case rdrName2String n of-      "[]" -> do-        addDeltaAnnotation AnnOpenS -- '['-        addDeltaAnnotation AnnCloseS -- ']'---- -----------------------------------------------------------------------class (Typeable ast) => AnnotateP ast where-  annotateP :: SrcSpan -> ast -> IO ()---type SrcSpan = Int-rdrName2String = undefined-type RdrName = String--data A = AnnOpenS | AnnCloseS--addDeltaAnnotation = undefined
− tests/examples/ghc710/FunDeps.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE FunctionalDependencies #-}---- FunDeps example-class Foo a b c | a b -> c where-  bar :: a -> b -> c-
− tests/examples/ghc710/FunctionalDeps.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}---- from https://ocharles.org.uk/blog/posts/2014-12-14-functional-dependencies.html--import Data.Foldable (forM_)-import Data.IORef--class Store store m | store -> m where- new :: a -> m (store a)- get :: store a -> m a- put :: store a -> a -> m ()--instance Store IORef IO where-  new = newIORef-  get = readIORef-  put ioref a = modifyIORef ioref (const a)-
− tests/examples/ghc710/GADTRecords.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE GADTs #-}-module GADTRecords (H1(..)) where---- | h1-data H1 a b where-  C1 :: H1 a b-  C2 :: Ord a => [a] -> H1 a a-  C3 :: { field :: Int -- ^ hello docs-        } -> H1 Int Int-  C4 :: { field2 :: a -- ^ hello2 docs-        } -> H1 Int a--  FwdDataflowAnalysis :: (Eq f, Monad m) => { analysisTop :: f-                                            , analysisMeet :: f -> f -> f-                                            , analysisTransfer :: f -> Instruction -> m f-                                            , analysisFwdEdgeTransfer :: Maybe (f -> Instruction -> m [(BasicBlock, f)])-                                            } -> DataflowAnalysis m f--data GADT :: * -> * where-      Ctor :: { gadtField :: A } -> GADT A
− tests/examples/ghc710/GADTRecords2.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE GADTs #-}-module GADTRecords2 (H1(..)) where---- | h1-data H1 a b where-  C3 :: (Num a) => { field :: a -- ^ hello docs-                   } -> H1 Int Int
− tests/examples/ghc710/GHCOrig.hs 
@@ -1,211 +0,0 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude, DeriveGeneric #-}--------------------------------------------------------------------------------- |--- Module      :  GHC.Tuple--- Copyright   :  (c) The University of Glasgow 2001--- License     :  BSD-style (see the file libraries/ghc-prim/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  non-portable (GHC extensions)------ The tuple data types-----------------------------------------------------------------------------------module GHC.Tuple where---default () -- Double and Integer aren't available yet---- | The unit datatype @()@ has one non-undefined member, the nullary--- constructor @()@.-data () = ()--data (,) a b = (,) a b-data (,,) a b c = (,,) a b c-data (,,,) a b c d = (,,,) a b c d-data (,,,,) a b c d e = (,,,,) a b c d e-data (,,,,,) a b c d e f = (,,,,,) a b c d e f-data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g-data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h-data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i-data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j-data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k-data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l-data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m-data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n-data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o-data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p-data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q- = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q-data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r- = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r-data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s- = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s-data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t- = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t-data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u- = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u-data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v- = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v-data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w- = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w-data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x- = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x-data (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y- = (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y-data (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z- = (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z-data (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__--{- Manuel says: Including one more declaration gives a segmentation fault.-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___  u___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___  u___ v___- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ v___--}
− tests/examples/ghc710/GenericDeriving.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ViewPatterns #-}-import GHC.Generics---- from https://ocharles.org.uk/blog/posts/2014-12-16-derive-generic.html--data Valid e a = Error e | OK a-  deriving (Generic)--toEither :: Valid e a -> Either e a-toEither (Error e) = Left e-toEither (OK a) = Right a--fromEither :: Either e a -> Valid e a-fromEither (Left e) = Error e-fromEither (Right a) = OK a---- -----------------------------------------------------------------------class GetError rep e | rep -> e where-  getError' :: rep a -> Maybe e--instance GetError f e => GetError (M1 i c f) e where-  getError' (M1 m1) = getError' m1--instance GetError l e => GetError (l :+: r) e where-  getError' (L1 l) = getError' l-  getError' (R1 _) = Nothing--instance GetError (K1 i e) e where-  getError' (K1 e) = Just e--getError :: (Generic (errorLike e a), GetError (Rep (errorLike e a)) e) => errorLike e a -> Maybe e-getError = getError' . from-
− tests/examples/ghc710/Guards.hs 
@@ -1,6 +0,0 @@---f x | x > 0, x /= 10 = 1 / x-    | x == 0 = undefined-  where-    y = 4
− tests/examples/ghc710/Hang.hs 
@@ -1,1 +0,0 @@-(~>) = forall
− tests/examples/ghc710/HangingRecord.hs 
@@ -1,5 +0,0 @@--data Foo = Foo-  { r1 :: Int-  , r2 :: Int-  }
− tests/examples/ghc710/HashQQ.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}--module Web.Maid.ApacheMimeTypes where---import qualified Data.Text as T-import Air.TH----apache_mime_types :: T.Text-apache_mime_types = [here|--# This file maps Internet media types to unique file extension(s).-# Although created for httpd, this file is used by many software systems-# and has been placed in the public domain for unlimited redisribution.-#-# The table below contains both registered and (common) unregistered types.-# A type that has no unique extension can be ignored -- they are listed-# here to guide configurations toward known types and to make it easier to-# identify "new" types.  File extensions are also commonly used to indicate-# content languages and encodings, so choose them carefully.-#-# Internet media types should be registered as described in RFC 4288.-# The registry is at .-#-# MIME type (lowercased)      Extensions-# ============================================  ==========-# application/1d-interleaved-parityfec-# application/3gpp-ims+xml-# application/activemessage-application/andrew-inset      ez |]---testComplex    = assertBool "" ([istr|-        ok-#{Foo 4 "Great!" : [Foo 3 "Scott!"]}-        then-|] == ("\n" ++-    "        ok\n" ++-    "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++-    "        then\n"))-
− tests/examples/ghc710/HsDo.hs 
@@ -1,22 +0,0 @@-module HsDo where--import qualified Data.Map as Map--moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)-  where-    numbered_summaries = zip summaries [1..]--    node_map :: NodeMap SummaryNode-    node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node)-                            | node@(s, _, _) <- nodes ]---graphFromEdgedVertices = undefined-nodes = undefined-lookup_node = undefined-type NodeMap a = Map.Map (Int,Int) (Int,Int,Int)-data SummaryNode = SummaryNode-moduleName = undefined-ms_mod = undefined-ms_hsc_src = undefined-
− tests/examples/ghc710/IfThenElse1.hs 
@@ -1,7 +0,0 @@--- From http://lpaste.net/81623, courtesy of Albert Y. C. Lai-main = do-  cs <- if True-  then getLine-  else return "computer input"-  putStrLn cs-
− tests/examples/ghc710/IfThenElse2.hs 
@@ -1,5 +0,0 @@--- From http://lpaste.net/81623, courtesy of Albert Y. C. Lai-main = if True-then print 12-else print 42-
− tests/examples/ghc710/IfThenElse3.hs 
@@ -1,6 +0,0 @@--- From http://lpaste.net/81623, courtesy of Albert Y. C. Lai-main = do-  print 3-  if True then do-    print 5-    else print 7
− tests/examples/ghc710/ImplicitParams.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE ImplicitParams #-}---- From https://ocharles.org.uk/blog/posts/2014-12-11-implicit-params.html--import Data.Char---type LogFunction = String -> IO ()--type Present = String--queueNewChristmasPresents :: LogFunction -> [Present] -> IO ()-queueNewChristmasPresents logMessage presents = do-  mapM (logMessage . ("Queueing present for delivery: " ++)) presents-  return ()--queueNewChristmasPresents2 :: (?logMessage :: LogFunction) => [Present] -> IO ()-queueNewChristmasPresents2 presents = do-  mapM (?logMessage . ("Queueing present for delivery: " ++)) presents-  return ()---ex1 :: IO ()-ex1 =-  let ?logMessage = \t -> putStrLn ("[XMAS LOG]: " ++ t)-  in queueNewChristmasPresents2 ["Cuddly Lambda", "Gamma Christmas Pudding"]---ex2 :: IO ()-ex2 = do-  -- Specifies its own logger-  ex1--  -- We can locally define a new logging function-  let ?logMessage = \t -> putStrLn (zipWith (\i c -> if even i-                                                     then c-                                                     else toUpper c)-                                           [0..]-                                           t)-  queueNewChristmasPresents2 ["Category Theory Books"]-
− tests/examples/ghc710/ImplicitSemi.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE ImplicitParams #-}--explicit :: ((?above :: q, ?below :: a -> q) => b) -> q -> (a -> q) -> b-explicit x ab be = x where ?above = ab; ?below = be
− tests/examples/ghc710/ImplicitTypeSyn.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnicodeSyntax #-}--type MPI = ?mpi_secret :: MPISecret
− tests/examples/ghc710/Imports.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ExplicitNamespaces #-}-module Imports( f, type (+), pattern Single ) where--import GHC.TypeLits--pattern Single x = [x]--f = undefined
− tests/examples/ghc710/ImportsSemi.hs 
@@ -1,6 +0,0 @@-module ImportsSemi where-{-; ; ; ; ; ;-import Data.List-;;;-}
− tests/examples/ghc710/IndentedDo.hs 
@@ -1,12 +0,0 @@----foo =-  parseTestFile "gitlogo-double.ppm" "a multi-image file" $ do-      \res -> case res of-        Right ([ PPM { ppmHeader = h1 }-               , PPM { ppmHeader = h2 }], rest) -> do h1 `shouldBe` PPMHeader P6 220 92-                                                      h2 `shouldBe` PPMHeader P6 220 92-                                                      rest `shouldBe` Nothing-        Right r                                    -> assertFailure $ "parsed unexpected: " ++ show r-        Left e                                     -> assertFailure $ "did not parse: " ++ e
− tests/examples/ghc710/Infix.hs 
@@ -1,8 +0,0 @@--infix  3 &&&--(&&&) :: (Eq a) => [a] -> [a] -> [a]-(&&& ) [] [] =  []-xs  &&&   [] =  xs-(  &&&) [] ys =  ys-
− tests/examples/ghc710/InfixPatternSynonyms.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}---- | The pattern synonym equivalent of 'destIff'.-pattern l :<=> r <- Comb (Comb (Const "=" (TyBool :-> TyBool :-> TyBool)) l) r---- | Destructor for boolean conjunctions.-destConj :: HOLTerm -> Maybe (HOLTerm, HOLTerm)-destConj = destBinary "/\\"---- | The pattern synonym equivalent of 'destConj'.-pattern l :/\ r <- Binary "/\\" l r---- | Destructor for boolean implications.-destImp :: HOLTerm -> Maybe (HOLTerm, HOLTerm)-destImp = destBinary "==>"---- | The pattern synonym equivalent of 'destImp'.-pattern l :==> r <- Binary "==>" l r
− tests/examples/ghc710/InlineSemi.hs 
@@ -1,1 +0,0 @@-{-# INLINE (|.) #-}; (|.)::Storable a=>Ptr a -> Int -> IO a         ; (|.) a i   = peekElemOff a i
− tests/examples/ghc710/Internals.hs 
@@ -1,427 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses,-             CPP #-}-#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE RoleAnnotations #-}-#endif--{-# OPTIONS_HADDOCK hide #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Array.IO.Internal--- Copyright   :  (c) The University of Glasgow 2001-2012--- License     :  BSD-style (see the file libraries/base/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  non-portable (uses Data.Array.Base)------ Mutable boxed and unboxed arrays in the IO monad.-----------------------------------------------------------------------------------module Data.Array.IO.Internals (-    IOArray(..),         -- instance of: Eq, Typeable-    IOUArray(..),        -- instance of: Eq, Typeable-    castIOUArray,        -- :: IOUArray ix a -> IO (IOUArray ix b)-    unsafeThawIOUArray,-  ) where--import Data.Int-import Data.Word-import Data.Typeable--import Control.Monad.ST         ( RealWorld, stToIO )-import Foreign.Ptr              ( Ptr, FunPtr )-import Foreign.StablePtr        ( StablePtr )--#if __GLASGOW_HASKELL__ < 711-import Data.Ix-#endif-import Data.Array.Base--import GHC.IOArray (IOArray(..))---------------------------------------------------------------------------------- Flat unboxed mutable arrays (IO monad)---- | Mutable, unboxed, strict arrays in the 'IO' monad.  The type--- arguments are as follows:------  * @i@: the index type of the array (should be an instance of 'Ix')------  * @e@: the element type of the array.  Only certain element types---    are supported: see "Data.Array.MArray" for a list of instances.----newtype IOUArray i e = IOUArray (STUArray RealWorld i e)-                       deriving Typeable-#if __GLASGOW_HASKELL__ >= 708--- Both parameters have class-based invariants. See also #9220.-type role IOUArray nominal nominal-#endif--instance Eq (IOUArray i e) where-    IOUArray s1 == IOUArray s2  =  s1 == s2--instance MArray IOUArray Bool IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Char IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Int IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Word IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray (Ptr a) IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray (FunPtr a) IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Float IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Double IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray (StablePtr a) IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Int8 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Int16 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Int32 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Int64 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Word8 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Word16 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Word32 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)--instance MArray IOUArray Word64 IO where-    {-# INLINE getBounds #-}-    getBounds (IOUArray arr) = stToIO $ getBounds arr-    {-# INLINE getNumElements #-}-    getNumElements (IOUArray arr) = stToIO $ getNumElements arr-    {-# INLINE newArray #-}-    newArray lu initialValue = stToIO $ do-        marr <- newArray lu initialValue; return (IOUArray marr)-    {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ lu = stToIO $ do-        marr <- unsafeNewArray_ lu; return (IOUArray marr)-    {-# INLINE newArray_ #-}-    newArray_ = unsafeNewArray_-    {-# INLINE unsafeRead #-}-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)-    {-# INLINE unsafeWrite #-}-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)---- | Casts an 'IOUArray' with one element type into one with a--- different element type.  All the elements of the resulting array--- are undefined (unless you know what you\'re doing...).-castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)-castIOUArray (IOUArray marr) = stToIO $ do-    marr' <- castSTUArray marr-    return (IOUArray marr')--{-# INLINE unsafeThawIOUArray #-}-#if __GLASGOW_HASKELL__ >= 711-unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e)-#else-unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)-#endif-unsafeThawIOUArray arr = stToIO $ do-    marr <- unsafeThawSTUArray arr-    return (IOUArray marr)--{-# RULES-"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray-    #-}--#if __GLASGOW_HASKELL__ >= 711-thawIOUArray :: UArray ix e -> IO (IOUArray ix e)-#else-thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)-#endif-thawIOUArray arr = stToIO $ do-    marr <- thawSTUArray arr-    return (IOUArray marr)--{-# RULES-"thaw/IOUArray" thaw = thawIOUArray-    #-}--{-# INLINE unsafeFreezeIOUArray #-}-#if __GLASGOW_HASKELL__ >= 711-unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e)-#else-unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)-#endif-unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)--{-# RULES-"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray-    #-}--#if __GLASGOW_HASKELL__ >= 711-freezeIOUArray :: IOUArray ix e -> IO (UArray ix e)-#else-freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)-#endif-freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)--{-# RULES-"freeze/IOUArray" freeze = freezeIOUArray-    #-}
− tests/examples/ghc710/Jon.hs 
@@ -1,4 +0,0 @@-{- ___ -}import Data.Char;main=putStr$do{c<-"/1 AA A A;9+ )11929 )1191A 2C9A ";e-{-  |  -}    .(`divMod`8).(+(-32)).ord$c};e(0,0)="\n";e(m,n)=m?"  "++n?"_/"-{-  |  -}n?x=do{[1..n];x}                                    --- obfuscated-{-\_/ on Fairbairn, with apologies to Chris Brown. Above is / Haskell 98 -}
− tests/examples/ghc710/LambdaCase.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE LambdaCase #-}--foo = f >>= \case-        Just h -> loadTestDB (h ++ "/.testdb")-        Nothing -> fmap S.Right initTestDB--{-| Is the alarm set - i.e. will it go off at some point in the future even if `setAlarm` is not called? -}-isAlarmSetSTM :: AlarmClock -> STM Bool-isAlarmSetSTM AlarmClock{..} = readTVar acNewSetting-  >>= \case { AlarmNotSet -> readTVar acIsSet; _ -> return True }
− tests/examples/ghc710/LayoutLet.hs 
@@ -1,7 +0,0 @@--foo x =-  let-    a = 1-    b = 2-  in x + a + b-
− tests/examples/ghc710/LayoutWhere.hs 
@@ -1,6 +0,0 @@--foo x = r-  where-    a = 3-    b = 4-    r = a + a + b
− tests/examples/ghc710/LetExpr.hs 
@@ -1,63 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-{-# Language DeriveFoldable #-}-{-# LANGUAGE Safe #-}-{-# options_ghc -w #-}---- | A simple let expression, to ensure the layout is detected--- With some haddock in the top-{- And a normal-   multiline comment too -}-  module {- brah -}  LetExpr        ( foo -- foo does ..-                                    , bar -- bar does ..-                                    , Baz () -- baz does ..-                                 , Ba   ( ..),Ca(Cc,Cd)   ,-                                     bbb ,  aaa-                                  , module  Data.List-                                    , pattern  Bar-                                    )-    where--import Data.List--- A comment in the middle-import {-# SOURCE #-} BootImport ( Foo(..) )-import {-# SoURCE  #-} safe   qualified  BootImport   as    BI-import qualified Data.Map as {- blah -}  Foo.Map--import Control.Monad  (   )-import Data.Word (Word8)-import Data.Tree hiding  (  drawTree   )--import qualified Data.Maybe as M hiding    ( maybe  , isJust  )----- comment-foo = let x = 1-          y = 2-      in x + y--bar = 3-bbb x- | x == 1 = ()- | otherwise = ()---aaa [ ] _   = 0-aaa x  _unk = 1--aba () = 0--x `ccc` 1 = x + 1-x `ccc` y = x + y--x !@# y = x + y--data Baz = Baz1 | Baz2--data Ba = Ba | Bb--data Ca = Cc | Cd--pattern Foo a <- RealFoo a-pattern Bar a <- RealBar a--data Thing = RealFoo Thing | RealBar Int
− tests/examples/ghc710/LetExpr2.hs 
@@ -1,4 +0,0 @@-l z =-  let-    ll = 34-  in ll + z
− tests/examples/ghc710/LetExprSemi.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-{-# Language DeriveFoldable #-}-{-# LANGUAGE Safe #-}-{-# options_ghc -w #-}---- | A simple let expression, to ensure the layout is detected--- With some haddock in the top-{- And a normal-   multiline comment too -}-  module {- brah -}  LetExprSemi    ( foo -- foo does ..-                                    , bar -- bar does ..-                                    , Baz () -- baz does ..-                                 , Ba   ( ..),Ca(Cc,Cd)   ,-                                     bbb ,  aaa-                                  , module  Data.List-                                    , pattern  Bar-                                    )-    where-{-import Data.List--- A comment in the middle-; import {-# SOURCE #-} BootImport ( Foo(..) ) ;-import {-# SOURCE  #-} safe   qualified  BootImport   as    BI-;;; import qualified Data.Map as {- blah -}  Foo.Map;--import Control.Monad  (   )  ;-import Data.Word (Word8);-import Data.Tree hiding  (  drawTree   ) ;--  ; import qualified Data.Maybe as M hiding    ( maybe  , isJust  )-;---- comment-foo = let x = 1-          y = 2-      in x + y-;-bar = 3;-bbb x- | x == 1 = ()- | otherwise = ()--;-aaa [] _    = 0;-aaa x  _unk = 1-;-x `ccc` 1 = x + 1;-x `ccc` y = x + y-;-x !@# y = x + y-;-data Baz = Baz1 | Baz2-;-data Ba = Ba | Bb-;-data Ca = Cc | Cd-;-pattern Foo a <- RealFoo a ;-pattern Bar a <- RealBar a-;-data Thing = RealFoo Thing | RealBar Int-}--
− tests/examples/ghc710/LetStmt.hs 
@@ -1,9 +0,0 @@--- A simple let statement, to ensure the layout is detected--module Layout.LetStmt where--foo = do-{- ffo -}let x = 1-             y = 2 -- baz-         x+y-
− tests/examples/ghc710/LiftedInfixConstructor.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE DataKinds, TemplateHaskell #-}--applicate :: Bool -> [Stmt] -> ExpQ-applicate rawPatterns stmt = do-    return $ foldl (\g e -> VarE '(<**>) `AppE` e `AppE` g)-                    (VarE 'pure `AppE` f')-                    es--tuple :: Int -> ExpQ-tuple n = do-    ns <- replicateM n (newName "x")-    lamE [foldr (\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns)
− tests/examples/ghc710/LinePragma.hs 
@@ -1,36 +0,0 @@-module UHC.Light.Compiler.Core.SysF.AsTy-( Ty-, ty2TySysfWithEnv, ty2TyC-, ty2TyCforFFI )-where-import UHC.Light.Compiler.Base.Common-import UHC.Light.Compiler.Opts.Base-import UHC.Light.Compiler.Error-import qualified UHC.Light.Compiler.Core as C-import qualified UHC.Light.Compiler.Ty as T-import UHC.Light.Compiler.FinalEnv--{-# LINE 50 "src/ehc/Core/SysF/AsTy.chs" #-}--- | The type, represented by a term CExpr-type Ty             = C.SysfTy          -- base ty---- | Binding the bound-type TyBind         = C.SysfTyBind-type TyBound        = C.SysfTyBound---- | A sequence of parameters (for now just a single type)-type TySeq          = C.SysfTySeq---{-# LINE 67 "src/ehc/Core/SysF/AsTy.chs" #-}-ty2TySysfWithEnv :: ToSysfEnv -> T.Ty -> Ty-ty2TySysfWithEnv _   t =                                                     t---- | Construct a type for use by AbstractCore-ty2TyC :: EHCOpts -> ToSysfEnv -> T.Ty -> C.CTy-ty2TyC o env t = C.mkCTy o t (ty2TySysfWithEnv env t)--{-# LINE 93 "src/ehc/Core/SysF/AsTy.chs" #-}--- | Construct a type for use by AbstractCore, specifically for use by FFI-ty2TyCforFFI :: EHCOpts -> T.Ty -> C.CTy-ty2TyCforFFI o t = C.mkCTy o t                                t
− tests/examples/ghc710/ListComprehensions.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE ParallelListComp,-             TransformListComp,-             RecordWildCards #-}---             MonadComprehensions,---- From https://ocharles.org.uk/blog/guest-posts/2014-12-07-list-comprehensions.html--import GHC.Exts-import qualified Data.Map as M-import Data.Ord (comparing)-import Data.List (sortBy)---- Let’s look at a simple, normal list comprehension to start:--regularListComp :: [Int]-regularListComp = [ x + y * z-                  | x <- [0..10]-                  , y <- [10..20]-                  , z <- [20..30]-                  ]--parallelListComp :: [Int]-parallelListComp = [ x + y * z-                   | x <- [0..10]-                   | y <- [10..20]-                   | z <- [20..30]-                   ]---- fibs :: [Int]--- fibs = 0 : 1 : zipWith (+) fibs (tail fibs)--fibs :: [Int]-fibs = 0 : 1 : [ x + y-               | x <- fibs-               | y <- tail fibs-               ]--fiblikes :: [Int]-fiblikes = 0 : 1 : [ x + y + z-                   | x <- fibs-                   | y <- tail fibs-                   | z <- tail (tail fibs)-                   ]---- TransformListComp-data Character = Character-  { firstName :: String-  , lastName :: String-  , birthYear :: Int-  } deriving (Show, Eq)--friends :: [Character]-friends = [ Character "Phoebe" "Buffay" 1963-          , Character "Chandler" "Bing" 1969-          , Character "Rachel" "Green" 1969-          , Character "Joey" "Tribbiani" 1967-          , Character "Monica" "Geller" 1964-          , Character "Ross" "Geller" 1966-          ]--oldest :: Int -> [Character] -> [String]-oldest k tbl = [ firstName ++ " " ++ lastName-               | Character{..} <- tbl-               , then sortWith by birthYear-               , then take k-               ]--groupByLargest :: Ord b => (a -> b) -> [a] -> [[a]]-groupByLargest f = sortBy (comparing (negate . length)) . groupWith f--bestBirthYears :: [Character] -> [(Int, [String])]-bestBirthYears tbl = [ (the birthYear, firstName)-                     | Character{..} <- tbl-                     , then group by birthYear using groupByLargest-                     ]--uniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs-                                   , let d' = ppDir d-                                   , then group by Down (p,d') using groupWith ]--legendres :: [Poly Rational]-legendres = one : x :-    [ multPoly-        (poly LE [recip (n' + 1)])-        (addPoly (poly LE [0, 2 * n' + 1] `multPoly` p_n)-                 (poly LE           [-n'] `multPoly` p_nm1)-        )-    | n     <- [1..], let n' = fromInteger n-    | p_n   <- tail legendres-    | p_nm1 <- legendres-    ]--fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a]-                    -> [(Bool,(a, W.Stack k))]-fromGroups' defl defls st gs sls =-    [ (isNew,fromMaybe2 (dl, single w) (l, M.lookup w gs))-        | l <- map Just sls ++ repeat Nothing, let isNew = isNothing l-        | dl <- defls ++ repeat defl-        | w <- W.integrate' $ W.filter (`notElem` unfocs) =<< st ]
− tests/examples/ghc710/LocalDecls2Expected.hs 
@@ -1,6 +0,0 @@-module LocalDecls2Expected where--foo a = bar a-  where-    nn :: Int-    nn = 2
− tests/examples/ghc710/MachineTypes.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE Trustworthy #-} -- Safe if eliminate GeneralizedNewtypeInstance-{-# LANGUAGE Arrows #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module-    Control.Arrow.Machine.Types-where--import qualified Control.Category as Cat-import Data.Profunctor (Profunctor, dimap, rmap)-import Control.Arrow-import Control.Monad-import Control.Monad.Trans-import Control.Monad.State-import Control.Monad.Reader-import Control.Monad.Writer hiding ((<>))-import Control.Monad.Identity-import Control.Applicative-import Data.Foldable as Fd-import Data.Traversable as Tv-import Data.Semigroup (Semigroup, (<>))-import Data.Maybe (fromMaybe, isNothing, isJust)-import qualified Control.Monad.Trans.Free as F-import qualified Control.Monad.Trans.Free.Church as F-import Control.Arrow.Machine.ArrowUtil-import GHC.Exts (build)----- | To get multiple outputs by one input, the `Phase` parameter is introduced.------ Once a value `Feed`ed, the machine is `Sweep`ed until it `Suspend`s.-data Phase = Feed | Sweep | Suspend deriving (Eq, Show)--instance-    Monoid Phase-  where-    mempty = Sweep--    mappend Feed _ = Feed-    mappend _ Feed = Feed-    mappend Suspend _ = Suspend-    mappend _ Suspend = Suspend-    mappend Sweep Sweep = Sweep---type ProcType a b c = ProcessA a b c---- | The stream transducer arrow.------ To construct `ProcessA` instances, use `Control.Arrow.Machine.Plan.Plan`,--- `arr`, functions declared in `Control.Arrow.Machine.Utils`,--- or arrow combinations of them.------ See an introduction at "Control.Arrow.Machine" documentation.-data ProcessA a b c = ProcessA {-    feed :: a b (c, ProcessA a b c),-    sweep :: a b (Maybe c, ProcessA a b c),-    suspend :: !(b -> c)-  }----- For internal use-class-    (Applicative f, Monad f) => ProcessHelper f-  where-    step :: ArrowApply a => ProcessA a b c -> a b (f c, ProcessA a b c)-    helperToMaybe :: f a -> Maybe a-    weakly :: a -> f a--    step' :: ArrowApply a => ProcessA a b c -> a (f b) (f c, ProcessA a b c)-    step' pa = proc hx ->-      do-        let mx = helperToMaybe hx-        maybe-            (arr $ const (suspend pa <$> hx, pa))-            (\x -> proc _ -> step pa -< x)-            mx-                -<< ()-
− tests/examples/ghc710/MagicHash.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE MagicHash #-}--module Data.Text.Internal.Builder.Functions-    (-      (<>)-    , i2d-    ) where--import Data.Monoid (mappend)-import Data.Text.Lazy.Builder (Builder)-import GHC.Base---- | Unsafe conversion for decimal digits.-{-# INLINE i2d #-}-i2d :: Int -> Char-i2d (I# i#) = C# (chr# (ord# '0'# +# i#))--main =-  print (F# (expFloat# 3.45#))---- | The normal 'mappend' function with right associativity instead of--- left.-(<>) :: Builder -> Builder -> Builder-(<>) = mappend-{-# INLINE (<>) #-}--infixr 4 <>--
− tests/examples/ghc710/MangledSemiLet.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE-    BangPatterns-  #-}---mtGamma a b =-  let !x_2 = x*x; !x_4 = x_2*x_2-      v3 = v*v*v-      dv = d * v3-  in 5
− tests/examples/ghc710/Minimal.hs 
@@ -1,37 +0,0 @@-class AwsType a where-    toText :: a -> b---    {-# MINIMAL toText #-}--class Minimal a where-  toText :: a -> b-  {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}--class Minimal a where-  toText :: a -> b-  {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-}--class Minimal a where-  toText :: a -> b-  {-# MINIMAL (toSample | toSamples) #-}--class ManyOps a where-    aOp :: a -> a -> Bool-    bOp :: a -> a -> Bool-    cOp :: a -> a -> Bool-    dOp :: a -> a -> Bool-    eOp :: a -> a -> Bool-    fOp :: a -> a -> Bool-    {-# MINIMAL  ( aOp)-               | ( bOp   , cOp)-               | ((dOp  |  eOp) , fOp)-      #-}--class Foo a where-    bar :: a -> a -> Bool-    foo :: a -> a -> Bool-    baq :: a -> a -> Bool-    baz :: a -> a -> Bool-    quux :: a -> a -> Bool-    {-# MINIMAL bar, (foo, baq | foo, quux) #-}
− tests/examples/ghc710/Mixed.hs 
@@ -1,50 +0,0 @@--import Data.List  ()-import Data.List  hiding ()--infixl 1 `f`--- infixr 2 `\\\`-infix  3 :==>-infix  4 `MkFoo`--data Foo = MkFoo Int | Float :==> Double--x `f` y = x--(\\\) :: (Eq a) => [a] -> [a] -> [a]-(\\\) xs ys =  xs--g x = x + if True then 1 else 2-h x = x + 1::Int--{-# SPECIALISe j :: Int -> Int-                  , Integer -> Integer #-}-j n = n + 1--test = let k x y = x+y in 1 `k` 2 `k` 3--data Rec = (:<-:) { a :: Int, b :: Float }--ng1 x y = negate y--instance (Num a, Num b) => Num (a,b)-  where-   {-# Specialise instance Num (Int,Int) #-}-   negate (a,b) = (ng 'c' a, ng1 'c' b)   where  ng x y = negate y----class Foo1 a where--class Foz a--x = 2 where-y = 3--instance Foo1 Int where--ff = ff where g = g where-type T = Int---
− tests/examples/ghc710/ModuleOnly.hs 
@@ -1,1 +0,0 @@-module ModuleOnly where
− tests/examples/ghc710/MonadComprehensions.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE ParallelListComp,-             TransformListComp,-             RecordWildCards #-}-{-# LANGUAGE MonadComprehensions #-}---- From https://ocharles.org.uk/blog/guest-posts/2014-12-07-list-comprehensions.html--import GHC.Exts-import qualified Data.Map as M-import Data.Ord (comparing)-import Data.List (sortBy)----- Monad Comprehensions--sqrts :: M.Map Int Int-sqrts = M.fromList $ [ (x, sx)-                     | x  <- map (^2) [1..100]-                     | sx <- [1..100]-                     ]--sumIntSqrts :: Int -> Int -> Maybe Int-sumIntSqrts a b = [ x + y-                  | x <- M.lookup a sqrts-                  , y <- M.lookup b sqrts-                  ]--greet :: IO String-greet = [ name-        | name <- getLine-        , _ <- putStrLn $ unwords ["Hello, ", name, "!"]-        ]-
− tests/examples/ghc710/Move1.hs 
@@ -1,53 +0,0 @@-module Move1 where--data Located a = L Int a-type Name = String-hsBinds = undefined-divideDecls = undefined-definingDeclsNames = undefined-nub = undefined-definedPNs :: a -> [b]-definedPNs = undefined-logm = undefined-showGhc = undefined-pnsNeedRenaming = undefined-concatMap1 = undefined---- liftToTopLevel' :: ModuleName -- -> (ParseResult,[PosToken]) -> FilePath---                 -> Located Name---                 -> RefactGhc [a]-liftToTopLevel' :: Int -> Located Name -> IO [a]-liftToTopLevel' modName pn@(L _ n) = do-  liftToMod-  return []-    where-          {-step1: divide the module's top level declaration list into three parts:-            'parent' is the top level declaration containing the lifted declaration,-            'before' and `after` are those declarations before and after 'parent'.-            step2: get the declarations to be lifted from parent, bind it to liftedDecls -            step3: remove the lifted declarations from parent and extra arguments may be introduce.-            step4. test whether there are any names need to be renamed.-          -}-       liftToMod :: IO ()-       liftToMod = do-                      -- renamed <- getRefactRenamed-                      let renamed = undefined-                      let declsr = hsBinds renamed-                      let (before,parent,after) = divideDecls declsr pn-                      -- error ("liftToMod:(before,parent,after)=" ++ (showGhc (before,parent,after))) -- ++AZ++-                      {- ++AZ++ : hsBinds does not return class or instance definitions-                      when (isClassDecl $ ghead "liftToMod" parent)-                            $ error "Sorry, the refactorer cannot lift a definition from a class declaration!"-                      when (isInstDecl $ ghead "liftToMod" parent)-                            $ error "Sorry, the refactorer cannot lift a definition from an instance declaration!"-                      -}-                      let liftedDecls = definingDeclsNames [n] parent True True-                          declaredPns = nub $ concatMap1 definedPNs liftedDecls--                      -- TODO: what about declarations between this-                      -- one and the top level that are used in this one?--                      logm $ "liftToMod:(liftedDecls,declaredPns)=" ++ (showGhc (liftedDecls,declaredPns))-                      -- original : pns<-pnsNeedRenaming inscps mod parent liftedDecls declaredPns-                      -- pns <- pnsNeedRenaming renamed parent liftedDecls declaredPns-                      return ()
− tests/examples/ghc710/MultiImplicitParams.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE ImplicitParams #-}--foo = do-  ev <- let ?mousePosition = relative<$>Reactive (Size 1 1) _size<|*>_mousePos-            ?buttonChanges = _button-        in sink-  return baz
− tests/examples/ghc710/MultiLineCommentWithPragmas.hs 
@@ -1,18 +0,0 @@--{---- this is ugly too: can't use Data.Complex because the qd bindings do--- not implement some low-level functions properly, leading to obscure--- crashes inside various Data.Complex functions...-data Complex c = {-# UNPACK #-} !c :+ {-# UNPACK #-} !c deriving (Read, Show, Eq)---- complex number arithmetic, with extra strictness and cost-centres-instance Num c => Num (Complex c) where-  (!(a :+ b)) + (!(c :+ d)) = {-# SCC "C+" #-} ((a + c) :+ (b + d))-  (!(a :+ b)) - (!(c :+ d)) = {-# SCC "C-" #-} ((a - c) :+ (b - d))-  (!(a :+ b)) * (!(c :+ d)) = {-# SCC "C*" #-} ((a * c - b * d) :+ (a * d + b * c))-  negate !(a :+ b) = (-a) :+ (-b)-  abs x = error $ "Complex.abs: " ++ show x-  signum x = error $ "Complex.signum: " ++ show x-  fromInteger !x = fromInteger x :+ 0--}-
− tests/examples/ghc710/MultiParamTypeClasses.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- From https://ocharles.org.uk/blog/posts/2014-12-13-multi-param-type-classes.html--import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader (ReaderT)-import Data.Foldable (forM_)-import Data.IORef--class Store store m where- new :: a -> m (store a)- get :: store a -> m a- put :: store a -> a -> m ()--type Present = String-storePresents :: (Store store m, Monad m) => [Present] -> m (store [Present])-storePresents xs = do-  store <- new []-  forM_ xs $ \x -> do-    old <- get store-    put store (x : old)-  return store--instance Store IORef IO where-  new = newIORef-  get = readIORef-  put ioref a = modifyIORef ioref (const a)---- ex ps = do---   store <- storePresents ps---   get (store :: IORef [Present])
− tests/examples/ghc710/MultiWayIf.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE MultiWayIf #-}---instance Animatable Double where-    interpolate ease from to t =-        if | t <= 0 -> from-           | t >= 1 -> to-           | otherwise -> from + easeDouble ease t * (to - from)-    animAdd = (+)-    animSub = (-)-    animZero = 0
− tests/examples/ghc710/NestedDoLambda.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE Arrows #-}--operator = describe "Operators on ProcessA"$-  do-    describe "feedback" $-      do-        it "acts like local variable with hold." $-          do-            let-                pa = proc evx ->-                  do-                    (\evy -> hold 10 -< evy)-                      `feedback` \y ->-                      do-                        returnA -< ((+y) <$> evx, (y+1) <$ evx)-            run pa [1, 2, 3] `shouldBe` [11, 13, 15]--        it "correctly handles stream end." $-          do-            let-                pa = proc x ->-                    (\asx -> returnA -< asx)-                  `feedback`-                    (\asy -> returnA -< (asy::Event Int, x))-                comp = mkProc (PgPush PgStop) >>> pa-            stateProc comp [0, 0] `shouldBe` ([], [0])--        it "correctly handles stream end.(2)" $-          do-            pendingWith "now many utilities behave incorrectly at the end of stream."-
− tests/examples/ghc710/NestedLambda.hs 
@@ -1,8 +0,0 @@----getPath :: [String] -> Filter-getPath names elms =-  let follow = foldl (\f n -> \els-> subElems n $ f els) id' names :: Filter-      id' = id :: Filter-  in  follow elms
− tests/examples/ghc710/NullaryTypeClasses.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE NullaryTypeClasses #-}---- From https://ocharles.org.uk/blog/posts/2014-12-10-nullary-type-classes.html--class Logger where-  logMessage :: String -> IO ()--type Present = String-queueNewChristmasPresents :: Logger => [Present] -> IO ()-queueNewChristmasPresents presents = do-  mapM (logMessage . ("Queueing present for delivery: " ++)) presents-  return ()--instance Logger where-  logMessage t = putStrLn ("[XMAS LOG]: " ++ t)-
− tests/examples/ghc710/Obscure.hs 
@@ -1,29 +0,0 @@-type A = Integer-data B = B { u :: !B, j :: B, r :: !A, i :: [A] } | Y-c=head-k=tail-b x y=x(y)y-n=map(snd)h-m=2:3:5:[7]-f=s(flip(a))t-s x y z=x(y(z))-e=filter(v)[2..221]-z=s(s(s((s)b)(s(s)flip)))s-main=mapM_(print)(m++map(fst)h)-v=s(flip(all)m)(s((.)(/=0))mod)-t=(s(s(s(b))flip)((s)s))(s(B(Y)Y)c)k-g=z(:)(z(,)c(b(s((s)map(*))c)))(s(g)k)-h=c(q):c(k(q)):d(p(t((c)n))(k(n)))(k((k)q))-q=g(scanl1(+)(11:cycle(zipWith(-)((k)e)e)))-a x Y = x-a Y x = x-a x y = case compare((r)x)(r(y)) of-  GT -> a(y)x-  _  -> B(a((j)x)y)(u(x))((r)x)(i(x))-p x y = case compare((r)x)(c(c(y))) of-  GT -> p(f((c)y)x)(k(y))-  _  -> r(x):p(f((i)x)(a(u(x))(j(x))))y-d x y = case compare((c)x)(fst(c(y))) of-  GT -> c(y):(d)x((k)y)-  LT -> d(k(x))y-  EQ -> d((k)x)(k(y))
− tests/examples/ghc710/OptSig.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--errors= do-  let ls :: [[String ]]= runR  readp $ pack "[" `append` (B.tail log) `append` pack "]"-  return ()---- This can be seen as the definition of accumFilter-accumFilter2 :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)-accumFilter2 f c_init =-    switch (never &&& attach c_init) afAux-    where-    afAux (c, a) =-            case f c a of-            (c', Nothing) -> switch (never &&& (notYet>>>attach c')) afAux-            (c', Just b)  -> switch (now b &&& (notYet>>>attach c')) afAux--    attach :: b -> SF (Event a) (Event (b, a))-        attach c = arr (fmap (\a -> (c, a)))
− tests/examples/ghc710/OptSig2.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--errors= do-  let ls :: Int = undefined-  return ()
− tests/examples/ghc710/OveridingPrimitives.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE TypeOperators          #-}--(~#) :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts)-(~#) = cascadeW-infixr 0 ~#-
− tests/examples/ghc710/OverloadedStrings.hs 
@@ -1,15 +0,0 @@-{-# Language OverloadedStrings #-}--- from https://ocharles.org.uk/blog/posts/2014-12-17-overloaded-strings.html--import Data.String--n :: Num a => a-n = 43--f  :: Fractional a => a-f = 03.1420---- foo :: Text-foo :: Data.String.IsString a => a-foo = "hello\n there"-
− tests/examples/ghc710/PArr.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE ParallelListComp #-}--module PArr where--blah xs ys = [ (x, y) | x <- xs | y <- ys ]---- bar = [: 1, 2 .. 3 :]----- entry point for desugaring a parallel array comprehension---- parr = [:e | qss:] = <<[:e | qss:]>> () [:():]--{--ary = let arr1 = toP [1..10]-          arr2 = toP [1..10]-          f = [: i1 + i2 | i1 <- arr1 | i2 <- arr2 :]-          in f !: 1--}---foo = 'a'-
− tests/examples/ghc710/ParensAroundContext.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE PartialTypeSignatures #-}-module ParensAroundContext where--f :: ((Eq a, _)) => a -> a -> Bool-f x y = x == y
− tests/examples/ghc710/PatBind.hs 
@@ -1,34 +0,0 @@-module   Layout.PatBind where--a,b :: Int-a = 1-b = 2--c :: Maybe (a -> b)-c = Nothing--f :: (Num a1, Num a) => a -> a1 -> ( a, a1 )-f x y = ( x+1, y-1 )---- Chris done comment attachment problem-foo = x-  where -- do stuff-        doStuff = do stuff-x = 1-stuff = 4-- -- Pattern bind-tup :: (Int, Int)-h :: Int-t :: Int-tup@(h,t) = head $ zip [1..10] [3..ff]-  where-    ff :: Int-    ff = 15--blah = do {- ; print "a"- ; print "b"- }--
− tests/examples/ghc710/PatSigBind.hs 
@@ -1,15 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--runCoreRunIO-  :: EHCOpts        -- ^ options, e.g. for turning on tracing (if supported by runner)-     -> Mod         -- ^ the module to run-     -> IO (Either Err RVal)-runCoreRunIO opts mod = do-    catch-      (runCoreRun opts [] mod $ cmodRun opts mod)-      (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "runCoreRunIO: " ++ show e))---foo = do-  (a :: Int) <- baz-  return grue
− tests/examples/ghc710/PatSynBind.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}---- From https://ocharles.org.uk/blog/posts/2014-12-03-pattern-synonyms.html--import Foreign.C--{---data BlendMode = NoBlending -- | AlphaBlending | AdditiveBlending | ColourModulatedBlending--toBlendMode :: BlendMode -> CInt-toBlendMode NoBlending = 0 -- #{const SDL_BLENDMODE_NONE}--- toBlendMode AlphaBlending = #{const SDL_BLENDMODE_BLEND}--fromBlendMode :: CInt -> Maybe BlendMode-fromBlendMode 0 = Just NoBlending---}--{---pattern AlphaBlending = (1) :: CInt -- #{const SDL_BLENDMODE_BLEND} :: CInt--setUpBlendMode :: CInt -> IO ()-setUpBlendMode AlphaBlending = do-  putStrLn "Enabling Alpha Blending"-  activateAlphaBlendingForAllTextures-  activateRenderAlphaBlending---}--newtype BlendMode = MkBlendMode { unBlendMode :: CInt }--pattern NoBlending = MkBlendMode 0 -- #{const SDL_BLENDMODE_NONE}-pattern AlphaBlending = MkBlendMode 1 -- #{const SDL_BLENDMODE_BLEND}--setUpBlendMode :: BlendMode -> IO ()-setUpBlendMode AlphaBlending = do-  putStrLn "Enabling Alpha Blending"-  activateAlphaBlendingForAllTextures-  activateRenderAlphaBlending--data Renderer--setRenderAlphaBlending :: Renderer -> IO ()-setRenderAlphaBlending r =-  sdlSetRenderDrawBlendMode r (unBlendMode AlphaBlending)--activateAlphaBlendingForAllTextures = return ()-activateRenderAlphaBlending = return ()--sdlSetRenderDrawBlendMode _ _ = return ()---- And from https://www.fpcomplete.com/user/icelandj/Pattern%20synonyms--data Date = Date { month :: Int, day :: Int } deriving Show---- Months-pattern January  day = Date { month = 1,  day = day }-pattern February day = Date { month = 2,  day = day }-pattern March    day = Date { month = 3,  day = day }--- elided-pattern December day = Date { month = 12, day = day }---- Holidays-pattern Christmas    = Date { month = 12, day = 25  }--describe :: Date -> String-describe (January 1)  = "First day of year"-describe (February n) = show n ++ "th of February"-describe Christmas    = "Presents!"-describe _            = "meh"--pattern Christmas2 = December 25--pattern BeforeChristmas <- December (compare 25 -> GT)-pattern Christmas3      <- December (compare 25 -> EQ)-pattern AfterChristmas  <- December (compare 25 -> LT)--react :: Date -> String-react BeforeChristmas = "Waiting :("-react Christmas       = "Presents!"-react AfterChristmas  = "Have to wait a whole year :("-react _               = "It's not even December..."--isItNow :: Int -> (Ordering, Int)-isItNow day = (compare 25 day, day)--pattern BeforeChristmas4 day <- December (isItNow -> (GT, day))-pattern Christmas4           <- December (isItNow -> (EQ, _))-pattern AfterChristmas4  day <- December (isItNow -> (LT, day))--days'tilChristmas :: Date -> Int-days'tilChristmas (BeforeChristmas4 n) = 25 - n-days'tilChristmas Christmas4           = 0-days'tilChristmas (AfterChristmas4 n)  = 365 + 25 - n
− tests/examples/ghc710/PatternGuards.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE PatternGuards #-}--match n-      | Just 5 <- Just n-      , Just 6 <- Nothing-      , Just 7 <- Just 9-      = Just 8
− tests/examples/ghc710/Ppr006a.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module Ppr006a where--commands :: [Command]-commands = [-    command "novisual" "cancel visual selection" $-      sendEventCurrent EvNoVisual--  -- insert a song right after the current song-  , command "insert" [help|-      inserts a song to the playlist. The song is inserted after the currently-      playing song.-      |] $ do-      st <- MPD.status-      case MPD.stSongPos st of-        Just n -> do-          -- there is a current song, insert after-          sendEventCurrent (EvInsert (n + 1))-        _ -> do-          -- there is no current song, just add-          sendEventCurrent EvAdd--  ]-
− tests/examples/ghc710/ProcNotation.hs 
@@ -1,12 +0,0 @@-{-#LANGUAGE Arrows, RankNTypes, ScopedTypeVariables, FlexibleContexts,-  TypeSynonymInstances, NoMonomorphismRestriction, FlexibleInstances #-}--valForm initVal vtor label = withInput $-    proc ((),nm,fi) -> do-      s_curr <- keepState initVal -< fi-      valid <- vtor -< s_curr-      case valid of-         Left err -> returnA -< (textField label (Just err) s_curr nm,-                                                   Nothing)-         Right x -> returnA -< (textField label Nothing s_curr nm,-                                Just x)
− tests/examples/ghc710/Process.hs 
@@ -1,717 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-module Synthesizer.MIDI.CausalIO.Process (-   Events,--   slice,-   controllerLinear,-   controllerExponential,-   pitchBend,-   channelPressure,-   bendWheelPressure,-   constant,--   Instrument,-   Bank,-   GateChunk,-   noteEvents,-   embedPrograms,-   applyInstrument,-   applyModulatedInstrument,-   flattenControlSchedule,-   applyModulation,-   arrangeStorable,-   sequenceCore,-   sequenceModulated,-   sequenceModulatedMultiProgram,-   sequenceModulatedMultiProgramVelocityPitch,-   sequenceStorable,--   -- auxiliary function-   initWith,-   mapMaybe,-   ) where--import qualified Synthesizer.CausalIO.Gate as Gate-import qualified Synthesizer.CausalIO.Process as PIO--import qualified Synthesizer.MIDI.Value.BendModulation as BM-import qualified Synthesizer.MIDI.Value.BendWheelPressure as BWP-import qualified Synthesizer.MIDI.Value as MV--import qualified Synthesizer.MIDI.EventList as MIDIEv-import Synthesizer.MIDI.EventList (StrictTime, )--import qualified Synthesizer.PiecewiseConstant.Signal as PC-import qualified Synthesizer.Storable.Cut as CutSt-import qualified Synthesizer.Generic.Cut as CutG-import qualified Synthesizer.Zip as Zip--import qualified Sound.MIDI.Message.Class.Check as Check-import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg--import Control.DeepSeq (rnf, )--import qualified Data.EventList.Relative.TimeBody  as EventList-import qualified Data.EventList.Relative.BodyTime  as EventListBT-import qualified Data.EventList.Relative.TimeTime  as EventListTT-import qualified Data.EventList.Relative.TimeMixed as EventListTM-import qualified Data.EventList.Relative.MixedTime as EventListMT-import qualified Data.EventList.Absolute.TimeBody  as AbsEventList--import qualified Numeric.NonNegative.Wrapper as NonNegW-import qualified Numeric.NonNegative.Class as NonNeg--import qualified Algebra.Transcendental as Trans-import qualified Algebra.RealRing       as RealRing-import qualified Algebra.Field          as Field-import qualified Algebra.Additive       as Additive-import qualified Algebra.ToInteger      as ToInteger--import qualified Data.StorableVector as SV-import qualified Data.StorableVector.ST.Strict as SVST-import Foreign.Storable (Storable, )--import qualified Control.Monad.Trans.Writer as MW-import qualified Control.Monad.Trans.State as MS-import qualified Control.Monad.Trans.Class as MT-import Control.Monad.IO.Class (liftIO, )--import qualified Data.Traversable as Trav-import Data.Traversable (Traversable, )-import Data.Foldable (traverse_, )--import Control.Arrow (Arrow, arr, (^<<), (<<^), )-import Control.Category ((.), )--import qualified Data.Map as Map--import qualified Data.List.HT as ListHT-import qualified Data.Maybe as Maybe-import Data.Monoid (Monoid, mempty, mappend, )-import Data.Maybe (maybeToList, )-import Data.Tuple.HT (mapFst, mapPair, )--import NumericPrelude.Numeric-import NumericPrelude.Base hiding ((.), sequence, )-import Prelude ()---type Events event = EventListTT.T StrictTime [event]---initWith ::-   (y -> c) ->-   c ->-   PIO.T-      (Events y)-      (EventListBT.T PC.ShortStrictTime c)-initWith f initial =-   PIO.traverse initial $-      \evs0 -> do-         y0 <- MS.get-         fmap (PC.subdivideLongStrict . EventListMT.consBody y0) $-            Trav.traverse (\ys -> traverse_ (MS.put . f) ys >> MS.get) evs0--slice ::-   (Check.C event) =>-   (event -> Maybe Int) ->-   (Int -> y) -> y ->-   PIO.T-      (Events event)-      (EventListBT.T PC.ShortStrictTime y)-slice select f initial =-   initWith f initial . mapMaybe select----mapMaybe ::-   (Arrow arrow, Functor f) =>-   (a -> Maybe b) ->-   arrow (f [a]) (f [b])-mapMaybe f =-   arr $ fmap $ Maybe.mapMaybe f--catMaybes ::-   (Arrow arrow, Functor f) =>-   arrow (f [Maybe a]) (f [a])-catMaybes =-   arr $ fmap Maybe.catMaybes--traverse ::-   (Traversable f) =>-   s -> (a -> MS.State s b) ->-   PIO.T (f [a]) (f [b])-traverse initial f =-   PIO.traverse initial (Trav.traverse (Trav.traverse f))---controllerLinear ::-   (Check.C event, Field.C y) =>-   MIDIEv.Channel ->-   MIDIEv.Controller ->-   (y,y) -> y ->-   PIO.T-      (Events event)-      (EventListBT.T PC.ShortStrictTime y)-controllerLinear chan ctrl bnd initial =-   slice (Check.controller chan ctrl)-      (MV.controllerLinear bnd) initial--controllerExponential ::-   (Check.C event, Trans.C y) =>-   MIDIEv.Channel ->-   MIDIEv.Controller ->-   (y,y) -> y ->-   PIO.T-      (Events event)-      (EventListBT.T PC.ShortStrictTime y)-controllerExponential chan ctrl bnd initial =-   slice (Check.controller chan ctrl)-      (MV.controllerExponential bnd) initial--pitchBend ::-   (Check.C event, Trans.C y) =>-   MIDIEv.Channel ->-   y -> y ->-   PIO.T-      (Events event)-      (EventListBT.T PC.ShortStrictTime y)-pitchBend chan range center =-   slice (Check.pitchBend chan)-      (MV.pitchBend range center) center--channelPressure ::-   (Check.C event, Trans.C y) =>-   MIDIEv.Channel ->-   y -> y ->-   PIO.T-      (Events event)-      (EventListBT.T PC.ShortStrictTime y)-channelPressure chan maxVal initial =-   slice (Check.channelPressure chan)-      (MV.controllerLinear (zero,maxVal)) initial--bendWheelPressure ::-   (Check.C event, RealRing.C y, Trans.C y) =>-   MIDIEv.Channel ->-   Int -> y -> y ->-   PIO.T-      (Events event)-      (EventListBT.T PC.ShortStrictTime (BM.T y))-bendWheelPressure chan-      pitchRange wheelDepth pressDepth =-   let toBM = BM.fromBendWheelPressure pitchRange wheelDepth pressDepth-   in  initWith toBM (toBM BWP.deflt)-       .-       catMaybes-       .-       traverse BWP.deflt (BWP.check chan)----- might be moved to synthesizer-core-constant ::-   (Arrow arrow) =>-   y -> arrow (Events event) (EventListBT.T PC.ShortStrictTime y)-constant y = arr $-   EventListBT.singleton y .-   NonNegW.fromNumberMsg "MIDI.CausalIO.constant" .-   fromIntegral .-   EventListTT.duration--_constant ::-   (Arrow arrow, CutG.Read input) =>-   y -> arrow input (EventListBT.T PC.ShortStrictTime y)-_constant y = arr $-   EventListBT.singleton y .-   NonNegW.fromNumberMsg "MIDI.CausalIO.constant" .-   CutG.length----noteEvents ::-   (Check.C event, Arrow arrow) =>-   MIDIEv.Channel ->-   arrow-      (Events event)-      (Events (Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)))-noteEvents chan =-   mapMaybe $ MIDIEv.checkNoteEvent chan---embedPrograms ::-   MIDIEv.Program ->-   PIO.T-      (Events (Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)))-      (Events (MIDIEv.NoteBoundary (Maybe MIDIEv.Program)))-embedPrograms initPgm =-   catMaybes .-   traverse initPgm MIDIEv.embedProgramState---type GateChunk = Gate.Chunk MIDIEv.Velocity-type Instrument y chunk = y -> y -> PIO.T GateChunk chunk-type Bank y chunk = MIDIEv.Program -> Instrument y chunk----{--for distinction of notes with the same pitch--We must use Integer instead of Int, in order to avoid an overflow-that would invalidate the check for unmatched NoteOffs-that is based on comparison of the NoteIds.-We cannot re-use NoteIds easily,-since the events at one time point are handled out of order.--}-newtype NoteId = NoteId Integer-   deriving (Show, Eq, Ord)--succNoteId :: NoteId -> NoteId-succNoteId (NoteId n) = NoteId (n+1)--flattenNoteIdRange :: (NoteId,NoteId) -> [NoteId]-flattenNoteIdRange (start,afterEnd) =-   takeWhile (<afterEnd) $ iterate succNoteId start---newtype NoteOffList =-   NoteOffList {-      unwrapNoteOffList :: Events (NoteBoundary NoteId)-   }---instance CutG.Read NoteOffList where-   null (NoteOffList evs) =-      EventListTT.isPause evs && EventListTT.duration evs == 0-   length = fromIntegral . EventListTT.duration . unwrapNoteOffList--instance CutG.NormalForm NoteOffList where-   evaluateHead =-      EventListMT.switchTimeL (\t _ -> rnf (NonNegW.toNumber t)) .-      unwrapNoteOffList--instance Monoid NoteOffList where-   mempty = NoteOffList (EventListTT.pause mempty)-   mappend (NoteOffList xs) (NoteOffList ys) =-      NoteOffList (mappend xs ys)--{- |-The function defined here are based on the interpretation-of event lists as piecewise constant signals.-They do not fit to the interpretation of atomic events.-Because e.g. it makes no sense to split an atomic event into two instances by splitAt,-and it is also not clear, whether dropping the first chunk-shall leave a chunk of length zero-or remove that chunk completely.--}-instance CutG.Transform NoteOffList where-   take n (NoteOffList xs) =-      NoteOffList $-      EventListTT.takeTime-         (NonNegW.fromNumberMsg "NoteOffList.take" $ fromIntegral n) xs-   drop n (NoteOffList xs) =-      NoteOffList $-      EventListTT.dropTime-         (NonNegW.fromNumberMsg "NoteOffList.drop" $ fromIntegral n) xs-   splitAt n (NoteOffList xs) =-      mapPair (NoteOffList, NoteOffList) $-      EventListTT.splitAtTime-         (NonNegW.fromNumberMsg "NoteOffList.splitAtTime" $ fromIntegral n) xs--   -- cf. ChunkySize.dropMarginRem-   dropMarginRem =-      CutG.dropMarginRemChunky-         (fmap fromIntegral . EventListTT.getTimes . unwrapNoteOffList)--   reverse (NoteOffList xs) =-      NoteOffList . EventListTT.reverse $ xs---findEvent ::-   (a -> Bool) ->-   Events a -> (Events a, Maybe a)-findEvent p =-   EventListTT.foldr-      (\t -> mapFst (EventListMT.consTime t))-      (\evs rest ->-         case ListHT.break p evs of-            (prefix, suffix) ->-               mapFst (EventListMT.consBody prefix) $-               case suffix of-                  [] -> rest-                  ev:_ -> (EventListTT.pause mempty, Just ev))-      (EventListBT.empty, Nothing)--gateFromNoteOffs ::-   (MIDIEv.Pitch, NoteId) ->-   NoteOffList ->-   GateChunk-gateFromNoteOffs pitchNoteId (NoteOffList noteOffs) =-   let dur = EventListTT.duration noteOffs-       (sustain, mEnd) =-          findEvent-             (\bnd ->-                case bnd of-                   -- AllNotesOff -> True-                   NoteBoundary endPitch _ noteId ->-                      pitchNoteId == (endPitch, noteId))-          noteOffs-   in  Gate.chunk dur $-       flip fmap mEnd $ \end ->-       (EventListTT.duration sustain,-        case end of-           NoteBoundary _ endVel _ -> endVel-           {--           AllNotesOff -> VoiceMsg.normalVelocity -} )---data NoteBoundary a =-     NoteBoundary VoiceMsg.Pitch VoiceMsg.Velocity a---   | AllSoundOff-   deriving (Eq, Show)--{- |-We count NoteIds per pitch,-such that the pair (pitch,noteId) identifies a note.-We treat nested notes in a first-in-first-out order (FIFO).-E.g.--> On, On, On, Off, Off, Off--is interpreted as--> On 0, On 1, On 2, Off 0, Off 1, Off 2--NoteOffs without previous NoteOns are thrown away.--}-assignNoteIds ::-   (Traversable f) =>-   PIO.T-      (f [MIDIEv.NoteBoundary (Maybe MIDIEv.Program)])-      (f [NoteBoundary (NoteId, Maybe MIDIEv.Program)])-assignNoteIds =-   fmap concat-   ^<<-   traverse Map.empty (\bnd ->-      case bnd of-         MIDIEv.AllNotesOff -> do-            notes <- MS.get-            MS.put Map.empty-            return $-               concatMap (\(pitch, range) ->-                  map-                     (\noteId ->-                        NoteBoundary pitch VoiceMsg.normalVelocity-                           (noteId, Nothing))-                     (flattenNoteIdRange range)) $-               Map.toList notes-         MIDIEv.NoteBoundary pitch vel mpgm ->-            fmap (fmap (\noteId ->-               NoteBoundary pitch vel (noteId,mpgm))) $-            case mpgm of-               Nothing -> do-                  mNoteId <- MS.gets (Map.lookup pitch)-                  case mNoteId of-                     Nothing -> return []-                     Just (nextNoteOffId, nextNoteOnId) ->-                        if nextNoteOffId >= nextNoteOnId-                          then return []-                          else do-                             MS.modify (Map.insert pitch (succNoteId nextNoteOffId, nextNoteOnId))-                             return [nextNoteOffId]-               Just _ -> do-                  mNoteId <- MS.gets (Map.lookup pitch)-                  let (nextNoteOffId, nextNoteOnId) =-                         case mNoteId of-                            Nothing -> (NoteId 0, NoteId 0)-                            Just ids -> ids--                  MS.modify (Map.insert pitch (nextNoteOffId, succNoteId nextNoteOnId))-                  return [nextNoteOnId])--{-# INLINE velFreqBank #-}-velFreqBank ::-   (Trans.C y) =>-   (MIDIEv.Program -> y -> y -> process) ->-   (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch -> process)-velFreqBank bank pgm vel pitch =-   bank pgm (MV.velocity vel) (MV.frequencyFromPitch pitch)--applyInstrumentCore ::-   (Arrow arrow) =>-   ((MIDIEv.Pitch, NoteId) -> noteOffListCtrl -> gateCtrl) ->-   (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->-    PIO.T gateCtrl chunk) ->-   arrow-      (Events (NoteBoundary (NoteId, Maybe MIDIEv.Program)))-      (Zip.T-         NoteOffList-         (Events (PIO.T noteOffListCtrl chunk)))-applyInstrumentCore makeGate bank = arr $-   uncurry Zip.Cons .-   mapFst NoteOffList .-   EventListTT.unzip .-   fmap (ListHT.unzipEithers . fmap (\ev ->-      case ev of---         MIDIEv.AllNotesOff -> Left MIDIEv.AllNotesOff-         NoteBoundary pitch vel (noteId, mpgm) ->-            case mpgm of-               Nothing -> Left $ NoteBoundary pitch vel noteId-               Just pgm ->-                  Right $-                     bank pgm vel pitch-                     <<^-                     makeGate (pitch, noteId)))--applyInstrument ::-   (Arrow arrow) =>-   (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->-    PIO.T GateChunk chunk) ->-   arrow-      (Events (NoteBoundary (NoteId, Maybe MIDIEv.Program)))-      (Zip.T-         NoteOffList-         (Events (PIO.T NoteOffList chunk)))-applyInstrument bank =-   applyInstrumentCore gateFromNoteOffs bank---type ModulatedBank y ctrl chunk =-        MIDIEv.Program -> y -> y ->-        PIO.T (Zip.T GateChunk ctrl) chunk--applyModulatedInstrument ::-   (Arrow arrow, CutG.Read ctrl) =>-   (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->-    PIO.T (Zip.T GateChunk ctrl) chunk) ->-   arrow-      (Zip.T-         (Events (NoteBoundary (NoteId, Maybe MIDIEv.Program)))-         ctrl)-      (Zip.T-         (Zip.T NoteOffList ctrl)-         (Events (PIO.T (Zip.T NoteOffList ctrl) chunk)))-applyModulatedInstrument bank =-   (\(Zip.Cons (Zip.Cons noteOffs events) ctrl) ->-      Zip.Cons (Zip.Cons noteOffs ctrl) events)-   ^<<-   Zip.arrowFirst-      (applyInstrumentCore-         (Zip.arrowFirst . gateFromNoteOffs) bank)---{- |-Turn an event list with bundles of elements-into an event list with single events.-ToDo: Move to event-list package?--}-flatten ::-   (NonNeg.C time) =>-   a ->-   EventListTT.T time [a] ->-   EventListTT.T time a-flatten empty =-   EventListTT.foldr-      EventListMT.consTime-      (\bt xs ->-         uncurry EventListMT.consBody $-         case bt of-            [] -> (empty, xs)-            b:bs -> (b, foldr (\c rest -> EventListTT.cons NonNeg.zero c rest) xs bs))-      EventListBT.empty---flattenControlSchedule ::-   (Monoid chunk, Arrow arrow) =>-   arrow-      (Zip.T ctrl-         (EventListTT.T StrictTime [PIO.T ctrl chunk]))-      (Zip.T ctrl-         (EventListTT.T StrictTime (PIO.T ctrl chunk)))-flattenControlSchedule = arr $-   \(Zip.Cons ctrl evs) ->-      -- Zip.consChecked "flattenControlSchedule" ctrl $-      Zip.Cons ctrl $-      flatten (arr (const mempty)) evs----data CausalState a b =-   forall state.-   CausalState-      (a -> state -> IO (b, state))-      (state -> IO ())-      state--_applyChunkSimple :: CausalState a b -> a -> IO (b, CausalState a b)-_applyChunkSimple (CausalState next delete state0) input = do-   (output, state1) <- next input state0-   return (output, CausalState next delete state1)--applyChunk ::-   (CutG.Read a, CutG.Read b) =>-   CausalState a b -> a -> IO (b, Maybe (CausalState a b))-applyChunk (CausalState next delete state0) input = do-   (output, state1) <- next input state0-   cs <--      if CutG.length output < CutG.length input-        then do-           delete state1-           return Nothing-        else return $ Just $ CausalState next delete state1-   return (output, cs)---- could be moved to synthesizer-core-applyModulation ::-   (CutG.Transform ctrl, CutG.NormalForm ctrl,-    CutG.Read chunk,-    Monoid time, ToInteger.C time) =>-   PIO.T-      (Zip.T ctrl (EventListTT.T time (PIO.T ctrl chunk)))-      (EventListTT.T time chunk)-applyModulation = PIO.Cons-   (\(Zip.Cons ctrl evs) acc0 -> do-      acc1 <- mapM (flip applyChunk ctrl) acc0-      let (accChunks, acc2) = unzip acc1--      (newChunks, newAcc) <--         MW.runWriterT $-         flip MS.evalStateT ctrl $-         EventListTT.mapM-            (\time -> do-               ctrl_ <- MS.gets (CutG.drop (fromIntegral time))-               MS.put ctrl_-               return (case CutG.evaluateHead ctrl_ of () -> time))-            (\(PIO.Cons next create delete) -> do-               state0 <- liftIO create-               (chunk, state1) <--                  liftIO . applyChunk (CausalState next delete state0)-                  =<< MS.get-               MT.lift $ MW.tell $ maybeToList state1-               return chunk)-            evs--      return-         (EventListTM.prependBodyEnd-             (EventList.fromPairList $-              map ((,) mempty) accChunks)-             newChunks,-          Maybe.catMaybes acc2 ++ newAcc))--   (return [])-   (mapM_ (\(CausalState _ close state) -> close state))---- move synthesizer-core:CausalIO-arrangeStorable ::-   (Arrow arrow, Storable a, Additive.C a) =>-   arrow-      (EventListTT.T StrictTime (SV.Vector a))-      (SV.Vector a)-arrangeStorable =-   arr $ \evs ->-   SVST.runSTVector (do-      v <- SVST.new (fromIntegral $ EventListTT.duration evs) zero-      mapM_ (uncurry $ CutSt.addChunkToBuffer v) $-         AbsEventList.toPairList $-         AbsEventList.mapTime fromIntegral $-         EventList.toAbsoluteEventList 0 $-         EventListTM.switchTimeR const evs-      return v)----sequenceCore ::-   (Check.C event, Monoid chunk, CutG.Read chunk, Trans.C y) =>-   MIDIEv.Channel ->-   Bank y chunk ->-   PIO.T (Events event) (EventListTT.T StrictTime chunk)-sequenceCore channel bank =-   applyModulation-   .-   flattenControlSchedule-   .-   applyInstrument (velFreqBank bank)-   .-   assignNoteIds-   .-   embedPrograms (VoiceMsg.toProgram 0)-   .-   noteEvents channel---sequenceModulated ::-   (Check.C event, Monoid chunk, CutG.Read chunk,-    CutG.Transform ctrl, CutG.NormalForm ctrl, Trans.C y) =>-   MIDIEv.Channel ->-   ModulatedBank y ctrl chunk ->-   PIO.T (Zip.T (Events event) ctrl) (EventListTT.T StrictTime chunk)-sequenceModulated channel bank =-   applyModulation-   .-   flattenControlSchedule-   .-   applyModulatedInstrument (velFreqBank bank)-   .-   Zip.arrowFirst-      (assignNoteIds-       .-       embedPrograms (VoiceMsg.toProgram 0)-       .-       noteEvents channel)---sequenceModulatedMultiProgram ::-   (Check.C event, Monoid chunk, CutG.Read chunk,-    CutG.Transform ctrl, CutG.NormalForm ctrl, Trans.C y) =>-   MIDIEv.Channel ->-   MIDIEv.Program ->-   ModulatedBank y ctrl chunk ->-   PIO.T (Zip.T (Events event) ctrl) (EventListTT.T StrictTime chunk)-sequenceModulatedMultiProgram channel initPgm bank =-   applyModulation-   .-   flattenControlSchedule-   .-   applyModulatedInstrument (velFreqBank bank)-   .-   Zip.arrowFirst-      (assignNoteIds-       .-       embedPrograms initPgm-       .-       noteEvents channel)----- | may replace the other functions-sequenceModulatedMultiProgramVelocityPitch ::-   (Check.C event, Monoid chunk, CutG.Read chunk,-    CutG.Transform ctrl, CutG.NormalForm ctrl) =>-   MIDIEv.Channel ->-   MIDIEv.Program ->-   (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->-    PIO.T (Zip.T GateChunk ctrl) chunk) ->-   PIO.T (Zip.T (Events event) ctrl) (EventListTT.T StrictTime chunk)-sequenceModulatedMultiProgramVelocityPitch channel initPgm bank =-   applyModulation-   .-   flattenControlSchedule-   .-   applyModulatedInstrument bank-   .-   Zip.arrowFirst-      (assignNoteIds-       .-       embedPrograms initPgm-       .-       noteEvents channel)---sequenceStorable ::-   (Check.C event, Storable a, Additive.C a, Trans.C y) =>-   MIDIEv.Channel ->-   Bank y (SV.Vector a) ->-   PIO.T (Events event) (SV.Vector a)-sequenceStorable channel bank =-   arrangeStorable-   .-   sequenceCore channel bank
− tests/examples/ghc710/Process1.hs 
@@ -1,7 +0,0 @@-module Synthesizer.MIDI.CausalIO.Process1 where--gateFromNoteOffs=-   let dur = 1-   in (d, 3-          {--            AllNotesOff -> VoiceMsg.normalVelocity -} )
− tests/examples/ghc710/Pseudonym.hs 
@@ -1,41 +0,0 @@-default(Int);q s=s++ss s;ss ""=" \"\"";ss s=" "++show(take 50 s)++"++\n"++- ss(dd 50 s);t3="   ";z n=t3++" xo"!!n:t3;zl n = z(l n);j=head$[m|- (m,0)<-zip[0..]p]++[-1];l s = if j==s then 2 else p!!s;m=- "default(Int);q s=s++ss s;ss \"\"=\" \\\"\\\"\";ss s=\" \"++s"++- "how(take 50 s)++\"++\\n\"++\n ss(dd 50 s);t3=\"   \";z n"++- "=t3++\" xo\"!!n:t3;zl n = z(l n);j=head$[m|\n (m,0)<-"++- "zip[0..]p]++[-1];l s = if j==s then 2 else p!!s;m=\n"-vv="\n "++z0++";z0=z"++z0++"0 ;a=\n "++zl 4++"-0;b="++zl 7++"-0;c="++zl 1++- "\n "++z0++"-0;ms"++z0++"=[[4,\n 7,1],[6,0,5],[2,8,3],[4,6,2],[7\n ,0,8],[1, 5,3],[4,0,3],[1,0,2]]\n ;main=putStr(unlines[q m,q y,vv\n "++z0++"]);x="- ++z0++"1; d=\n "++zl 6++"-0;e="++zl 0++"-0;f="++zl 5++"\n "++z0++"-0"- ++";o="++z0++"2;p=[\n e,c,g,i,a,f,d,b,h];r=[\"\",\"You \"\n ++\"win\",\"I win\"]!!head([w|w<-[1\n ,2],x<-ms,all(\\x->w==l x)x]++[0\n "++z0++"]);n="++z0++"1"- ++"9;g=\n "++zl 2++"-0;h="++zl 8++"-0;i="++zl 3++"\n "++z0++"-0;dd"++z0++- "=drop\n\n"++r-;y= "vv=\"\\n \"++z0++\";z0=z\"++z0++\"0 ;a=\\n \"++zl 4++\"-0;b"++- "=\"++zl 7++\"-0;c=\"++zl 1++\n \"\\n \"++z0++\"-0;ms\"++z0+"++- "+\"=[[4,\\n 7,1],[6,0,5],[2,8,3],[4,6,2],[7\\n ,0,8],"++- "[1, 5,3],[4,0,3],[1,0,2]]\\n ;main=putStr(unlines[q"++- " m,q y,vv\\n \"++z0++\"]);x=\"\n ++z0++\"1; d=\\n \"++zl 6"++- "++\"-0;e=\"++zl 0++\"-0;f=\"++zl 5++\"\\n \"++z0++\"-0\"\n +"++- "+\";o=\"++z0++\"2;p=[\\n e,c,g,i,a,f,d,b,h];r=[\\\"\\\",\\\""++- "You \\\"\\n ++\\\"win\\\",\\\"I win\\\"]!!head([w|w<-[1\\n ,2]"++- ",x<-ms,all(\\\\x->w==l x)x]++[0\\n \"++z0++\"]);n=\"++z0"++- "++\"1\"\n ++\"9;g=\\n \"++zl 2++\"-0;h=\"++zl 8++\"-0;i=\"++"++- "zl 3++\"\\n \"++z0++\"-0;dd\"++z0++\n \"=drop\\n\\n\"++r\n;y="--        ;z0=z       0 ;a=-        -0;b=       -0;c=-        -0;ms       =[[4,- 7,1],[6,0,5],[2,8,3],[4,6,2],[7- ,0,8],[1, 5,3],[4,0,3],[1,0,2]]- ;main=putStr(unlines[q m,q y,vv-        ]);x=       1; d=-        -0;e=       -0;f=-        -0;o=       2;p=[- e,c,g,i,a,f,d,b,h];r=["","You "- ++"win","I win"]!!head([w|w<-[1- ,2],x<-ms,all(\x->w==l x)x]++[0-        ]);n=       19;g=-        -0;h=       -0;i=-        -0;dd       =drop-
− tests/examples/ghc710/PuncFunctions.hs 
@@ -1,25 +0,0 @@--- | Compares two functions taking one container-(=*=) :: (Eq' a b) => (f -> a) -> (g -> b)-      -> SameAs f g r -> r -> Property-(f =*= g) sa i = f (toF sa i) =^= g (toG sa i)---- | Compares two functions taking one scalar and one container-(=?*=) :: (Eq' a b) => (t -> f -> a) -> (t -> g -> b)-       -> SameAs f g r -> r -> t -> Property-(f =?*= g) sa i t = (f t =*= g t) sa i---- | Compares functions taking two scalars and one container-(=??*=) :: (Eq' a b) => (t -> s -> f -> a) -> (t -> s -> g -> b)-        -> SameAs f g r -> r -> t -> s -> Property-(f =??*= g) sa i t s = (f t s =*= g t s) sa i---- | Compares two functions taking two containers-(=**=) :: (Eq' a b) => (f -> f -> a) -> (g -> g -> b)-       -> SameAs f g r -> r -> r -> Property-(f =**= g) sa i = (f (toF sa i) =*= g (toG sa i)) sa---- | Compares two functions taking one container with preprocessing-(=*==) :: (Eq' f g) => (z -> f) -> (z -> g) -> (p -> z)-       -> SameAs f g r -> p -> Property-(f =*== g) p _ i = f i' =^= g i'-  where i' = p i
− tests/examples/ghc710/QuasiQuote.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module QuasiQuote where--import T7918A--ex1 = [qq|e1|]-ex2 = [qq|e2|]-ex3 = [qq|e3|]-ex4 = [qq|e4|]--tx1 = undefined :: [qq|t1|]-tx2 = undefined :: [qq|t2|]-tx3 = undefined :: [qq|t3|]-tx4 = undefined :: [qq|t4|]--px1 [qq|p1|] = undefined-px2 [qq|p2|] = undefined-px3 [qq|p3|] = undefined-px4 [qq|p4|] = undefined--{-# LANGUAGE QuasiQuotes #-}--testComplex    = assertBool "" ([istr|-        ok-#{Foo 4 "Great!" : [Foo 3 "Scott!"]}-        then-|] == ("\n" ++-    "        ok\n" ++-    "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++-    "        then\n"))-
− tests/examples/ghc710/QuasiQuote2.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module Test where--a = bar-    where-        bar = [q|-            |]--b = bar-    where-        bar = [q|-           |]--c = bar-    where-        bar = [q|-             |]--d = [q|-            |]
− tests/examples/ghc710/RSA.hs 
@@ -1,19 +0,0 @@-import Data.Char-e=181021504832735228091659724090293195791121747536890433--u(f,m)x=i(m(x),       [],let(a,b)=f(x)       in(a:u(f,m)b))-(v,h)=(foldr(\x(y    )->00+128*y+x)0,u(     sp(25),((==)"")))-p::(Integer,Integer )->Integer      ->     Integer    --NotInt-p(n,m)x     =i(n==0 ,1,i(z n             ,q(n,m)x,    r(n,m)x))-i(n,e,d     )=if(n) then(e)              else  (d)    --23+3d4f-(g,main     ,s,un)= (\x->x,             y(j),\x->x*x,unlines)--)-j(o)=i(take(2)o==   "e=","e="++t        (drop(4-2)o),i(d>e,k,l)o)-l=un.map (show.p      (e,n).v.map(      fromIntegral{-g-}.ord)).h-k=co.map(map(chr       .fromIntegral    ).w.p(d,n).   read).lines-(t,y)=(\ (o:q)->              i(o=='-'  ,'1','-' ):   q,interact)-q(n,m)x=   mod(s(    p(        div(n)2, m{-jl-})x)    )m--hd&&gdb-(r,z,co)    =(\(n,   m)x->mod(x*p(n-1,  m)x)m,even    ,concat)--6-(w,sp)=(    u(\x->(   mod(x)128,div(x   )128),(==0    )),splitAt)--d=563347325936+1197371806136556985877790097-563347325936-n=351189532146914946493104395525009571831256157560461451
− tests/examples/ghc710/RankNTypes.hs 
@@ -1,159 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}---- from https://ocharles.org.uk/blog/guest-posts/2014-12-18-rank-n-types.html--import System.Random-import Control.Monad.State-import Data.Char---id' :: forall a. a -> a-id' x = x--f = print (id' (3 :: Integer),-           id' "blah")---- rank 2 polymorphism-type IdFunc = forall a. a -> a--id'' :: IdFunc-id'' x = x--someInt :: IdFunc -> Integer-someInt id' = id' 3---- rank 3 polymorphism-type SomeInt = IdFunc -> Integer--someOtherInt :: SomeInt -> Integer-someOtherInt someInt' =-    someInt' id + someInt' id---- random numbers--data Player =-    Player {-      playerName :: String,-      playerPos  :: (Double, Double)-    }-    deriving (Eq, Ord, Show)---{--randomPlayer-    :: (MonadIO m, MonadState g m, RandomGen g)-    => m Player--}--type GenAction m = forall a. (Random a) => m a--type GenActionR m = forall a. (Random a) => (a, a) -> m a---- genRandom :: (RandomGen g) => GenAction (State g)--- genRandom = state random--genRandomR :: (RandomGen g) => GenActionR (State g)-genRandomR range = state (randomR range)--genRandom :: (Random a, RandomGen g) => State g a-genRandom = state random---randomPlayer :: (MonadIO m) => GenActionR m -> m Player-randomPlayer genR = do-    liftIO (putStrLn "Generating random player...")--    len <- genR (8, 12)-    name <- replicateM len (genR ('a', 'z'))-    x <- genR (-100, 100)-    y <- genR (-100, 100)--    liftIO (putStrLn "Done.")-    return (Player name (x, y))--main :: IO ()-main = randomPlayer randomRIO >>= print---- scott encoding--data List a-    = Cons a (List a)-    | Nil--uncons :: (a -> List a -> r) -> r -> List a -> r-uncons co ni (Cons x xs) = co x xs-uncons co ni Nil         = ni--listNull :: List a -> Bool-listNull = uncons (\_ _ -> False) True--listMap :: (a -> b) -> List a -> List b-listMap f =-    uncons (\x xs -> Cons (f x) (listMap f xs))-           Nil--newtype ListS a =-    ListS {-      unconsS :: forall r. (a -> ListS a -> r) -> r -> r-    }--nilS :: ListS a-nilS = ListS (\co ni -> ni)--consS :: a -> ListS a -> ListS a-consS x xs = ListS (\co ni -> co x xs)--unconsS' :: (a -> ListS a -> r) -> r -> ListS a -> r-unconsS' co ni (ListS f) = f co ni--instance Functor ListS where-    fmap f =-        unconsS' (\x xs -> consS (f x) (fmap f xs))-                 nilS---- Church Encoding-newtype ListC a =-    ListC {-      foldC :: forall r. (a -> r -> r) -> r -> r-    }--foldC' :: (a -> r -> r) -> r -> ListC a -> r-foldC' co ni (ListC f) = f co ni--instance Functor ListC where-    fmap f = foldC' (\x xs -> consC (f x) xs) nilC--consC = undefined-nilC = undefined---- GADTs and continuation passing style-data Some :: * -> * where-    SomeInt  :: Int -> Some Int-    SomeChar :: Char -> Some Char-    Anything :: a -> Some a---unSome :: Some a -> a-unSome (SomeInt x) = x + 3-unSome (SomeChar c) = toLower c-unSome (Anything x) = x---newtype SomeC a =-    SomeC {-      runSomeC ::-          forall r.-          ((a ~ Int) => Int -> r) ->-          ((a ~ Char) => Char -> r) ->-          (a -> r) ->-          r-      }---- dependent types--idk :: forall (a :: *). a -> a-idk x = x-
− tests/examples/ghc710/RdrNames.hs 
@@ -1,149 +0,0 @@-{-# LANGUAGE ParallelListComp #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples #-}-module RdrNames where--import Data.Monoid---- -------------------------------------------------------------------------        |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))---                                            [mj AnnType $1,mj AnnVal $2] }---- Tested in DataFamilies.hs---- -------------------------------------------------------------------------        | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))---                                       [mo $1,mj AnnVal $2,mc $3] }-ff = (RdrNames.:::) 0 1----- -------------------------------------------------------------------------        | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))---                                       [mo $1,mj AnnVal $2,mc $3] }-data FF = ( :::  ) Int Int---- -------------------------------------------------------------------------        | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))---                                       [mj AnnBackquote $1,mj AnnVal $2---                                       ,mj AnnBackquote $3] }-data GG = GG Int Int-gg = 0 `  GG ` 1---- -------------------------------------------------------------------------        | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))---                                       [mj AnnBackquote $1,mj AnnVal $2---                                       ,mj AnnBackquote $3] }-vv = "a" ` mappend  ` "b"---- -------------------------------------------------------------------------        | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))---                                       [mj AnnBackquote $1,mj AnnVal $2---                                       ,mj AnnBackquote $3] }-vvq = "a" `  Data.Monoid.mappend ` "b"---- -------------------------------------------------------------------------        | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)---                                              [mo $1,mc $2] }--- Tested in Vect.hs---- -------------------------------------------------------------------------        | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)---                                              [mo $1,mc $2] }--- Tested in Vect.hs---- -------------------------------------------------------------------------        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon BoxedTuple---                                                        (snd $2 + 1)))---                                       (mo $1:mc $3:(mcommas (fst $2))) }-ng :: (, , ,) Int Int Int Int-ng = undefined---- -------------------------------------------------------------------------        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon UnboxedTuple---                                                        (snd $2 + 1)))---                                       (mo $1:mc $3:(mcommas (fst $2))) }--- Tested in Unboxed.hs---- -------------------------------------------------------------------------        | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)---                                       [mo $1,mj AnnRarrow $2,mc $3] }--ft :: (->) a b-ft = undefined--fp :: (   ->    ) a b-fp = undefined--type family F a :: * -> * -> *-type instance F Int = (->)-type instance F Char = ( ,  )---- -------------------------------------------------------------------------        | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mo $1,mc $2] }-lt :: [] a-lt = undefined---- -------------------------------------------------------------------------        | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }---- GHC source indicates this constuctor is only available in PrelPArr--- ltp :: [::] a--- ltp = undefined---- -------------------------------------------------------------------------        | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)---                                        [mo $1,mj AnnTildehsh $2,mc $3] }---- primitive type?--- Refl Int :: ~# * Int Int--- Refl Maybe :: ~# (* -> *) Maybe Maybe---- | A data constructor used to box up all unlifted equalities------ The type constructor is special in that GHC pretends that it--- has kind (? -> ? -> Fact) rather than (* -> * -> *)-data (~) a b = Eq# ((~#) a b)-data (  ~ ) a b = Eq# (( ~#  ) a b)--data Coercible a b = MkCoercible ((~#) a b)----- -------------------------------------------------------------------------        | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))---                                               [mo $1,mj AnnVal $2,mc $3] }--- TBD---- -------------------------------------------------------------------------        | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)---                                               [mo $1,mj AnnTilde $2,mc $3] }---- ------------------------------------------------------------------------- tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))---                                        [mj AnnBackquote $1,mj AnnVal $2---                                        ,mj AnnBackquote $3] }---- ------------------------------------------------------------------------{- From #haskell-emacs-gracjan> did you know that this is legal haskell:-<gracjan> (+ 1) ` fmap {- -} ` [1,2,3]--}-xxx = (+ 1) ` fmap {- -} ` [1,2,3]
− tests/examples/ghc710/RebindableSyntax.hs 
@@ -1,60 +0,0 @@-{-# LANGUAGE RebindableSyntax, NoMonomorphismRestriction #-}---- From https://ocharles.org.uk/blog/guest-posts/2014-12-06-rebindable-syntax.html--import Prelude hiding ((>>), (>>=), return)-import Data.Monoid-import Control.Monad ((<=<))-import Data.Map as M--addNumbers = do-  80-  60-  10-  where (>>) = (+)-        return = return--(>>) = mappend-return = mempty---- We can perform the same computation as above using the Sum wrapper:--someSum :: Sum Int-someSum = do-    Sum 80-    Sum 60-    Sum 10-    return--someProduct :: Product Int-someProduct = do-    Product 10-    Product 30---- Why not try something non-numeric?--tummyMuscle :: String-tummyMuscle = do-    "a"-    "b"---ff = let-  (>>)    = flip (.)-  return  = id--  arithmetic = do-      (+1)-      (*100)-      (/300)-      return--  -- Here, the input is numeric and all functions operate on a number.-  -- What if we want to take a list and output a string? No problem:--  check = do-      sum-      sqrt-      floor-      show-  in 4
− tests/examples/ghc710/RecordSemi.hs 
@@ -1,15 +0,0 @@--- | Generate a generate statement for the builtin function "fst"-genFst :: BuiltinBuilder-genFst = genNoInsts genFst'-genFst' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [(Either CoreSyn.CoreExpr AST.Expr, Type.Type)] -> TranslatorSession [AST.ConcSm]-genFst' res f args@[(arg,argType)] = do {-  ; arg_htype <- MonadState.lift tsType $ mkHType "\nGenerate.genFst: Invalid argument type" argType-  ; [AST.PrimName argExpr] <- argsToVHDLExprs [arg]-  ; let {-        ; labels      = getFieldLabels arg_htype 0-        ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argExpr (labels!!0)-        ; assign      = mkUncondAssign res argexprA-        } ;-    -- Return the generate functions-  ; return [assign]-  }
− tests/examples/ghc710/RecordUpdate.hs 
@@ -1,6 +0,0 @@--data Foo = F { f1 :: Int, f2 :: String }--foo :: Int -> Foo -> Foo-foo v f = f { f1 = v }-
− tests/examples/ghc710/RecordWildcard.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE RecordWildCards #-}---parseArgs =-  Args-        { equalProb = E `elem` opts-        , ..-        }
− tests/examples/ghc710/RecursiveDo.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE RecursiveDo #-}--- From https://ocharles.org.uk/blog/posts/2014-12-09-recursive-do.html--import Control.Monad.Fix--data RoseTree a = RoseTree a [RoseTree a]-  deriving (Show)--exampleTree :: RoseTree Int-exampleTree = RoseTree 5 [RoseTree 4 [], RoseTree 6 []]--pureMax :: Ord a => RoseTree a -> RoseTree (a, a)-pureMax tree =-  let (t, largest) = go largest tree-  in t- where-  go :: Ord a => a -> RoseTree a -> (RoseTree (a, a), a)-  go biggest (RoseTree x []) = (RoseTree (x, biggest) [], x)-  go biggest (RoseTree x xs) =-      let sub = map (go biggest) xs-          (xs', largests) = unzip sub-      in (RoseTree (x, biggest) xs', max x (maximum largests))--t = pureMax exampleTree---- -----------------------------------------------------------------------impureMin :: (MonadFix m, Ord b) => (a -> m b) -> RoseTree a -> m (RoseTree (a, b))-impureMin f tree = do-  rec (t, largest) <- go largest tree-  return t- where-  go smallest (RoseTree x []) = do-    b <- f x-    return (RoseTree (x, smallest) [], b)--  go smallest (RoseTree x xs) = do-    sub <- mapM (go smallest) xs-    b <- f x-    let (xs', bs) = unzip sub-    return (RoseTree (x, smallest) xs', min b (minimum bs))--budget :: String -> IO Int-budget "Ada"      = return 10 -- A struggling startup programmer-budget "Curry"    = return 50 -- A big-earner in finance-budget "Dijkstra" = return 20 -- Teaching is the real reward-budget "Howard"   = return 5  -- An frugile undergraduate!--inviteTree = RoseTree "Ada" [ RoseTree "Dijkstra" []-                            , RoseTree "Curry" [ RoseTree "Howard" []]-                            ]--ti = impureMin budget inviteTree--simplemdo = mdo-  return 5-
− tests/examples/ghc710/RedundantDo.hs 
@@ -1,4 +0,0 @@-foo =-  case x of-    True -> foo-    False -> foo
− tests/examples/ghc710/Remorse.hs 
@@ -1,88 +0,0 @@-import Prelude as P;import Data.Char as C;import Data.List;import System.Environment as S;-main = do- (.--.)<-(--.|.--.+);(.-)<-(--.|.-+)- case (.-) of ["+",(.-)]->(-|---|--+) (.-);["-",(.-)]->(..-.|.-.|--+) (.-);_->(.|.-.)("Usage: "++(.--.)++" (+/-) F.hs")- where- (-|---|--+) (.-)=do (..-.)<-(.-.|..-.+) (.-);(.--.|...+)(((-.-.|--+) (.--).(--.).(-..-))(..-.))- (..-.|.-.|--+) (.-)=do (..-.)<-(.-.|..-.+) (.-);(.--.|...+)(((-.-.|--+) (.--|=).(--.|=).(-..-))(..-.))---- | (--| ): (-.-.|---|-.|...-|.|.-.|-) (-.-.|....|.-|.-.) -> (--|---|.-.|...|.)-_--| 'a'=".-";_--| 'b'="-...";_--| 'c'="-.-.";_--| 'd'= "-..";_--| 'e'=".";-_--| 'f'="..-.";_--| 'g'="--.";_--| 'h'="....";_--| 'i'="..";_--| 'j'=".---";-_--| 'k'="-.-";_--| 'l'=".-..";_--| 'm'="--";_--| 'n'="-.";_--| 'o'="---";-_--| 'p'=".--.";_--| 'q'="--.-";_--| 'r'=".-.";_--| 's'="...";_--| 't'="-";-_--| 'u'="..-";_--| 'v'="...-";_--| 'w'=".--";_--| 'x'="-..-";_--| 'y'="-.--";-_--| 'z'="--..";_--| '0'="-----";_--| '1'=".----";_--| '2'="..---";-_--| '3'="...--";_--| '4'="....-";_--| '5'=".....";_--| '6'="-....";-_--| '7'="--...";_--| '8'="---..";_--| '9'="----.";_--| '_'="!";_--| '\''="=";-_--| (-.-.)- |'A'<=(-.-.)&&(-.-.)<='Z'=(()--| (-|.-..+) (-.-.))++"+"- |(-..|.|..-.)=[(-.-.)]---- | (--|=): (..|-.|...-) of (--| )-(--|=) (...)=(..-.)[(-.-.)|(-.-.)<-['a'..'z']++['0'..'9']++['A'..'Z']++['_','\''],()--| (-.-.)==(...)]- where (..-.)[]=(....|-..) (...);(..-.) (-.-.|...)=(....|-..) (-.-.|...)---- | (.--): (-.-.|---|-.|...-|.|.-.|-) (.--|---|.-.|-..)-(.--) (...)- |(...).|.-..["e","i","m","o","t"]=(.--)((...)++" ") -- (...|---|--|.) (..-|-.|-|..|-..|-.--) (.|-..-|-.-.|.|.--.|-|..|---|-.|...):- -- .=(-.-.|---|--|.--.|---|...|..|-|..|---|-.), ..=(-.|..-|--|.|.-.|..|-.-.) (.-.|.-|-.|--.|.), --/---=(.|-.|-..)-of-(.-..|..|-.|.) (-.-.|---|--|--|.|-.|-), -=(...|..-|-...|-|.-.|.-|-.-.|-|..|---|-.)- |(...).|.-..(-.-|.|-.--|...)=(...)- |(..|-..) (...)=(('(':).(++")").(-.-.|-.-.).(..|.--.) "|".(--|.--.)((--| )()))(...)- |(..|-.|..-.|-..-) (...)=((-|.-..).(..|-).(.--).(-|.-..).(..|-))(...)- |(-..|.|..-.)=(...)- where- (..|-..)((-..-):_)=(..|.-..+) (-..-)||(-..-)=='_'- (..|-.|..-.|-..-)((-..-):_)=(-..-)=='`'---- | (.--|=): do (..|-.|...-) of (.--)-(.--|=) (...)- |(...)=="|"="|"- |(..|-..) (...)=((--|.--.) (--|=).(-.-.|....|.-.|...).(-|.-..).(..|-))(...)- |(---|-.|.) (...)='`':((--|=).(..|-))(...):"`"- |(..|-.|..-.|-..-) (...)='`':((--|.--.) (--|=).(-.-.|....|.-.|...))(...)++"`"- |(-..|.|..-.)=(...)- where- (..|-..)('(':(....):(-| ))=(.--.|.-.|.) (....)&&(.-..|.-) (-| )==')'&&(.-|.-..)(??)((..|-) (-| ))- (..|-..) _=False- (.--.|.-.|.) (-.-.)=(-.-.).|.-..".-"- (..|-.|..-.|-..-) (...)=(.--.|.-.|.) ((....|-..) (...))&&(.-|.-..)(??)((-|.-..) (...))&&(.-|-.)(=='|')(...)- (---|-.|.) (...)=(.-|.-..) (.--.|.-.|.) ((..|-) (...))&&(.-..|.-) (...)=='|'- (-.-.|....|.-.|...) (...)=case (-..|.--+)(=='|')(...) of []->[];(...)->let ((.--),(...|...))=(-...|.-.)(=='|')(...) in (.--):(-.-.|....|.-.|...) (...|...)---- | (.--.|.-.|.|-..) (---|-.) (-.-.|....|.-|.-.|...)-(??)(-.-.)=(-.-.).|.-..".-+/=!|"---- | (.-..|.|-..-) (...|.-.|-.-.) -> (-|---|-.-) (...|-|.-.|.|.-|--)-(-..-)[]=[]-(-..-)((-.-.):(...))|(..|...+) (-.-.)=((-.-.):(...|...)):(-..-) (.-.|--) where ((...|...),(.-.|--))=(...|.--.) (..|...+) (...)-(-..-) (...)=(-|---|-.-):(-..-) (.-.|--) where ((-|---|-.-),(.-.|--))=(....|-..)((.--.|.-..|.|-..-) (...))---- | (--.): (--.|.-..|..-|.) (...|.|--.-) (-|---|-.-|...) -> (...|..|-.|--.|.-..|.) (-|---|-.-)-(--.)((--.-):".":(-.):(.-.|--))|(..|..-+)((....|-..) (--.-))=(--.)(((--.-)++"."++(-.)):(.-.|--))-(--.)("`":(.-.|--))=case (--.) (.-.|--) of ((--.-|-.):"`":(.-.|--))->("`"++(--.-|-.)++"`"):(--.) (.-.|--);_->("`":(.-.|--))-(--.)((...):(...|...))=(...):(--.) (...|...)-(--.)[]=[]---- | (--.|=): (.-..|..|-.-|.) (--.) in (.-.|.|...-)-(--.|=)("(":(-.):")":(.-.|--))|(.-|.-..)(??)(-.)=("("++(-.)++")"):(--.|=) (.-.|--)-(--.|=)("(":(-.):" ":")":(.-.|--))|(.-|.-..)(??)(-.)=("("++(-.)++")"):(--.|=) (.-.|--)-(--.|=)("|":(.-.|--))="|":(--.|=) (.-.|--)-(--.|=)((-.):(...|...):(.-.|--))|(.-|.-..)(.|.-..".-")((..|-) (-.))&&(.-..|.-) (-.)=='|'&&(.-|.-..) (..|...+) (...|...)=(-.):(--.|=) (.-.|--)-(--.|=)((-.):(.-.|--))=(-.):(--.|=) (.-.|--)-(--.|=)[]=[]---- | (....|.-|...|-.-|.|.-..|.-..) (-.-|.|-.--|.--|---|.-.|-..|...)-(-.-|.|-.--|...)=- ["case","class","data","default","deriving","do","else"- ,"if","import","in","infix","infixl","infixr","instance","let","module"- ,"newtype","of","then","type","where","_","main","foreign","ccall","as"]---- | (.-|-...|-...|.-.|.|...-) (.-..|..|-...) (..-.|-.|...)-(-.-.|-.-.)=P.concat;(.|.-..) (-..-)=P.elem (-..-);(--|.--.)=P.map;(-.-.|--+)=P.concatMap;-(...|.--.)=P.span;(-...|.-.)=P.break;(..|.--.)=intersperse;(-..|.--+)=P.dropWhile;-(....|-..)=P.head;(-|.-..)=P.tail;(..|-)=P.init;(.-..|.-)=P.last;-(-|.-..+)=C.toLower;(..|.-..+)=C.isLower;(..|...+)=C.isSpace;(..|..-+)=C.isUpper;-(.-.|..-.+)=P.readFile;(.--.|...+)=P.putStr;(.|.-.)=P.error;-(--.|.-+)=S.getArgs;(--.|.--.+)=S.getProgName;-(.-|.-..)=P.all;(.-|-.)=P.any;(-..|.|..-.)=P.otherwise;(.--.|.-..|.|-..-)=P.lex;
− tests/examples/ghc710/Roles.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE RoleAnnotations, PolyKinds #-}--module Roles where--data T1 a = K1 a-data T2 a = K2 a-data T3 (a :: k) = K3-data T4 (a :: * -> *) b = K4 (a b)--data T5 a = K5 a-data T6 a = K6-data T7 a b = K7 b--type role T1 nominal-type role T2 representational-type role T3 phantom-type role T4 nominal _-type role T5 _
− tests/examples/ghc710/Rules.hs 
@@ -1,39 +0,0 @@-module Rules where--import Data.Char--{-# RULES "map-loop" [ ~  ]  forall f . map' f = map' (id . f) #-}--{-# NOINLINE map' #-}-map' f [] = []-map' f (x:xs) = f x : map' f xs--main = print (map' toUpper "Hello, World")---- Should warn-foo1 x = x-{-# RULES "foo1" [ 1] forall x. foo1 x = x #-}---- Should warn-foo2 x = x-{-# INLINE foo2 #-}-{-# RULES "foo2" [~ 1 ] forall x. foo2 x = x #-}---- Should not warn-foo3 x = x-{-# NOINLINE foo3 #-}-{-# RULES "foo3" forall x. foo3 x = x #-}--{-# NOINLINE f #-}-f :: Int -> String-f x = "NOT FIRED"--{-# NOINLINE neg #-}-neg :: Int -> Int-neg = negate--{-# RULES-     "f" forall (c::Char->Int) (x::Char). f (c x) = "RULE FIRED"- #-}--
− tests/examples/ghc710/RulesSemi.hs 
@@ -1,9 +0,0 @@--{-# RULES-  "cFloatConv/Float->Float"    forall (x::Float).  cFloatConv x = x;-  "cFloatConv/Double->Double"  forall (x::Double). cFloatConv x = x;-  "cFloatConv/Float->CFloat"   forall (x::Float).  cFloatConv x = CFloat x;-  "cFloatConv/CFloat->Float"   forall (x::Float).  cFloatConv CFloat x = x;-  "cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x;-  "cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x- #-};
− tests/examples/ghc710/ScopedTypeVariables.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- from https://ocharles.org.uk/blog/guest-posts/2014-12-20-scoped-type-variables.html--import qualified Data.Map as Map--insertMany ::  forall k v . Ord k => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v-insertMany f vs m = foldr f1 m vs-  where-    f1 :: (k, v) -> Map.Map k v -> Map.Map k v-    f1 (k,v) m = Map.insertWith f k v m
− tests/examples/ghc710/SemiInstance.hs 
@@ -1,11 +0,0 @@--instance ArrowTransformer (AbortT v) where {-  lift = AbortT . (>>> arr Right);-  tmap f = AbortT . f . unwrapAbortT;-};--instance MakeValueTuple Float  where type ValueTuple Float  = Value Float  ; valueTupleOf = valueOf--instance Foo where {-  type ListElement Zero (a,r) = a;-}
− tests/examples/ghc710/SemiWorkout.hs 
@@ -1,60 +0,0 @@-{-# LANGUAGE KindSignatures-           , GADTs-           , ScopedTypeVariables-           , PatternSignatures-           , MultiParamTypeClasses-           , FunctionalDependencies-           , FlexibleInstances-           , UndecidableInstances-           , TypeFamilies-           , FlexibleContexts-           #-}--instance forall init prog prog' fromO fromI progOut progIn-                sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem-                keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem current current' invertedSessionsMe invertedSessionsThem .-    ( ProgramToMVarsOutgoingT prog prog ~ progOut-    , ProgramToMVarsOutgoingT prog' prog' ~ progIn-    , SWellFormedConfig init (D0 E) prog-    , SWellFormedConfig init (D0 E) prog'-    , TyListIndex progOut init (MVar (ProgramCell (Cell fromO)))-    , TyListIndex progIn init (MVar (ProgramCell (Cell fromI)))-    , TyListIndex prog init current'-    , Expand prog current' current-    , MapLookup (TyMap sessionsToIdxMe idxsToPairStructsMe) init-                    (MVar (Map (RawPid, RawPid) (MVar (PairStruct init prog prog' ((Cons (Jump init) Nil), (Cons (Jump init) Nil), (Cons (Jump init) Nil))))))-    , TyListMember invertedSessionsThem init True-    , MapSize (TyMap keyToIdxMe idxToValueMe) idxOfThem-    , MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfThem-                    (SessionState prog prog' (current, fromO, fromI)) (TyMap keyToIdxMe' idxToValueMe')-    ) =>-    CreateSession False init prog prog'-                  sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem-                  keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem where-                      createSession init FF (Pid remotePid _) =-                          InterleavedChain $-                              \ipid@(IPid (Pid localPid localSTMap) _) mp ->-                                  do { let pidFuncMapMVar :: MVar (Map (RawPid, RawPid)-                                                                       (MVar (PairStruct init prog prog'-                                                                              ((Cons (Jump init) Nil), (Cons (Jump init) Nil), (Cons (Jump init) Nil)))))-                                               = mapLookup localSTMap init-                                     ; pidFuncMap <- takeMVar pidFuncMapMVar-                                     ; emptyMVar :: MVar (TyMap keyToIdxMe' idxToValueMe') <- newEmptyMVar-                                     ; psMVar :: MVar (PairStruct init prog prog' ((Cons (Jump init) Nil), (Cons (Jump init) Nil), (Cons (Jump init) Nil)))-                                              <- case Map.lookup (localPid, remotePid) pidFuncMap of-                                                   Nothing-                                                       -> do { empty <- newEmptyMVar-                                                             ; putMVar pidFuncMapMVar (Map.insert (localPid, remotePid) empty pidFuncMap)-                                                             ; return empty-                                                             }-                                                   (Just mv)-                                                       -> do { putMVar pidFuncMapMVar pidFuncMap-                                                             ; return mv-                                                             }-                                     ; let idxOfThem :: idxOfThem = mapSize mp-                                           ps :: PairStruct init prog prog' ((Cons (Jump init) Nil), (Cons (Jump init) Nil), (Cons (Jump init) Nil))-                                              = PS localPid (f idxOfThem mp emptyMVar)-                                     ; putMVar psMVar ps-                                     ; mp' <- takeMVar emptyMVar-                                     ; return (idxOfThem, mp', ipid)-                                     }
− tests/examples/ghc710/Shebang.hs 
@@ -1,5 +0,0 @@-#!/usr/bin/env runhaskell-{-# LANGUAGE OverloadedStrings #-}-import Aws.SSSP.App--main = web
− tests/examples/ghc710/ShiftingLambda.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-}-spec :: Spec-spec = do-  describe "split4'8" $ do-    it "0xabc" $ do-      split4'8 0xabc `shouldBe` (0x0a, 0xbc)-    it "0xfff" $ do-      split4'8 0xfff `shouldBe` (0x0f, 0xff)--    describe "(x, y) = split4'8 z" $ do-      prop "x <= 0x0f" $-        \z -> let (x, _) =  split4'8 z in x <= 0x0f-      prop "x << 8 | y == z" $ do-        \z -> let (x, y) = split4'8 z in-          fromIntegral x `shiftL` 8 .|. fromIntegral y == z--match s@Status{ pos, flips, captureAt, captureLen }-  | isOne ?pat = ite (pos .>= strLen) __FAIL__ one-  | otherwise = ite (pos + (toEnum $ minLen ?pat) .> strLen) __FAIL__ $ case ?pat of-    POr ps -> choice flips $ map (\p -> \b -> let ?pat = p in match s{ flips = b }) ps--foo = 1
− tests/examples/ghc710/Sigs.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}--module Sigs where---- TypeSig-f :: Num a => a -> a-f = undefined--pattern Single :: () => (Show a) => a -> [a]-pattern Single x = [x]--g :: (Show a) => [a] -> a-g (Single x) = x---- Fixities--infixr  6 +++-infixr  7 ***,///--(+++) :: Int -> Int -> Int-a +++ b = a + 2*b--(***) :: Int -> Int -> Int-a *** b = a - 4*b--(///) :: Int -> Int -> Int-a /// b = 2*a - 3*b---- Inline signatures--{-# Inline g #-}-{-# INLINE [~34] f #-}---- Specialise signature---- Multiple sigs-x,y,z :: Int-x = 0-y = 0-z = 0
− tests/examples/ghc710/Simple.hs 
@@ -1,12 +0,0 @@---- blah-x :: (Int)-x = 1--(y) = 1--z :: t-z = do-  let-    a = 1-  return a
− tests/examples/ghc710/SimpleComplexTuple.hs 
@@ -1,3 +0,0 @@---foo ((-),(.))= (5,6)
− tests/examples/ghc710/SimpleDo.hs 
@@ -1,4 +0,0 @@--foo = do-  let    x = 1 -- a comment-  return x
− tests/examples/ghc710/SlidingDataClassDecl.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE TypeSynonymInstances       #-}---instance HasTrie R2Basis where-    data R2Basis :->: x = R2Trie x x-    trie f = R2Trie (f XB) (f YB)-    untrie (R2Trie x _y) XB = x-    untrie (R2Trie _x y) YB = y-    enumerate (R2Trie x y)  = [(XB,x),(YB,y)]
− tests/examples/ghc710/SlidingDoClause.hs 
@@ -1,13 +0,0 @@----- :bounds narrowing 35-bndCom tenv args =-  do { (bound,size) <- getBounds fail args-     ; let get (s,m,ref) = do { n <- readRef ref; return(s++" = "++show n++ m)}-     ; if bound == ""-          then do { xs <- mapM get boundRef; warnM [Dl xs "\n"]}-          else case find (\ (nm,info,ref) -> nm==bound) boundRef of-                Just (_,_,ref) -> writeRef ref size-                Nothing -> fail ("Unknown bound '"++bound++"'")-     ; return tenv-     }
− tests/examples/ghc710/SlidingLambda.hs 
@@ -1,3 +0,0 @@-{-# LANGUAGE ImplicitParams #-}--foo = choice flips $ map (\p -> \b -> let ?pat = p in match s{ flips = b }) ps
− tests/examples/ghc710/SlidingListComp.hs 
@@ -1,8 +0,0 @@---foo =-  [concatMap (\(n, f) -> [findPath copts v >>= f (listArg "ghc" as) | v <- listArg n as]) [-                    ("project", Update.scanProject),-                    ("file", Update.scanFile),-                    ("path", Update.scanDirectory)],-                map (Update.scanCabal (listArg "ghc" as)) cabals]
− tests/examples/ghc710/SlidingRecordSetter.hs 
@@ -1,4 +0,0 @@--selfQualify mod rsets = let defs = Set.fromList (map rs_name rsets)-                        in map (descend (f defs))-                               (map (\RS{..} -> RS{rs_name = qualify mod rs_name, ..}) rsets)
− tests/examples/ghc710/SpacesSplice.hs 
@@ -1,3 +0,0 @@-{-# LANGUAGE TemplateHaskell            #-}--makeLenses '' PostscriptFont
− tests/examples/ghc710/Splice.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE TemplateHaskell, FlexibleInstances,-          MultiParamTypeClasses, TypeSynonymInstances #-}--module Splice where--import Language.Haskell.TH.Syntax-import Language.Haskell.TH--foo $( return $ VarP $ mkName "x" ) = x-bar $( [p| x |] ) = x--baz = [| \ $( return $ VarP $ mkName "x" ) -> $(dyn "x") |]---class Eq a => MyClass a-data Foo = Foo deriving Eq--instance MyClass Foo--data Bar = Bar-  deriving Eq--type Baz = Bar-instance MyClass Baz--data Quux a  = Quux a   deriving Eq-data Quux2 a = Quux2 a  deriving Eq-instance Eq a  => MyClass (Quux a)-instance Ord a => MyClass (Quux2 a)--class MyClass2 a b-instance MyClass2 Int Bool--makeLenses '' PostscriptFont--$(return [])--main = do-    putStrLn $(do { info <- reify ''MyClass; lift (pprint info) })-    print $(isInstance ''Eq [ConT ''Foo] >>= lift)-    print $(isInstance ''MyClass [ConT ''Foo] >>= lift)-    print $ not $(isInstance ''Show [ConT ''Foo] >>= lift)-    print $(isInstance ''MyClass [ConT ''Bar] >>= lift) -- this one-    print $(isInstance ''MyClass [ConT ''Baz] >>= lift)-    print $(isInstance ''MyClass [AppT (ConT ''Quux) (ConT ''Int)] >>= lift) --this one-    print $(isInstance ''MyClass [AppT (ConT ''Quux2) (ConT ''Int)] >>= lift) -- this one-    print $(isInstance ''MyClass2 [ConT ''Int, ConT ''Bool] >>= lift)-    print $(isInstance ''MyClass2 [ConT ''Bool, ConT ''Bool] >>= lift)-
− tests/examples/ghc710/SpliceSemi.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---$(makePredicates ''TheType) ; $(makePredicatesNot ''TheType)
− tests/examples/ghc710/StaticPointers.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE StaticPointers #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveDataTypeable #-}--module Main where--import GHC.StaticPtr-import GHC.Word-import GHC.Generics-import Data.Data-import Data.Binary-import Data.ByteString--fact :: Int -> Int-fact 0 = 1-fact n = n * fact (n - 1)--main = do-  let sptr :: StaticPtr (Int -> Int)-      sptr = static fact-  print $ staticPtrInfo sptr-  print $ deRefStaticPtr sptr 10---- -----------------------------------------------------------------------type StaticKey1 = Fingerprint---- Defined in GHC.Fingerprint.-data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64-  deriving (Generic, Typeable)--staticKey :: StaticPtr a -> StaticKey1-staticKey = undefined--
− tests/examples/ghc710/Stmts.hs 
@@ -1,26 +0,0 @@-module Stmts where---- Make sure we get all the semicolons in statements-;;;;  ;;-import Data.List-; ; ;-import Data.Maybe-   ; ;;-foo :: IO ()-foo = do-  do { ;;;; a }-  a-; ;;-bar :: IO ()-bar = do-  { ;  ;-    a ;;-    b-  }- ; ;;  ;-baz :: IO ()-baz = do { ;; s ; s ; ; s ;; }-;-a = undefined-b = undefined-s = undefined
− tests/examples/ghc710/StrangeTypeClass.hs 
@@ -1,18 +0,0 @@----instance-  (-  ) => Elms Z ix where-  data Elm Z ix = ElmZ !ix-  type Arg Z = Z-  getArg !(ElmZ _) = Z-  getIdx !(ElmZ ix) = ix-  {-# INLINE getArg #-}-  {-# INLINE getIdx #-}--foo :: (Eq a) => a-> Bool-foo = undefined--bar :: (   ) => a-> Bool-bar = undefined
− tests/examples/ghc710/Stream.hs 
@@ -1,156 +0,0 @@-module Stream (Stream, carry, addStream, rationalToStream,-                streamToFloat, addFiniteStream, negate', average) where--import Data.Ratio---type Digit = Integer-type Stream = [Integer]------ Convert from a Rational fraction to its stream representation-rationalToStream :: Rational -> Stream-rationalToStream x-        |t<1            = 0:rationalToStream t-        |otherwise      = 1:rationalToStream (t-1)-        where t = 2*x------- Convert from a stream to the Float value-streamToFloat :: Stream -> Float-streamToFloat x =  f x (1)--f :: Stream -> Integer -> Float-f [] n = 0-f (y:ys) n = (fromIntegral)y/(fromIntegral(2^n)) + f ys (n+1)-------- Add two stream-addStream :: Stream -> Stream -> Stream-addStream (x1:x2:x3:xs) (y1:y2:y3:ys) = (u+c):(addStream (x2:x3:xs) (y2:y3:ys))-                                where u = interim x1 x2 y1 y2-                                      c = carry x2 x3 y2 y3------ Compute carry, the C(i) value, given x(i) and y(i)-carry :: Digit -> Digit -> Digit -> Digit -> Digit-carry x1 x2 y1 y2-        |t>1                    =  1-        |t<(-1)                 = -1-        |t==1 && (minus1 x2 y2) =  0-        |t==1 && not (minus1 x2 y2) = 1-        |t==(-1) && (minus1 x2 y2) = -1-        |t==(-1) && not (minus1 x2 y2) = 0-        |t==0                           = 0-        where t = x1+y1------ Computer the interim sum, the U(i) value, given x(i), y(i) and c(i)-interim :: Digit -> Digit -> Digit -> Digit -> Digit-interim x1 x2 y1 y2-                |t>1                    =  0-                |t<(-1)                 = 0-                |t==1 && (minus1 x2 y2) =  1-                |t==1 && not (minus1 x2 y2) = -1-                |t==(-1) && (minus1 x2 y2) = 1-                |t==(-1) && not (minus1 x2 y2) = -1-                |t==0                           = 0-                where t = x1+y1------ Check if at least one of 2 digits is -1-minus1 :: Digit -> Digit -> Bool-minus1 x y = (x==(-1))|| (y==(-1))--------- Algin two stream so that they have the same length-align :: Stream -> Stream -> (Stream, Stream)-align xs ys-        |x>y            = (xs, (copy 0 (x-y)) ++ys)-        |otherwise      = ((copy 0 (y-x)) ++ xs, ys)-        where x = toInteger(length xs)-              y = toInteger(length ys)------ Generate a list of x-copy :: Integer -> Integer -> [Integer]-copy x n = [x| i<- [1..n]]---------- Add two finite stream (to add the integral part)-addFiniteStream :: Stream -> Stream -> Stream-addFiniteStream xs ys = add' u v-                        where (u,v) = align xs ys------ Utility function for addFinitieStream-add' :: Stream -> Stream -> Stream-add' u v = normalise (f u v)-       where f [] [] = []-             f (x:xs) (y:ys) = (x+y):f xs ys----- Normalise the sum-normalise :: Stream -> Stream-normalise = foldr f [0]-            where f x (y:ys) = (u:v:ys)-                              where u = (x+y) `div` 2-                                    v = (x+y) `mod` 2----- Negate a stream-negate' :: Stream -> Stream-negate' = map (*(-1))------ Compute average of two stream--- Using [-2,-1,0,1,2] to add, and then divide by 2-average :: Stream -> Stream -> Stream-average xs ys = div2 (add xs ys)----- Addition of two streams, using [-2,-1,0,1,2]-add :: Stream -> Stream -> Stream-add (x:xs) (y:ys) = (x+y):(add xs ys)----- Then divided by 2, [-2,-1,0,1,2] -> [-1,0,1]-div2 :: Stream -> Stream-div2 (2:xs)             = 1:div2 xs-div2 ((-2):xs)          = (-1):div2 xs-div2 (0:xs)             = 0:div2 xs-div2 (1:(-2):xs)        = div2 (0:0:xs)-div2 (1:(-1):xs)        = div2 (0:1:xs)-div2 (1:0:xs)           = div2 (0:2:xs)-div2 (1:1:xs)           = div2 (2:(-1):xs)-div2 (1:2:xs)           = div2 (2:0:xs)-div2 ((-1):(-2):xs)     = div2 ((-2):0:xs)-div2 ((-1):(-1):xs)     = div2 ((-2):1:xs)-div2 ((-1):0:xs)        = div2 (0:(-2):xs)-div2 ((-1):1:xs)        = div2 (0:(-1):xs)-div2 ((-1):2:xs)        = div2 (0:0:xs)----test = take 100 (average (rationalToStream (1%2)) (rationalToStream (1%3)))
− tests/examples/ghc710/StrictLet.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE MagicHash #-}--{--If the (unboxed, hence strict) "let thunk =" would survive to the CallArity-stage, it might yield wrong results (eta-expanding thunk and hence "cond" would-be called multiple times).--It does not actually happen (CallArity sees a "case"), so this test just-safe-guards against future changes here.--}--import Debug.Trace-import GHC.Exts-import System.Environment--cond :: Int# -> Bool-cond x = trace ("cond called with " ++ show (I# x)) True-{-# NOINLINE cond #-}---bar (I# x) =-    let go n = let x = thunk n-               in case n of-                    100# -> I# x-                    _    -> go (n +# 1#)-    in go x-  where thunk = if cond x then \x -> (x +# 1#) else \x -> (x -# 1#)---main = do-    args <- getArgs-    bar (length args) `seq` return ()
− tests/examples/ghc710/StringGap.hs 
@@ -1,8 +0,0 @@-module StringGap where---- based on https://www.reddit.com/r/haskelltil/comments/3duhdf/haskell_ignores_all_whitespace_enclosed_in/--foo = "lorem ipsum \-      \dolor sit amet"--bar = "lorem ipsum \     \dolor sit amet"
− tests/examples/ghc710/T10196.hs 
@@ -1,13 +0,0 @@-module T10196 where--data X = Xᵦ | Xᵤ | Xᵩ | Xᵢ | Xᵪ | Xᵣ--f :: Int-f =-  let xᵦ = 1-      xᵤ = xᵦ-      xᵩ = xᵤ-      xᵢ = xᵩ-      xᵪ = xᵢ-      xᵣ = xᵪ-  in xᵣ
− tests/examples/ghc710/T10942.hs 
@@ -1,6 +0,0 @@--- Let's trick you-{-# LANGUAGE ExplicitForAll #-}-module Test (foo) where--foo :: forall a. a -> a-foo x = x
− tests/examples/ghc710/T2388.hs 
@@ -1,14 +0,0 @@-module T2388 where--import Data.Bits-import Data.Word-import Data.Int--test1 :: Word32 -> Char-test1 w | w .&. 0x80000000 /= 0 = 'a'-test1 _ = 'b'---- this should use a testq instruction on x86_64-test2 :: Int64 -> Char-test2 w | w .&. (-3) /= 0 = 'a'-test2 _ = 'b'
− tests/examples/ghc710/T3132.hs 
@@ -1,6 +0,0 @@-module T3132 where--import Data.Array.Unboxed--step :: UArray Int Double -> [Double]-step y = [y!1 + y!0]
− tests/examples/ghc710/T5951.hs 
@@ -1,11 +0,0 @@-module T5951 where--class A a-class B b-class C c--instance-       A =>-       B =>-       C where-         foo = undefined
− tests/examples/ghc710/T7918A.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module T7918A where--import Language.Haskell.TH-import Language.Haskell.TH.Quote--qq = QuasiQuoter {-         quoteExp  = \str -> case str of-                                "e1" -> [| True |]-                                "e2" -> [| id True |]-                                "e3" -> [| True || False |]-                                "e4" -> [| False |]-       , quoteType = \str -> case str of-                                "t1" -> [t| Bool |]-                                "t2" -> [t| Maybe Bool |]-                                "t3" -> [t| Either Bool Int |]-                                "t4" -> [t| Int |]-       , quotePat  = let x = VarP (mkName "x")-                         y = VarP (mkName "y")-                     in \str -> case str of-                                  "p1" -> return $ x-                                  "p2" -> return $ ConP 'Just [x]-                                  "p3" -> return $ TupP [x, y]-                                  "p4" -> return $ y-       , quoteDec  = undefined-       }
− tests/examples/ghc710/TH.hs 
@@ -1,71 +0,0 @@-{-# Language TemplateHaskell #-}---- from https://ocharles.org.uk/blog/guest-posts/2014-12-22-template-haskell.html--import Language.Haskell.TH--e1 :: IO Exp-e1 = runQ [| 1 + 2 |]--e2 :: Integer-e2 = $( return (InfixE (Just (LitE (IntegerL 1)))-                       (VarE (mkName "+"))-                       (Just (LitE (IntegerL 2)))-               )-      )--fibs :: [Integer]-fibs = 0 : 1 : zipWith (+) fibs (tail fibs)--fibQ :: Int -> Q Exp-fibQ n = [| fibs !! n |]---- e3 gives stage restriction, need to import this module to get it--- e3 = $(fibQ 22)--e4 = $(runQ [| fibs !! $( [| 8 |]) |])--e5 :: IO Exp-e5 = runQ [| 1 + 2 |]--e6 :: IO [Dec]-e6 = runQ [d|x = 5|]--e7 :: IO Type-e7 = runQ [t|Int|]--e8 :: IO Pat-e8 = runQ [p|(x,y)|]--myExp :: Q Exp; myExp = runQ [| 1 + 2 |]--e9 = runQ(myExp) >>= putStrLn.pprint---- -----------------------------------------------------------------------isPrime :: (Integral a) => a -> Bool-isPrime k | k <=1 = False | otherwise = not $ elem 0 (map (mod k)[2..k-1])--nextPrime :: (Integral a) => a -> a-nextPrime n | isPrime n = n | otherwise = nextPrime (n+1)---- returns a list of all primes between n and m, using the nextPrime function-doPrime :: (Integral a) => a -> a -> [a]-doPrime n m-        | curr > m = []-        | otherwise = curr:doPrime (curr+1) m-        where curr = nextPrime n---- and our Q expression-primeQ :: Int -> Int -> Q Exp-primeQ n m = [| doPrime n m |]---- stage restriction on e10--- e10 = $(primeQ 0 67)---- -----------------------------------------------------------------------e11 = $(stringE . show =<< reify ''Bool)---- stage restriction e12--- e12 = $(stringE . show =<< reify 'primeQ)
− tests/examples/ghc710/THMonadInstance.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE-  TemplateHaskell,-  MultiParamTypeClasses,-  FunctionalDependencies,-  UndecidableInstances-  #-}---genCodingInstance :: (Data c, Data h) => TypeQ -> Name -> [(c, h)] -> Q [Dec]-genCodingInstance ht ctn chs = do-  let n = const Nothing-  [d|-    instance Monad m => EncodeM m $(ht) $(conT ctn) where-      encodeM h = return $ $(-        caseE [| h |] [ match (dataToPatQ n h) (normalB (dataToExpQ n c)) [] | (c,h) <- chs ]-       )--    instance Monad m => DecodeM m $(ht) $(conT ctn) where-      decodeM c = return $ $(-        caseE [| c |] [ match (dataToPatQ n c) (normalB (dataToExpQ n h)) [] | (c,h) <- chs ]-       )-   |]
− tests/examples/ghc710/TemplateHaskell.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}--foo = $footemplate--makeSplices ''Foo--old = $(old)--bar = $$bartemplate--bar = [e| quasi |]--bar = [| quasi |]--baz = [quoter| quasi |]--[t| Map.Map T.Text $tc |]--{-# ANN module $([| 1 :: Int |]) #-}--foo = [t| HT.HashTable $(varT s) Int-                   (Result $(varT str) $tt) |]--objc_emit--objc_import [""]---$(do-    return $ foreignDecl cName ("build" ++ a) ([[t| Ptr Builder |]] ++ ats ++ [[t| CString |]]) [t| Ptr $(rt) |]- )--foo = do-  let elemSize = [|sizeOf (undefined :: $(elemType))|]-      alignment _ = alignment (undefined :: $(elemType))-  return bar--class QQExp a b where-  qqExp x = [||fst $ runState $$(qqExpM x) ((0,M.empty) :: (Int,M.Map L.Name [L.Operand]))||]--class QQExp2 a b where-  qqExp x = [e||fst $ runState $$(qqExpM x) ((0,M.empty) :: (Int,M.Map L.Name [L.Operand]))||]
− tests/examples/ghc710/TransformListComp.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE TransformListComp #-}--oldest :: [Int] -> [String]-oldest tbl = [ "str"-             | n <- tbl-             , then id-             ]
− tests/examples/ghc710/Trit.hs 
@@ -1,112 +0,0 @@-module Trit (Trit, rationalToTrit, getIntegral, getFraction, getFraction',-                neg, addTrits, subTrits, shiftLeft, shiftRight, multiply-                ) where--import Stream-import Utilities-import Data.Ratio--type Mantissa = Stream-type Fraction = Stream-type Trit     = (Mantissa, Fraction)----- Convert from a Rational number to its Trit representation (Integral, Fraction)-rationalToTrit :: Rational -> Trit-rationalToTrit x-                |x<1            = ([0], rationalToStream x)-                |otherwise      = (u', rationalToStream v)-                where   u = n `div` d-                        u' = toBinary u-                        v = x - (toRational u)-                        n = numerator x-                        d = denominator x----- Get the integral part of Trit-getIntegral :: Trit -> Mantissa-getIntegral = fst------ Get the fraction part of Trit, with n digit of the stream-getFraction :: Int -> Trit -> Stream-getFraction n = take n. snd----- Get the fraction part of Trit-getFraction' :: Trit -> Stream-getFraction' = snd------ Negate a Trit-neg :: Trit -> Trit-neg (a, b) = (negate' a, negate' b)------ Add two Trits-addTrits :: Trit -> Trit -> Trit-addTrits (m1, (x1:x2:xs)) (m2, (y1:y2:ys)) = (u,addStream (x1:x2:xs) (y1:y2:ys))-                                           where u' = addFiniteStream m1 m2-                                                 c = [carry x1 x2 y1 y2]-                                                 u = addFiniteStream u' c------ Substraction of 2 Trits-subTrits :: Trit -> Trit -> Trit-subTrits x y = addTrits x (neg y)------ Shift left = *2 opertaion with Trit-shiftLeft :: Trit -> Trit-shiftLeft (x, (y:ys)) = (x++ [y], ys)----- Shift right = /2 operation with Trit-shiftRight :: Trit -> Integer -> Trit-shiftRight (x, xs) 1 = (init x, (u:xs))-                    where u = last x-shiftRight (x, xs) n = shiftRight (init x, (u:xs)) (n-1)-                    where u = last x------ Multiply a Trit stream by 1,0 or -1, simply return the stream-mulOneDigit :: Integer -> Stream -> Stream-mulOneDigit x xs-              |x==1      = xs-              |x==0      = zero'-              |otherwise = negate' xs-              where zero' = (0:zero')--------- Multiplication of two streams-multiply :: Stream -> Stream -> Stream-multiply (a0:a1:x) (b0:b1:y) = average p q-                               where p = average (a1*b0: (average (mulOneDigit b1 x)-                                                                 (mulOneDigit a1 y)))-                                                 (average (mulOneDigit b0 x)-                                                          (mulOneDigit a0 y))-                                     q = (a0*b0:a0*b1:a1*b1:(multiply x y))-----start0 = take 30 (multiply (rationalToStream (1%2)) zo)--zo :: Stream-zo = 1:(-1):zero-     where zero = 0:zero--start1 = take 30 (average (rationalToStream (1%2)) (negate' (rationalToStream (1%4))))---
− tests/examples/ghc710/Tuple.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE TupleSections #-}--baz = (1, "hello", 6.5,,) 'a' (Just ())-
− tests/examples/ghc710/TupleSections.hs 
@@ -1,21 +0,0 @@-{-# LANGUAGE TupleSections #-}--foo = do-  liftIO $ atomicModifyIORef ciTokens ((,()) . f)-  liftIO $ atomicModifyIORef ciTokens (((),) . f)-  liftIO $ atomicModifyIORef ciTokens ((,) . f)---- | Make bilateral dictionary from PoliMorf.-mkPoli :: [P.Entry] -> Poli-mkPoli = mkBila . map ((,,(),,()) <$> P.base <*> P.pos <*> P.form)--foo = baz-  where-    _1 = ((,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)-    _2 = ((Nothing,,Nothing,Nothing,Nothing,Nothing) . Just <$>)-    _3 = ((Nothing,Nothing,,Nothing,Nothing,Nothing) . Just <$>)-    _4 = ((Nothing,Nothing,Nothing,,Nothing,Nothing) . Just <$>)-    _5 = ((Nothing,Nothing,Nothing,Nothing,,Nothing) . Just <$>)-    _6 = ((Nothing,Nothing,Nothing,Nothing,Nothing,) . Just <$>)--foo = (,,(),,,())
− tests/examples/ghc710/TypeBrackets.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--foo (f :: (Maybe t -> Int)) =-     undefined--type (((f `ObjectsFUnder` a))) = ConstF f a :/\: f-type   (f `ObjectsFOver`  a)   = f :/\: ConstF f a--type (c `ObjectsUnder` a) = Id c `ObjectsFUnder` a-type (c `ObjectsOver`  a) = Id c `ObjectsFOver`  a-
− tests/examples/ghc710/TypeBrackets2.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleInstances #-}----- | The style and color attributes can either be the terminal defaults. Or be equivalent to the--- previously applied style. Or be a specific value.-data MaybeDefault v where-    Default :: MaybeDefault v-    KeepCurrent :: MaybeDefault v-    SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v-    SetTo2 :: (Eq a) => forall v . ( Eq v, Show v ) => !v -> a -> MaybeDefault v--bar :: forall v . (( Eq v, Show v ) => v -> MaybeDefault v -> a -> [a])-baz :: (Eq a) => forall v . ( Eq v, Show v ) => !v -> a -> MaybeDefault v--instance Dsp (S n) where-  data   (ASig (S n))   = S_A CVar-  data  ((KSig (S n)))  = S_K CVar-  data (((INum (S n)))) = S_I CVar-  getSr    = fst <$> ask-  getKsmps = snd <$> ask
− tests/examples/ghc710/TypeBrackets4.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}---type family ((a :: Bool) || (b :: Bool)) :: Bool-type instance 'True  || a = 'True-type instance a || 'True  = 'True-type instance 'False || a = a-type instance a || 'False = a
− tests/examples/ghc710/TypeFamilies2.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}--type family (++) (a :: [k]) (b :: [k]) :: [k] where-    '[]       ++ b = b-    (a ': as) ++ b = a ': (as ++ b)--type family F a :: * -> * -> *-type instance F Int = (->)-type instance F Char = ( ,  )
− tests/examples/ghc710/TypeInstance.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Trustworthy #-}--class TrieKey k where-  type instance TrieRep k = TrieRepDefault k
− tests/examples/ghc710/TypeOperators.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}---- From https://ocharles.org.uk/blog/posts/2014-12-08-type-operators.html--import Data.String--data I a = I { unI :: a }-data Var a x = Var { unK :: a }--infixr 8 +-data ((f + g)) a = InL (f a) | InR (g a)--- data (f + g) a = InL (f a) | InR (g a)--class sub :<: sup where-  inj :: sub a -> sup a--instance (sym :<: sym) where-  inj = id--instance (sym1 :<: (sym1 + sym2)) where inj = InL--instance (sym1 :<: sym3) => (sym1 :<: (sym2 + sym3)) where-  inj = InR . inj--instance (I :<: g, IsString s) => IsString ((f + g) s) where-  fromString = inj . I . fromString--var :: (Var a :<: f) => a -> f e-var = inj . Var--elim :: (I :<: f) => (a -> b) -> (Var a + f) b -> f b-elim eval f =-  case f of-    InL (Var xs) -> inj (I (eval xs))-    InR g        -> g------------------------------------------------------------------------------------data UserVar = UserName--data ChristmasVar = ChristmasPresent--email :: [(Var UserVar + Var ChristmasVar + I) String]-email = [ "Dear "-        , var UserName-        , ", thank you for your recent email to Santa & Santa Inc."-        , "You have asked for a: "-        , var ChristmasPresent-        ]--main :: IO ()-main =-  do name <- getLine-     present <- getLine-     putStrLn (concatMap (unI .-                          (elim (\ChristmasPresent -> present) .-                           elim (\UserName -> name)))-                         email)--{---*Main> main-Ollie-Lambda Necklace-Dear Ollie, thank you for your recent email to Santa & Santa Inc.You have asked for a: Lambda Necklace---}
− tests/examples/ghc710/TypeSignature.hs 
@@ -1,12 +0,0 @@-module TypeSignature where--{- Lifting baz to the top level should bring in xx and a as parameters,-   and update the signature to include these--}-foo a = (baz xx a)-  where-    xx :: Int -> Int -> Int-    xx p1 p2 = p1 + p2--baz :: (Int -> Int -> Int) -> Int ->Int-baz xx a = xx 1 a
− tests/examples/ghc710/TypeSignatureParens.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--pTokenCost :: forall loc state a .((Show a, Eq a,  loc `IsLocationUpdatedBy` a, LL.ListLike state a) => [a] -> Int -> P (Str  a state loc) [a])-pTokenCost as cost = 5--pTokenCostStr :: forall a .((Show a) => [a] -> Int -> String)-pTokenCostStr as cost = "5"
− tests/examples/ghc710/TypeSynOperator.hs 
@@ -1,3 +0,0 @@-{-# LANGUAGE TypeOperators #-}--type a :-> t = a
− tests/examples/ghc710/TypeSynParens.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--class Compilable a where-   type CompileResult a :: *--instance Compilable a => Compilable [a] where-   type CompileResult [a] = [CompileResult a]--instance Compilable a => Compilable (Maybe a) where-   type CompileResult (Maybe a) = Maybe (CompileResult a)--instance Compilable InterpreterStmt where-   type CompileResult InterpreterStmt = [Hask.Stmt]--instance Compilable ModuleSpan where-   type ((CompileResult ModuleSpan)) = Hask.Module--instance Compilable StatementSpan where-   type (CompileResult StatementSpan) = [Stmt]
− tests/examples/ghc710/Unboxed.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}-module Layout.Unboxed where--f1 :: (Num a1, Num a) => a -> a1 -> (# , #) a a1-f1 x y = (# , #) (x+1) (y-1)--f2 x y z  = (# ,, #) x y z
− tests/examples/ghc710/Undefined10.hs 
@@ -1,643 +0,0 @@-{--    Copyright 2013-2015 Mario Blazevic--    License: BSD3 (see BSD3-LICENSE.txt file)--}---- | This module defines the 'FactorialMonoid' class and some of its instances.-----{-# LANGUAGE Haskell2010, Trustworthy #-}--module Data.Monoid.Factorial (-   -- * Classes-   FactorialMonoid(..), StableFactorialMonoid,-   -- * Monad function equivalents-   mapM, mapM_-   )-where--import Prelude hiding (break, drop, dropWhile, foldl, foldMap, foldr, last, length, map, mapM, mapM_, max, min,-                       null, reverse, span, splitAt, take, takeWhile)--import Control.Arrow (first)-import qualified Control.Monad as Monad-import Data.Monoid (Monoid (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo))-import qualified Data.Foldable as Foldable-import qualified Data.List as List-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Lazy as LazyByteString-import qualified Data.Text as Text-import qualified Data.Text.Lazy as LazyText-import qualified Data.IntMap as IntMap-import qualified Data.IntSet as IntSet-import qualified Data.Map as Map-import qualified Data.Sequence as Sequence-import qualified Data.Set as Set-import qualified Data.Vector as Vector-import Data.Int (Int64)-import Data.Numbers.Primes (primeFactors)--import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)---- | Class of monoids that can be split into irreducible (/i.e./, atomic or prime) 'factors' in a unique way. Factors of--- a 'Product' are literally its prime factors:------ prop> factors (Product 12) == [Product 2, Product 2, Product 3]------ Factors of a list are /not/ its elements but all its single-item sublists:------ prop> factors "abc" == ["a", "b", "c"]------ The methods of this class satisfy the following laws:------ > mconcat . factors == id--- > null == List.null . factors--- > List.all (\prime-> factors prime == [prime]) . factors--- > factors == unfoldr splitPrimePrefix == List.reverse . unfoldr (fmap swap . splitPrimeSuffix)--- > reverse == mconcat . List.reverse . factors--- > primePrefix == maybe mempty fst . splitPrimePrefix--- > primeSuffix == maybe mempty snd . splitPrimeSuffix--- > inits == List.map mconcat . List.tails . factors--- > tails == List.map mconcat . List.tails . factors--- > foldl f a == List.foldl f a . factors--- > foldl' f a == List.foldl' f a . factors--- > foldr f a == List.foldr f a . factors--- > span p m == (mconcat l, mconcat r) where (l, r) = List.span p (factors m)--- > List.all (List.all (not . pred) . factors) . split pred--- > mconcat . intersperse prime . split (== prime) == id--- > splitAt i m == (mconcat l, mconcat r) where (l, r) = List.splitAt i (factors m)--- > spanMaybe () (const $ bool Nothing (Maybe ()) . p) m == (takeWhile p m, dropWhile p m, ())--- > spanMaybe s0 (\s m-> Just $ f s m) m0 == (m0, mempty, foldl f s0 m0)--- > let (prefix, suffix, s') = spanMaybe s f m--- >     foldMaybe = foldl g (Just s)--- >     g s m = s >>= flip f m--- > in all ((Nothing ==) . foldMaybe) (inits prefix)--- >    && prefix == last (filter (isJust . foldMaybe) $ inits m)--- >    && Just s' == foldMaybe prefix--- >    && m == prefix <> suffix------ A minimal instance definition must implement 'factors' or 'splitPrimePrefix'. Other methods are provided and should--- be implemented only for performance reasons.-class MonoidNull m => FactorialMonoid m where-   -- | Returns a list of all prime factors; inverse of mconcat.-   factors :: m -> [m]-   -- | The prime prefix, 'mempty' if none.-   primePrefix :: m -> m-   -- | The prime suffix, 'mempty' if none.-   primeSuffix :: m -> m-   -- | Splits the argument into its prime prefix and the remaining suffix. Returns 'Nothing' for 'mempty'.-   splitPrimePrefix :: m -> Maybe (m, m)-   -- | Splits the argument into its prime suffix and the remaining prefix. Returns 'Nothing' for 'mempty'.-   splitPrimeSuffix :: m -> Maybe (m, m)-   -- | Returns the list of all prefixes of the argument, 'mempty' first.-   inits :: m -> [m]-   -- | Returns the list of all suffixes of the argument, 'mempty' last.-   tails :: m -> [m]-   -- | Like 'List.foldl' from "Data.List" on the list of 'primes'.-   foldl :: (a -> m -> a) -> a -> m -> a-   -- | Like 'List.foldl'' from "Data.List" on the list of 'primes'.-   foldl' :: (a -> m -> a) -> a -> m -> a-   -- | Like 'List.foldr' from "Data.List" on the list of 'primes'.-   foldr :: (m -> a -> a) -> a -> m -> a-   -- | The 'length' of the list of 'primes'.-   length :: m -> Int-   -- | Generalizes 'foldMap' from "Data.Foldable", except the function arguments are prime factors rather than the-   -- structure elements.-   foldMap :: Monoid n => (m -> n) -> m -> n-   -- | Like 'List.span' from "Data.List" on the list of 'primes'.-   span :: (m -> Bool) -> m -> (m, m)-   -- | Equivalent to 'List.break' from "Data.List".-   break :: (m -> Bool) -> m -> (m, m)-   -- | Splits the monoid into components delimited by prime separators satisfying the given predicate. The primes-   -- satisfying the predicate are not a part of the result.-   split :: (m -> Bool) -> m -> [m]-   -- | Equivalent to 'List.takeWhile' from "Data.List".-   takeWhile :: (m -> Bool) -> m -> m-   -- | Equivalent to 'List.dropWhile' from "Data.List".-   dropWhile :: (m -> Bool) -> m -> m-   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.-   spanMaybe :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)-   -- | Strict version of 'spanMaybe'.-   spanMaybe' :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)-   -- | Like 'List.splitAt' from "Data.List" on the list of 'primes'.-   splitAt :: Int -> m -> (m, m)-   -- | Equivalent to 'List.drop' from "Data.List".-   drop :: Int -> m -> m-   -- | Equivalent to 'List.take' from "Data.List".-   take :: Int -> m -> m-   -- | Equivalent to 'List.reverse' from "Data.List".-   reverse :: m -> m--   factors = List.unfoldr splitPrimePrefix-   primePrefix = maybe mempty fst . splitPrimePrefix-   primeSuffix = maybe mempty snd . splitPrimeSuffix-   splitPrimePrefix x = case factors x-                        of [] -> Nothing-                           prefix : rest -> Just (prefix, mconcat rest)-   splitPrimeSuffix x = case factors x-                        of [] -> Nothing-                           fs -> Just (mconcat (List.init fs), List.last fs)-   inits = foldr (\m l-> mempty : List.map (mappend m) l) [mempty]-   tails m = m : maybe [] (tails . snd) (splitPrimePrefix m)-   foldl f f0 = List.foldl f f0 . factors-   foldl' f f0 = List.foldl' f f0 . factors-   foldr f f0 = List.foldr f f0 . factors-   length = List.length . factors-   foldMap f = foldr (mappend . f) mempty-   span p m0 = spanAfter id m0-      where spanAfter f m = case splitPrimePrefix m-                            of Just (prime, rest) | p prime -> spanAfter (f . mappend prime) rest-                               _ -> (f mempty, m)-   break = span . (not .)-   spanMaybe s0 f m0 = spanAfter id s0 m0-      where spanAfter g s m = case splitPrimePrefix m-                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest-                                                    | otherwise -> (g mempty, m, s)-                                 Nothing -> (m0, m, s)-   spanMaybe' s0 f m0 = spanAfter id s0 m0-      where spanAfter g s m = seq s $-                              case splitPrimePrefix m-                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest-                                                    | otherwise -> (g mempty, m, s)-                                 Nothing -> (m0, m, s)-   split p m = prefix : splitRest-      where (prefix, rest) = break p m-            splitRest = case splitPrimePrefix rest-                        of Nothing -> []-                           Just (_, tl) -> split p tl-   takeWhile p = fst . span p-   dropWhile p = snd . span p-   splitAt n0 m0 | n0 <= 0 = (mempty, m0)-                 | otherwise = split' n0 id m0-      where split' 0 f m = (f mempty, m)-            split' n f m = case splitPrimePrefix m-                           of Nothing -> (f mempty, m)-                              Just (prime, rest) -> split' (pred n) (f . mappend prime) rest-   drop n p = snd (splitAt n p)-   take n p = fst (splitAt n p)-   reverse = mconcat . List.reverse . factors-   {-# MINIMAL factors | splitPrimePrefix #-}---- | A subclass of 'FactorialMonoid' whose instances satisfy this additional law:------ > factors (a <> b) == factors a <> factors b-class (FactorialMonoid m, PositiveMonoid m) => StableFactorialMonoid m--instance FactorialMonoid () where-   factors () = []-   primePrefix () = ()-   primeSuffix () = ()-   splitPrimePrefix () = Nothing-   splitPrimeSuffix () = Nothing-   length () = 0-   reverse = id--instance FactorialMonoid a => FactorialMonoid (Dual a) where-   factors (Dual a) = fmap Dual (reverse $ factors a)-   length (Dual a) = length a-   primePrefix (Dual a) = Dual (primeSuffix a)-   primeSuffix (Dual a) = Dual (primePrefix a)-   splitPrimePrefix (Dual a) = case splitPrimeSuffix a-                               of Nothing -> Nothing-                                  Just (p, s) -> Just (Dual s, Dual p)-   splitPrimeSuffix (Dual a) = case splitPrimePrefix a-                               of Nothing -> Nothing-                                  Just (p, s) -> Just (Dual s, Dual p)-   inits (Dual a) = fmap Dual (reverse $ tails a)-   tails (Dual a) = fmap Dual (reverse $ inits a)-   reverse (Dual a) = Dual (reverse a)--instance (Integral a, Eq a) => FactorialMonoid (Sum a) where-   primePrefix (Sum a) = Sum (signum a )-   primeSuffix = primePrefix-   splitPrimePrefix (Sum 0) = Nothing-   splitPrimePrefix (Sum a) = Just (Sum (signum a), Sum (a - signum a))-   splitPrimeSuffix (Sum 0) = Nothing-   splitPrimeSuffix (Sum a) = Just (Sum (a - signum a), Sum (signum a))-   length (Sum a) = abs (fromIntegral a)-   reverse = id--instance Integral a => FactorialMonoid (Product a) where-   factors (Product a) = List.map Product (primeFactors a)-   reverse = id--instance FactorialMonoid a => FactorialMonoid (Maybe a) where-   factors Nothing = []-   factors (Just a) | null a = [Just a]-                    | otherwise = List.map Just (factors a)-   length Nothing = 0-   length (Just a) | null a = 1-                   | otherwise = length a-   reverse = fmap reverse--instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (a, b) where-   factors (a, b) = List.map (\a1-> (a1, mempty)) (factors a) ++ List.map ((,) mempty) (factors b)-   primePrefix (a, b) | null a = (a, primePrefix b)-                      | otherwise = (primePrefix a, mempty)-   primeSuffix (a, b) | null b = (primeSuffix a, b)-                      | otherwise = (mempty, primeSuffix b)-   splitPrimePrefix (a, b) = case (splitPrimePrefix a, splitPrimePrefix b)-                             of (Just (ap, as), _) -> Just ((ap, mempty), (as, b))-                                (Nothing, Just (bp, bs)) -> Just ((a, bp), (a, bs))-                                (Nothing, Nothing) -> Nothing-   splitPrimeSuffix (a, b) = case (splitPrimeSuffix a, splitPrimeSuffix b)-                             of (_, Just (bp, bs)) -> Just ((a, bp), (mempty, bs))-                                (Just (ap, as), Nothing) -> Just ((ap, b), (as, b))-                                (Nothing, Nothing) -> Nothing-   inits (a, b) = List.map (flip (,) mempty) (inits a) ++ List.map ((,) a) (List.tail $ inits b)-   tails (a, b) = List.map (flip (,) b) (tails a) ++ List.map ((,) mempty) (List.tail $ tails b)-   foldl f a0 (x, y) = foldl f2 (foldl f1 a0 x) y-      where f1 a = f a . fromFst-            f2 a = f a . fromSnd-   foldl' f a0 (x, y) = a' `seq` foldl' f2 a' y-      where f1 a = f a . fromFst-            f2 a = f a . fromSnd-            a' = foldl' f1 a0 x-   foldr f a (x, y) = foldr (f . fromFst) (foldr (f . fromSnd) a y) x-   foldMap f (x, y) = foldMap (f . fromFst) x `mappend` foldMap (f . fromSnd) y-   length (a, b) = length a + length b-   span p (x, y) = ((xp, yp), (xs, ys))-      where (xp, xs) = span (p . fromFst) x-            (yp, ys) | null xs = span (p . fromSnd) y-                     | otherwise = (mempty, y)-   spanMaybe s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)-                         | otherwise = ((xp, mempty), (xs, y), s1)-     where (xp, xs, s1) = spanMaybe s0 (\s-> f s . fromFst) x-           (yp, ys, s2) = spanMaybe s1 (\s-> f s . fromSnd) y-   spanMaybe' s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)-                          | otherwise = ((xp, mempty), (xs, y), s1)-     where (xp, xs, s1) = spanMaybe' s0 (\s-> f s . fromFst) x-           (yp, ys, s2) = spanMaybe' s1 (\s-> f s . fromSnd) y-   split p (x0, y0) = fst $ List.foldr combine (ys, False) xs-      where xs = List.map fromFst $ split (p . fromFst) x0-            ys = List.map fromSnd $ split (p . fromSnd) y0-            combine x (~(y:rest), False) = (mappend x y : rest, True)-            combine x (rest, True) = (x:rest, True)-   splitAt n (x, y) = ((xp, yp), (xs, ys))-      where (xp, xs) = splitAt n x-            (yp, ys) | null xs = splitAt (n - length x) y-                     | otherwise = (mempty, y)-   reverse (a, b) = (reverse a, reverse b)--{-# INLINE fromFst #-}-fromFst :: Monoid b => a -> (a, b)-fromFst a = (a, mempty)--{-# INLINE fromSnd #-}-fromSnd :: Monoid a => b -> (a, b)-fromSnd b = (mempty, b)--instance FactorialMonoid [x] where-   factors xs = List.map (:[]) xs-   primePrefix [] = []-   primePrefix (x:_) = [x]-   primeSuffix [] = []-   primeSuffix xs = [List.last xs]-   splitPrimePrefix [] = Nothing-   splitPrimePrefix (x:xs) = Just ([x], xs)-   splitPrimeSuffix [] = Nothing-   splitPrimeSuffix xs = Just (splitLast id xs)-      where splitLast f last@[_] = (f [], last)-            splitLast f ~(x:rest) = splitLast (f . (x:)) rest-   inits = List.inits-   tails = List.tails-   foldl _ a [] = a-   foldl f a (x:xs) = foldl f (f a [x]) xs-   foldl' _ a [] = a-   foldl' f a (x:xs) = let a' = f a [x] in a' `seq` foldl' f a' xs-   foldr _ f0 [] = f0-   foldr f f0 (x:xs) = f [x] (foldr f f0 xs)-   length = List.length-   foldMap f = mconcat . List.map (f . (:[]))-   break f = List.break (f . (:[]))-   span f = List.span (f . (:[]))-   dropWhile f = List.dropWhile (f . (:[]))-   takeWhile f = List.takeWhile (f . (:[]))-   spanMaybe s0 f l = (prefix' [], suffix' [], s')-      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l-            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = (prefix . (x:), id, s2, True)-                                           | otherwise = (prefix, suffix . (x:), s1, False)-   spanMaybe' s0 f l = (prefix' [], suffix' [], s')-      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l-            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = seq s2 $ (prefix . (x:), id, s2, True)-                                           | otherwise = (prefix, suffix . (x:), s1, False)-   splitAt = List.splitAt-   drop = List.drop-   take = List.take-   reverse = List.reverse--instance FactorialMonoid ByteString.ByteString where-   factors x = factorize (ByteString.length x) x-      where factorize 0 _ = []-            factorize n xs = xs1 : factorize (pred n) xs'-              where (xs1, xs') = ByteString.splitAt 1 xs-   primePrefix = ByteString.take 1-   primeSuffix x = ByteString.drop (ByteString.length x - 1) x-   splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)-   splitPrimeSuffix x = if ByteString.null x then Nothing else Just (ByteString.splitAt (ByteString.length x - 1) x)-   inits = ByteString.inits-   tails = ByteString.tails-   foldl f = ByteString.foldl f'-      where f' a byte = f a (ByteString.singleton byte)-   foldl' f = ByteString.foldl' f'-      where f' a byte = f a (ByteString.singleton byte)-   foldr f = ByteString.foldr (f . ByteString.singleton)-   break f = ByteString.break (f . ByteString.singleton)-   span f = ByteString.span (f . ByteString.singleton)-   spanMaybe s0 f b = case ByteString.foldr g id b (0, s0)-                      of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')-      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ cont (i', s')-                            | otherwise = (i, s)-   spanMaybe' s0 f b = case ByteString.foldr g id b (0, s0)-                       of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')-      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')-                            | otherwise = (i, s)-   dropWhile f = ByteString.dropWhile (f . ByteString.singleton)-   takeWhile f = ByteString.takeWhile (f . ByteString.singleton)-   length = ByteString.length-   split f = ByteString.splitWith f'-      where f' = f . ByteString.singleton-   splitAt = ByteString.splitAt-   drop = ByteString.drop-   take = ByteString.take-   reverse = ByteString.reverse--instance FactorialMonoid LazyByteString.ByteString where-   factors x = factorize (LazyByteString.length x) x-      where factorize 0 _ = []-            factorize n xs = xs1 : factorize (pred n) xs'-               where (xs1, xs') = LazyByteString.splitAt 1 xs-   primePrefix = LazyByteString.take 1-   primeSuffix x = LazyByteString.drop (LazyByteString.length x - 1) x-   splitPrimePrefix x = if LazyByteString.null x then Nothing-                        else Just (LazyByteString.splitAt 1 x)-   splitPrimeSuffix x = if LazyByteString.null x then Nothing-                        else Just (LazyByteString.splitAt (LazyByteString.length x - 1) x)-   inits = LazyByteString.inits-   tails = LazyByteString.tails-   foldl f = LazyByteString.foldl f'-      where f' a byte = f a (LazyByteString.singleton byte)-   foldl' f = LazyByteString.foldl' f'-      where f' a byte = f a (LazyByteString.singleton byte)-   foldr f = LazyByteString.foldr f'-      where f' byte a = f (LazyByteString.singleton byte) a-   length = fromIntegral . LazyByteString.length-   break f = LazyByteString.break (f . LazyByteString.singleton)-   span f = LazyByteString.span (f . LazyByteString.singleton)-   spanMaybe s0 f b = case LazyByteString.foldr g id b (0, s0)-                      of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')-      where g w cont (i, s) | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ cont (i', s')-                            | otherwise = (i, s)-   spanMaybe' s0 f b = case LazyByteString.foldr g id b (0, s0)-                       of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')-      where g w cont (i, s)-              | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')-              | otherwise = (i, s)-   dropWhile f = LazyByteString.dropWhile (f . LazyByteString.singleton)-   takeWhile f = LazyByteString.takeWhile (f . LazyByteString.singleton)-   split f = LazyByteString.splitWith f'-      where f' = f . LazyByteString.singleton-   splitAt = LazyByteString.splitAt . fromIntegral-   drop n = LazyByteString.drop (fromIntegral n)-   take n = LazyByteString.take (fromIntegral n)-   reverse = LazyByteString.reverse--instance FactorialMonoid Text.Text where-   factors = Text.chunksOf 1-   primePrefix = Text.take 1-   primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)-   splitPrimePrefix = fmap (first Text.singleton) . Text.uncons-   splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.init x, Text.singleton (Text.last x))-   inits = Text.inits-   tails = Text.tails-   foldl f = Text.foldl f'-      where f' a char = f a (Text.singleton char)-   foldl' f = Text.foldl' f'-      where f' a char = f a (Text.singleton char)-   foldr f = Text.foldr f'-      where f' char a = f (Text.singleton char) a-   length = Text.length-   span f = Text.span (f . Text.singleton)-   break f = Text.break (f . Text.singleton)-   dropWhile f = Text.dropWhile (f . Text.singleton)-   takeWhile f = Text.takeWhile (f . Text.singleton)-   spanMaybe s0 f t = case Text.foldr g id t (0, s0)-                      of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')-      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ cont (i', s')-                            | otherwise = (i, s)-   spanMaybe' s0 f t = case Text.foldr g id t (0, s0)-                       of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')-      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')-                            | otherwise = (i, s)-   split f = Text.split f'-      where f' = f . Text.singleton-   splitAt = Text.splitAt-   drop = Text.drop-   take = Text.take-   reverse = Text.reverse--instance FactorialMonoid LazyText.Text where-   factors = LazyText.chunksOf 1-   primePrefix = LazyText.take 1-   primeSuffix x = if LazyText.null x then LazyText.empty else LazyText.singleton (LazyText.last x)-   splitPrimePrefix = fmap (first LazyText.singleton) . LazyText.uncons-   splitPrimeSuffix x = if LazyText.null x-                        then Nothing-                        else Just (LazyText.init x, LazyText.singleton (LazyText.last x))-   inits = LazyText.inits-   tails = LazyText.tails-   foldl f = LazyText.foldl f'-      where f' a char = f a (LazyText.singleton char)-   foldl' f = LazyText.foldl' f'-      where f' a char = f a (LazyText.singleton char)-   foldr f = LazyText.foldr f'-      where f' char a = f (LazyText.singleton char) a-   length = fromIntegral . LazyText.length-   span f = LazyText.span (f . LazyText.singleton)-   break f = LazyText.break (f . LazyText.singleton)-   dropWhile f = LazyText.dropWhile (f . LazyText.singleton)-   takeWhile f = LazyText.takeWhile (f . LazyText.singleton)-   spanMaybe s0 f t = case LazyText.foldr g id t (0, s0)-                      of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')-      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ cont (i', s')-                            | otherwise = (i, s)-   spanMaybe' s0 f t = case LazyText.foldr g id t (0, s0)-                       of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')-      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')-                            | otherwise = (i, s)-   split f = LazyText.split f'-      where f' = f . LazyText.singleton-   splitAt = LazyText.splitAt . fromIntegral-   drop n = LazyText.drop (fromIntegral n)-   take n = LazyText.take (fromIntegral n)-   reverse = LazyText.reverse--instance Ord k => FactorialMonoid (Map.Map k v) where-   factors = List.map (uncurry Map.singleton) . Map.toAscList-   primePrefix map | Map.null map = map-                   | otherwise = uncurry Map.singleton $ Map.findMin map-   primeSuffix map | Map.null map = map-                   | otherwise = uncurry Map.singleton $ Map.findMax map-   splitPrimePrefix = fmap singularize . Map.minViewWithKey-      where singularize ((k, v), rest) = (Map.singleton k v, rest)-   splitPrimeSuffix = fmap singularize . Map.maxViewWithKey-      where singularize ((k, v), rest) = (rest, Map.singleton k v)-   foldl f = Map.foldlWithKey f'-      where f' a k v = f a (Map.singleton k v)-   foldl' f = Map.foldlWithKey' f'-      where f' a k v = f a (Map.singleton k v)-   foldr f = Map.foldrWithKey f'-      where f' k v a = f (Map.singleton k v) a-   length = Map.size-   reverse = id--instance FactorialMonoid (IntMap.IntMap a) where-   factors = List.map (uncurry IntMap.singleton) . IntMap.toAscList-   primePrefix map | IntMap.null map = map-                   | otherwise = uncurry IntMap.singleton $ IntMap.findMin map-   primeSuffix map | IntMap.null map = map-                   | otherwise = uncurry IntMap.singleton $ IntMap.findMax map-   splitPrimePrefix = fmap singularize . IntMap.minViewWithKey-      where singularize ((k, v), rest) = (IntMap.singleton k v, rest)-   splitPrimeSuffix = fmap singularize . IntMap.maxViewWithKey-      where singularize ((k, v), rest) = (rest, IntMap.singleton k v)-   foldl f = IntMap.foldlWithKey f'-      where f' a k v = f a (IntMap.singleton k v)-   foldl' f = IntMap.foldlWithKey' f'-      where f' a k v = f a (IntMap.singleton k v)-   foldr f = IntMap.foldrWithKey f'-      where f' k v a = f (IntMap.singleton k v) a-   length = IntMap.size-   reverse = id--instance FactorialMonoid IntSet.IntSet where-   factors = List.map IntSet.singleton . IntSet.toAscList-   primePrefix set | IntSet.null set = set-                   | otherwise = IntSet.singleton $ IntSet.findMin set-   primeSuffix set | IntSet.null set = set-                   | otherwise = IntSet.singleton $ IntSet.findMax set-   splitPrimePrefix = fmap singularize . IntSet.minView-      where singularize (min, rest) = (IntSet.singleton min, rest)-   splitPrimeSuffix = fmap singularize . IntSet.maxView-      where singularize (max, rest) = (rest, IntSet.singleton max)-   foldl f = IntSet.foldl f'-      where f' a b = f a (IntSet.singleton b)-   foldl' f = IntSet.foldl' f'-      where f' a b = f a (IntSet.singleton b)-   foldr f = IntSet.foldr f'-      where f' a b = f (IntSet.singleton a) b-   length = IntSet.size-   reverse = id--instance FactorialMonoid (Sequence.Seq a) where-   factors = List.map Sequence.singleton . Foldable.toList-   primePrefix = Sequence.take 1-   primeSuffix q = Sequence.drop (Sequence.length q - 1) q-   splitPrimePrefix q = case Sequence.viewl q-                        of Sequence.EmptyL -> Nothing-                           hd Sequence.:< rest -> Just (Sequence.singleton hd, rest)-   splitPrimeSuffix q = case Sequence.viewr q-                        of Sequence.EmptyR -> Nothing-                           rest Sequence.:> last -> Just (rest, Sequence.singleton last)-   inits = Foldable.toList . Sequence.inits-   tails = Foldable.toList . Sequence.tails-   foldl f = Foldable.foldl f'-      where f' a b = f a (Sequence.singleton b)-   foldl' f = Foldable.foldl' f'-      where f' a b = f a (Sequence.singleton b)-   foldr f = Foldable.foldr f'-      where f' a b = f (Sequence.singleton a) b-   span f = Sequence.spanl (f . Sequence.singleton)-   break f = Sequence.breakl (f . Sequence.singleton)-   dropWhile f = Sequence.dropWhileL (f . Sequence.singleton)-   takeWhile f = Sequence.takeWhileL (f . Sequence.singleton)-   spanMaybe s0 f b = case Foldable.foldr g id b (0, s0)-                      of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')-      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ cont (i', s')-                            | otherwise = (i, s)-   spanMaybe' s0 f b = case Foldable.foldr g id b (0, s0)-                       of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')-      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')-                            | otherwise = (i, s)-   splitAt = Sequence.splitAt-   drop = Sequence.drop-   take = Sequence.take-   length = Sequence.length-   reverse = Sequence.reverse--instance Ord a => FactorialMonoid (Set.Set a) where-   factors = List.map Set.singleton . Set.toAscList-   primePrefix set | Set.null set = set-                   | otherwise = Set.singleton $ Set.findMin set-   primeSuffix set | Set.null set = set-                   | otherwise = Set.singleton $ Set.findMax set-   splitPrimePrefix = fmap singularize . Set.minView-      where singularize (min, rest) = (Set.singleton min, rest)-   splitPrimeSuffix = fmap singularize . Set.maxView-      where singularize (max, rest) = (rest, Set.singleton max)-   foldl f = Foldable.foldl f'-      where f' a b = f a (Set.singleton b)-   foldl' f = Foldable.foldl' f'-      where f' a b = f a (Set.singleton b)-   foldr f = Foldable.foldr f'-      where f' a b = f (Set.singleton a) b-   length = Set.size-   reverse = id--instance FactorialMonoid (Vector.Vector a) where-   factors x = factorize (Vector.length x) x-      where factorize 0 _ = []-            factorize n xs = xs1 : factorize (pred n) xs'-               where (xs1, xs') = Vector.splitAt 1 xs-   primePrefix = Vector.take 1-   primeSuffix x = Vector.drop (Vector.length x - 1) x-   splitPrimePrefix x = if Vector.null x then Nothing else Just (Vector.splitAt 1 x)-   splitPrimeSuffix x = if Vector.null x then Nothing else Just (Vector.splitAt (Vector.length x - 1) x)-   inits x0 = initsWith x0 []-      where initsWith x rest | Vector.null x = x:rest-                             | otherwise = initsWith (Vector.unsafeInit x) (x:rest)-   tails x = x : if Vector.null x then [] else tails (Vector.unsafeTail x)-   foldl f = Vector.foldl f'-      where f' a byte = f a (Vector.singleton byte)-   foldl' f = Vector.foldl' f'-      where f' a byte = f a (Vector.singleton byte)-   foldr f = Vector.foldr f'-      where f' byte a = f (Vector.singleton byte) a-   break f = Vector.break (f . Vector.singleton)-   span f = Vector.span (f . Vector.singleton)-   dropWhile f = Vector.dropWhile (f . Vector.singleton)-   takeWhile f = Vector.takeWhile (f . Vector.singleton)-   spanMaybe s0 f v = case Vector.ifoldr g Left v s0-                      of Left s' -> (v, Vector.empty, s')-                         Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')-      where g i x cont s | Just s' <- f s (Vector.singleton x) = cont s'-                         | otherwise = Right (i, s)-   spanMaybe' s0 f v = case Vector.ifoldr' g Left v s0-                       of Left s' -> (v, Vector.empty, s')-                          Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')-      where g i x cont s | Just s' <- f s (Vector.singleton x) = seq s' (cont s')-                         | otherwise = Right (i, s)-   splitAt = Vector.splitAt-   drop = Vector.drop-   take = Vector.take-   length = Vector.length-   reverse = Vector.reverse--instance StableFactorialMonoid ()-instance StableFactorialMonoid a => StableFactorialMonoid (Dual a)-instance StableFactorialMonoid [x]-instance StableFactorialMonoid ByteString.ByteString-instance StableFactorialMonoid LazyByteString.ByteString-instance StableFactorialMonoid Text.Text-instance StableFactorialMonoid LazyText.Text-instance StableFactorialMonoid (Sequence.Seq a)-instance StableFactorialMonoid (Vector.Vector a)---- | A 'Monad.mapM' equivalent.-mapM :: (FactorialMonoid a, Monoid b, Monad m) => (a -> m b) -> a -> m b-mapM f = ($ return mempty) . appEndo . foldMap (Endo . Monad.liftM2 mappend . f)---- | A 'Monad.mapM_' equivalent.-mapM_ :: (FactorialMonoid a, Monad m) => (a -> m b) -> a -> m ()-mapM_ f = foldr ((>>) . f) (return ())
− tests/examples/ghc710/Undefined11.hs 
@@ -1,423 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Algebra.Additive (-    -- * Class-    C,-    zero,-    (+), (-),-    negate, subtract,--    -- * Complex functions-    sum, sum1,-    sumNestedAssociative,-    sumNestedCommutative,--    -- * Instance definition helpers-    elementAdd, elementSub, elementNeg,-    (<*>.+), (<*>.-), (<*>.-$),--    -- * Instances for atomic types-    propAssociative,-    propCommutative,-    propIdentity,-    propInverse,-  ) where--import qualified Algebra.Laws as Laws--import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )-import Data.Word (Word, Word8, Word16, Word32, Word64, )--import qualified NumericPrelude.Elementwise as Elem-import Control.Applicative (Applicative(pure, (<*>)), )-import Data.Tuple.HT (fst3, snd3, thd3, )-import qualified Data.List.Match as Match--import qualified Data.Complex as Complex98-import qualified Data.Ratio as Ratio98-import qualified Prelude as P-import Prelude (Integer, Float, Double, fromInteger, )-import NumericPrelude.Base---infixl 6  +, ---{- |-Additive a encapsulates the notion of a commutative group, specified-by the following laws:--@-          a + b === b + a-    (a + b) + c === a + (b + c)-       zero + a === a-   a + negate a === 0-@--Typical examples include integers, dollars, and vectors.--Minimal definition: '+', 'zero', and ('negate' or '(-)')--}--class C a where-    {-# MINIMAL zero, (+), ((-) | negate) #-}-    -- | zero element of the vector space-    zero     :: a-    -- | add and subtract elements-    (+), (-) :: a -> a -> a-    -- | inverse with respect to '+'-    negate   :: a -> a--    {-# INLINE negate #-}-    negate a = zero - a-    {-# INLINE (-) #-}-    a - b    = a + negate b--{- |-'subtract' is @(-)@ with swapped operand order.-This is the operand order which will be needed in most cases-of partial application.--}-subtract :: C a => a -> a -> a-subtract = flip (-)-----{- |-Sum up all elements of a list.-An empty list yields zero.--This function is inappropriate for number types like Peano.-Maybe we should make 'sum' a method of Additive.-This would also make 'lengthLeft' and 'lengthRight' superfluous.--}-sum :: (C a) => [a] -> a-sum = foldl (+) zero--{- |-Sum up all elements of a non-empty list.-This avoids including a zero which is useful for types-where no universal zero is available.--}-sum1 :: (C a) => [a] -> a-sum1 = foldl1 (+)---{- |-Sum the operands in an order,-such that the dependencies are minimized.-Does this have a measurably effect on speed?--Requires associativity.--}-sumNestedAssociative :: (C a) => [a] -> a-sumNestedAssociative [] = zero-sumNestedAssociative [x] = x-sumNestedAssociative xs = sumNestedAssociative (sum2 xs)--{--Make sure that the last entries in the list-are equally often part of an addition.-Maybe this can reduce rounding errors.-The list that sum2 computes is a breadth-first-flattened binary tree.--Requires associativity and commutativity.--}-sumNestedCommutative :: (C a) => [a] -> a-sumNestedCommutative [] = zero-sumNestedCommutative xs@(_:rs) =-   let ys = xs ++ Match.take rs (sum2 ys)-   in  last ys--_sumNestedCommutative :: (C a) => [a] -> a-_sumNestedCommutative [] = zero-_sumNestedCommutative xs@(_:rs) =-   let ys = xs ++ take (length rs) (sum2 ys)-   in  last ys--{--[a,b,c, a+b,c+(a+b)]-[a,b,c,d, a+b,c+d,(a+b)+(c+d)]-[a,b,c,d,e, a+b,c+d,e+(a+b),(c+d)+e+(a+b)]-[a,b,c,d,e,f, a+b,c+d,e+f,(a+b)+(c+d),(e+f)+((a+b)+(c+d))]--}--sum2 :: (C a) => [a] -> [a]-sum2 (x:y:rest) = (x+y) : sum2 rest-sum2 xs = xs----{- |-Instead of baking the add operation into the element function,-we could use higher rank types-and pass a generic @uncurry (+)@ to the run function.-We do not do so in order to stay Haskell 98-at least for parts of NumericPrelude.--}-{-# INLINE elementAdd #-}-elementAdd ::-   (C x) =>-   (v -> x) -> Elem.T (v,v) x-elementAdd f =-   Elem.element (\(x,y) -> f x + f y)--{-# INLINE elementSub #-}-elementSub ::-   (C x) =>-   (v -> x) -> Elem.T (v,v) x-elementSub f =-   Elem.element (\(x,y) -> f x - f y)--{-# INLINE elementNeg #-}-elementNeg ::-   (C x) =>-   (v -> x) -> Elem.T v x-elementNeg f =-   Elem.element (negate . f)----- like <*>-infixl 4 <*>.+, <*>.-, <*>.-$--{- |-> addPair :: (Additive.C a, Additive.C b) => (a,b) -> (a,b) -> (a,b)-> addPair = Elem.run2 $ Elem.with (,) <*>.+  fst <*>.+  snd--}-{-# INLINE (<*>.+) #-}-(<*>.+) ::-   (C x) =>-   Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a-(<*>.+) f acc =-   f <*> elementAdd acc--{-# INLINE (<*>.-) #-}-(<*>.-) ::-   (C x) =>-   Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a-(<*>.-) f acc =-   f <*> elementSub acc--{-# INLINE (<*>.-$) #-}-(<*>.-$) ::-   (C x) =>-   Elem.T v (x -> a) -> (v -> x) -> Elem.T v a-(<*>.-$) f acc =-   f <*> elementNeg acc----- * Instances for atomic types--instance C Integer where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Float   where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Double  where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)---instance C Int     where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Int8    where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Int16   where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Int32   where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Int64   where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)---instance C Word    where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Word8   where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Word16  where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Word32  where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)--instance C Word64  where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = P.fromInteger 0-   negate = P.negate-   (+)    = (P.+)-   (-)    = (P.-)------- * Instances for composed types--instance (C v0, C v1) => C (v0, v1) where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = (,) zero zero-   (+)    = Elem.run2 $ pure (,) <*>.+  fst <*>.+  snd-   (-)    = Elem.run2 $ pure (,) <*>.-  fst <*>.-  snd-   negate = Elem.run  $ pure (,) <*>.-$ fst <*>.-$ snd--instance (C v0, C v1, C v2) => C (v0, v1, v2) where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero   = (,,) zero zero zero-   (+)    = Elem.run2 $ pure (,,) <*>.+  fst3 <*>.+  snd3 <*>.+  thd3-   (-)    = Elem.run2 $ pure (,,) <*>.-  fst3 <*>.-  snd3 <*>.-  thd3-   negate = Elem.run  $ pure (,,) <*>.-$ fst3 <*>.-$ snd3 <*>.-$ thd3---instance (C v) => C [v] where-   zero   = []-   negate = map negate-   (+) (x:xs) (y:ys) = (+) x y : (+) xs ys-   (+) xs     []     = xs-   (+) []     ys     = ys-   (-) (x:xs) (y:ys) = (-) x y : (-) xs ys-   (-) xs     []     = xs-   (-) []     ys     = negate ys---instance (C v) => C (b -> v) where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero       _ = zero-   (+)    f g x = (+) (f x) (g x)-   (-)    f g x = (-) (f x) (g x)-   negate f   x = negate (f x)---- * Properties--propAssociative :: (Eq a, C a) => a -> a -> a -> Bool-propCommutative :: (Eq a, C a) => a -> a -> Bool-propIdentity    :: (Eq a, C a) => a -> Bool-propInverse     :: (Eq a, C a) => a -> Bool--propCommutative  =  Laws.commutative (+)-propAssociative  =  Laws.associative (+)-propIdentity     =  Laws.identity (+) zero-propInverse      =  Laws.inverse (+) negate zero------ legacy--instance (P.Integral a) => C (Ratio98.Ratio a) where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero                =  P.fromInteger 0-   (+)                 =  (P.+)-   (-)                 =  (P.-)-   negate              =  P.negate--instance (P.RealFloat a) => C (Complex98.Complex a) where-   {-# INLINE zero #-}-   {-# INLINE negate #-}-   {-# INLINE (+) #-}-   {-# INLINE (-) #-}-   zero                =  P.fromInteger 0-   (+)                 =  (P.+)-   (-)                 =  (P.-)-   negate              =  P.negate
− tests/examples/ghc710/Undefined13.hs 
@@ -1,130 +0,0 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Network.TigHTTP.Papillon (-    ContentType(..), Type(..), Subtype(..), Parameter(..), Charset(..),-        parseContentType, showContentType,-) where--import Data.Char-import Text.Papillon--import Data.ByteString (ByteString)-import Data.ByteString.Char8 (pack)-import qualified Data.ByteString as BS--import Network.TigHTTP.Token--data ContentType = ContentType Type Subtype [Parameter]-    deriving (Show, Eq)--parseContentType :: BS.ByteString -> ContentType-parseContentType ct = case runError . contentType $ parse ct of-    Left _ -> error "parseContentType"-    Right (r, _) -> r--showContentType :: ContentType -> BS.ByteString-showContentType (ContentType t st ps) = showType t-    `BS.append` "/"-    `BS.append` showSubtype st-    `BS.append` showParameters ps--data Type-    = Text-    | TypeRaw BS.ByteString-    deriving (Show, Eq)--mkType :: BS.ByteString -> Type-mkType "text" = Text-mkType t = TypeRaw t--showType :: Type -> BS.ByteString-showType Text = "text"-showType (TypeRaw t) = t--data Subtype-    = Plain-    | Html-    | Css-    | SubtypeRaw BS.ByteString-    deriving (Show, Eq)--mkSubtype :: BS.ByteString -> Subtype-mkSubtype "html" = Html-mkSubtype "plain" = Plain-mkSubtype "css" = Css-mkSubtype s = SubtypeRaw s--showSubtype :: Subtype -> BS.ByteString-showSubtype Plain = "plain"-showSubtype Html = "html"-showSubtype Css = "css"-showSubtype (SubtypeRaw s) = s--data Parameter-    = Charset Charset-    | ParameterRaw BS.ByteString BS.ByteString-    deriving (Show, Eq)--mkParameter :: BS.ByteString -> BS.ByteString -> Parameter-mkParameter "charset" "UTF-8" = Charset Utf8-mkParameter "charset" v = Charset $ CharsetRaw v-mkParameter a v = ParameterRaw a v--showParameters :: [Parameter] -> BS.ByteString-showParameters [] = ""-showParameters (Charset v : ps) = "; " `BS.append` "charset"-    `BS.append` "=" `BS.append` showCharset v `BS.append` showParameters ps-showParameters (ParameterRaw a v : ps) = "; " `BS.append` a-    `BS.append` "=" `BS.append` v `BS.append` showParameters ps--data Charset-    = Utf8-    | CharsetRaw BS.ByteString-    deriving (Show, Eq)--showCharset :: Charset -> BS.ByteString-showCharset Utf8 = "UTF-8"-showCharset (CharsetRaw cs) = cs--bsconcat :: [ByteString] -> ByteString-bsconcat = BS.concat--[papillon|--source: ByteString--contentType :: ContentType-    = c:token '/' sc:token ps:(';' ' '* p:parameter { p })*-    { ContentType (mkType c) (mkSubtype sc) ps }--token :: ByteString-    = t:<isTokenChar>+          { pack t }--quotedString :: ByteString-    = '"' t:(qt:qdtext { qt } / qp:quotedPair { pack [qp] })* '"'-                        { bsconcat t }--quotedPair :: Char-    = '\\' c:<isAscii>          { c }--crlf :: () = '\r' '\n'--lws :: () = _:crlf _:(' ' / '\t')+---- text :: ByteString---  = ts:(cs:<isTextChar>+ { cs } / _:lws { " " })+     { pack $ concat ts }--qdtext :: ByteString-    = ts:(cs:<isQdtextChar>+ { cs } / _:lws { " " })+   { pack $ concat ts }--parameter :: Parameter-    = a:attribute '=' v:value               { mkParameter a v }--attribute :: ByteString = t:token               { t }--value :: ByteString-    = t:token                       { t }-    / qs:quotedString                   { qs }--|]
− tests/examples/ghc710/Undefined2.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE Safe #-}---------------------------------------------------------------------------------- |--- Module      :  Control.Monad.Zip--- Copyright   :  (c) Nils Schweinsberg 2011,---                (c) George Giorgidze 2011---                (c) University Tuebingen 2011--- License     :  BSD-style (see the file libraries/base/LICENSE)--- Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ Monadic zipping (used for monad comprehensions)-----------------------------------------------------------------------------------module Control.Monad.Zip where--import Prelude-import Control.Monad (liftM)---- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`------ Instances should satisfy the laws:------ * Naturality :------   > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)------ * Information Preservation:------   > liftM (const ()) ma = liftM (const ()) mb---   > ==>---   > munzip (mzip ma mb) = (ma, mb)----class Monad m => MonadZip m where--    mzip :: m a -> m b -> m (a,b)-    mzip = mzipWith (,)--    mzipWith :: (a -> b -> c) -> m a -> m b -> m c-    mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)--    munzip :: m (a,b) -> (m a, m b)-    munzip mab = (liftM fst mab, liftM snd mab)-    -- munzip is a member of the class because sometimes-    -- you can implement it more efficiently than the-    -- above default code.  See Trac #4370 comment by giorgidze-    {-# MINIMAL mzip | mzipWith #-}--instance MonadZip [] where-    mzip     = zip-    mzipWith = zipWith-    munzip   = unzip-
− tests/examples/ghc710/Undefined3.hs 
@@ -1,340 +0,0 @@-{-# LANGUAGE Trustworthy #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Foldable--- Copyright   :  Ross Paterson 2005--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ Class of data structures that can be folded to a summary value.------ Many of these functions generalize "Prelude", "Control.Monad" and--- "Data.List" functions of the same names from lists to any 'Foldable'--- functor.  To avoid ambiguity, either import those modules hiding--- these names or qualify uses of these function names with an alias--- for this module.-----------------------------------------------------------------------------------module Data.Foldable (-    -- * Folds-    Foldable(..),-    -- ** Special biased folds-    foldrM,-    foldlM,-    -- ** Folding actions-    -- *** Applicative actions-    traverse_,-    for_,-    sequenceA_,-    asum,-    -- *** Monadic actions-    mapM_,-    forM_,-    sequence_,-    msum,-    -- ** Specialized folds-    toList,-    concat,-    concatMap,-    and,-    or,-    any,-    all,-    sum,-    product,-    maximum,-    maximumBy,-    minimum,-    minimumBy,-    -- ** Searches-    elem,-    notElem,-    find-    ) where--import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,-                elem, notElem, concat, concatMap, and, or, any, all,-                sum, product, maximum, minimum)-import qualified Prelude (foldl, foldr, foldl1, foldr1)-import qualified Data.List as List (foldl')-import Control.Applicative-import Control.Monad (MonadPlus(..))-import Data.Maybe (fromMaybe, listToMaybe)-import Data.Monoid-import Data.Proxy--import GHC.Exts (build)-import GHC.Arr---- | Data structures that can be folded.------ Minimal complete definition: 'foldMap' or 'foldr'.------ For example, given a data type------ > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)------ a suitable instance would be------ > instance Foldable Tree where--- >    foldMap f Empty = mempty--- >    foldMap f (Leaf x) = f x--- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r------ This is suitable even for abstract types, as the monoid is assumed--- to satisfy the monoid laws.  Alternatively, one could define @foldr@:------ > instance Foldable Tree where--- >    foldr f z Empty = z--- >    foldr f z (Leaf x) = f x z--- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l----class Foldable t where-    -- | Combine the elements of a structure using a monoid.-    fold :: Monoid m => t m -> m-    fold = foldMap id--    -- | Map each element of the structure to a monoid,-    -- and combine the results.-    foldMap :: Monoid m => (a -> m) -> t a -> m-    foldMap f = foldr (mappend . f) mempty--    -- | Right-associative fold of a structure.-    ---    -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@-    foldr :: (a -> b -> b) -> b -> t a -> b-    foldr f z t = appEndo (foldMap (Endo . f) t) z--    -- | Right-associative fold of a structure,-    -- but with strict application of the operator.-    foldr' :: (a -> b -> b) -> b -> t a -> b-    foldr' f z0 xs = foldl f' id xs z0-      where f' k x z = k $! f x z--    -- | Left-associative fold of a structure.-    ---    -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@-    foldl :: (b -> a -> b) -> b -> t a -> b-    foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z--    -- | Left-associative fold of a structure.-    -- but with strict application of the operator.-    ---    -- @'foldl' f z = 'List.foldl'' f z . 'toList'@-    foldl' :: (b -> a -> b) -> b -> t a -> b-    foldl' f z0 xs = foldr f' id xs z0-      where f' x k z = k $! f z x--    -- | A variant of 'foldr' that has no base case,-    -- and thus may only be applied to non-empty structures.-    ---    -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@-    foldr1 :: (a -> a -> a) -> t a -> a-    foldr1 f xs = fromMaybe (error "foldr1: empty structure")-                    (foldr mf Nothing xs)-      where-        mf x Nothing = Just x-        mf x (Just y) = Just (f x y)--    -- | A variant of 'foldl' that has no base case,-    -- and thus may only be applied to non-empty structures.-    ---    -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@-    foldl1 :: (a -> a -> a) -> t a -> a-    foldl1 f xs = fromMaybe (error "foldl1: empty structure")-                    (foldl mf Nothing xs)-      where-        mf Nothing y = Just y-        mf (Just x) y = Just (f x y)-    {-# MINIMAL foldMap | foldr #-}---- instances for Prelude types--instance Foldable Maybe where-    foldr _ z Nothing = z-    foldr f z (Just x) = f x z--    foldl _ z Nothing = z-    foldl f z (Just x) = f z x--instance Foldable [] where-    foldr = Prelude.foldr-    foldl = Prelude.foldl-    foldl' = List.foldl'-    foldr1 = Prelude.foldr1-    foldl1 = Prelude.foldl1--instance Foldable (Either a) where-    foldMap _ (Left _) = mempty-    foldMap f (Right y) = f y--    foldr _ z (Left _) = z-    foldr f z (Right y) = f y z--instance Foldable ((,) a) where-    foldMap f (_, y) = f y--    foldr f z (_, y) = f y z--instance Ix i => Foldable (Array i) where-    foldr f z = Prelude.foldr f z . elems-    foldl f z = Prelude.foldl f z . elems-    foldr1 f = Prelude.foldr1 f . elems-    foldl1 f = Prelude.foldl1 f . elems--instance Foldable Proxy where-    foldMap _ _ = mempty-    {-# INLINE foldMap #-}-    fold _ = mempty-    {-# INLINE fold #-}-    foldr _ z _ = z-    {-# INLINE foldr #-}-    foldl _ z _ = z-    {-# INLINE foldl #-}-    foldl1 _ _ = error "foldl1: Proxy"-    {-# INLINE foldl1 #-}-    foldr1 _ _ = error "foldr1: Proxy"-    {-# INLINE foldr1 #-}--instance Foldable (Const m) where-    foldMap _ _ = mempty---- | Monadic fold over the elements of a structure,--- associating to the right, i.e. from right to left.-foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b-foldrM f z0 xs = foldl f' return xs z0-  where f' k x z = f x z >>= k---- | Monadic fold over the elements of a structure,--- associating to the left, i.e. from left to right.-foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b-foldlM f z0 xs = foldr f' return xs z0-  where f' x k z = f z x >>= k---- | Map each element of a structure to an action, evaluate--- these actions from left to right, and ignore the results.-traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()-traverse_ f = foldr ((*>) . f) (pure ())---- | 'for_' is 'traverse_' with its arguments flipped.-for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()-{-# INLINE for_ #-}-for_ = flip traverse_---- | Map each element of a structure to a monadic action, evaluate--- these actions from left to right, and ignore the results.-mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()-mapM_ f = foldr ((>>) . f) (return ())---- | 'forM_' is 'mapM_' with its arguments flipped.-forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()-{-# INLINE forM_ #-}-forM_ = flip mapM_---- | Evaluate each action in the structure from left to right,--- and ignore the results.-sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()-sequenceA_ = foldr (*>) (pure ())---- | Evaluate each monadic action in the structure from left to right,--- and ignore the results.-sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()-sequence_ = foldr (>>) (return ())---- | The sum of a collection of actions, generalizing 'concat'.-asum :: (Foldable t, Alternative f) => t (f a) -> f a-{-# INLINE asum #-}-asum = foldr (<|>) empty---- | The sum of a collection of actions, generalizing 'concat'.-msum :: (Foldable t, MonadPlus m) => t (m a) -> m a-{-# INLINE msum #-}-msum = foldr mplus mzero---- These use foldr rather than foldMap to avoid repeated concatenation.---- | List of elements of a structure.-toList :: Foldable t => t a -> [a]-{-# INLINE toList #-}-toList t = build (\ c n -> foldr c n t)---- | The concatenation of all the elements of a container of lists.-concat :: Foldable t => t [a] -> [a]-concat = fold---- | Map a function over all the elements of a container and concatenate--- the resulting lists.-concatMap :: Foldable t => (a -> [b]) -> t a -> [b]-concatMap = foldMap---- | 'and' returns the conjunction of a container of Bools.  For the--- result to be 'True', the container must be finite; 'False', however,--- results from a 'False' value finitely far from the left end.-and :: Foldable t => t Bool -> Bool-and = getAll . foldMap All---- | 'or' returns the disjunction of a container of Bools.  For the--- result to be 'False', the container must be finite; 'True', however,--- results from a 'True' value finitely far from the left end.-or :: Foldable t => t Bool -> Bool-or = getAny . foldMap Any---- | Determines whether any element of the structure satisfies the predicate.-any :: Foldable t => (a -> Bool) -> t a -> Bool-any p = getAny . foldMap (Any . p)---- | Determines whether all elements of the structure satisfy the predicate.-all :: Foldable t => (a -> Bool) -> t a -> Bool-all p = getAll . foldMap (All . p)---- | The 'sum' function computes the sum of the numbers of a structure.-sum :: (Foldable t, Num a) => t a -> a-sum = getSum . foldMap Sum---- | The 'product' function computes the product of the numbers of a structure.-product :: (Foldable t, Num a) => t a -> a-product = getProduct . foldMap Product---- | The largest element of a non-empty structure.-maximum :: (Foldable t, Ord a) => t a -> a-maximum = foldr1 max---- | The largest element of a non-empty structure with respect to the--- given comparison function.-maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a-maximumBy cmp = foldr1 max'-  where max' x y = case cmp x y of-                        GT -> x-                        _  -> y---- | The least element of a non-empty structure.-minimum :: (Foldable t, Ord a) => t a -> a-minimum = foldr1 min---- | The least element of a non-empty structure with respect to the--- given comparison function.-minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a-minimumBy cmp = foldr1 min'-  where min' x y = case cmp x y of-                        GT -> y-                        _  -> x---- | Does the element occur in the structure?-elem :: (Foldable t, Eq a) => a -> t a -> Bool-elem = any . (==)---- | 'notElem' is the negation of 'elem'.-notElem :: (Foldable t, Eq a) => a -> t a -> Bool-notElem x = not . elem x---- | The 'find' function takes a predicate and a structure and returns--- the leftmost element of the structure matching the predicate, or--- 'Nothing' if there is no such element.-find :: Foldable t => (a -> Bool) -> t a -> Maybe a-find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])-
− tests/examples/ghc710/Undefined4.hs 
@@ -1,280 +0,0 @@-{-# LANGUAGE Trustworthy #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Traversable--- Copyright   :  Conor McBride and Ross Paterson 2005--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  portable------ Class of data structures that can be traversed from left to right,--- performing an action on each element.------ See also------  * \"Applicative Programming with Effects\",---    by Conor McBride and Ross Paterson,---    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at---    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.------  * \"The Essence of the Iterator Pattern\",---    by Jeremy Gibbons and Bruno Oliveira,---    in /Mathematically-Structured Functional Programming/, 2006, online at---    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.------  * \"An Investigation of the Laws of Traversals\",---    by Mauro Jaskelioff and Ondrej Rypacek,---    in /Mathematically-Structured Functional Programming/, 2012, online at---    <http://arxiv.org/pdf/1202.2919>.------ Note that the functions 'mapM' and 'sequence' generalize "Prelude"--- functions of the same names from lists to any 'Traversable' functor.--- To avoid ambiguity, either import the "Prelude" hiding these names--- or qualify uses of these function names with an alias for this module.-----------------------------------------------------------------------------------module Data.Traversable (-    -- * The 'Traversable' class-    Traversable(..),-    -- * Utility functions-    for,-    forM,-    mapAccumL,-    mapAccumR,-    -- * General definitions for superclass methods-    fmapDefault,-    foldMapDefault,-    ) where--import Prelude hiding (mapM, sequence, foldr)-import qualified Prelude (mapM, foldr)-import Control.Applicative-import Data.Foldable (Foldable())-import Data.Monoid (Monoid)-import Data.Proxy--import GHC.Arr---- | Functors representing data structures that can be traversed from--- left to right.------ Minimal complete definition: 'traverse' or 'sequenceA'.------ A definition of 'traverse' must satisfy the following laws:------ [/naturality/]---   @t . 'traverse' f = 'traverse' (t . f)@---   for every applicative transformation @t@------ [/identity/]---   @'traverse' Identity = Identity@------ [/composition/]---   @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@------ A definition of 'sequenceA' must satisfy the following laws:------ [/naturality/]---   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@---   for every applicative transformation @t@------ [/identity/]---   @'sequenceA' . 'fmap' Identity = Identity@------ [/composition/]---   @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@------ where an /applicative transformation/ is a function------ @t :: (Applicative f, Applicative g) => f a -> g a@------ preserving the 'Applicative' operations, i.e.------  * @t ('pure' x) = 'pure' x@------  * @t (x '<*>' y) = t x '<*>' t y@------ and the identity functor @Identity@ and composition of functors @Compose@--- are defined as------ >   newtype Identity a = Identity a--- >--- >   instance Functor Identity where--- >     fmap f (Identity x) = Identity (f x)--- >--- >   instance Applicative Indentity where--- >     pure x = Identity x--- >     Identity f <*> Identity x = Identity (f x)--- >--- >   newtype Compose f g a = Compose (f (g a))--- >--- >   instance (Functor f, Functor g) => Functor (Compose f g) where--- >     fmap f (Compose x) = Compose (fmap (fmap f) x)--- >--- >   instance (Applicative f, Applicative g) => Applicative (Compose f g) where--- >     pure x = Compose (pure (pure x))--- >     Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)------ (The naturality law is implied by parametricity.)------ Instances are similar to 'Functor', e.g. given a data type------ > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)------ a suitable instance would be------ > instance Traversable Tree where--- >    traverse f Empty = pure Empty--- >    traverse f (Leaf x) = Leaf <$> f x--- >    traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r------ This is suitable even for abstract types, as the laws for '<*>'--- imply a form of associativity.------ The superclass instances should satisfy the following:------  * In the 'Functor' instance, 'fmap' should be equivalent to traversal---    with the identity applicative functor ('fmapDefault').------  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be---    equivalent to traversal with a constant applicative functor---    ('foldMapDefault').----class (Functor t, Foldable t) => Traversable t where-    -- | Map each element of a structure to an action, evaluate-    -- these actions from left to right, and collect the results.-    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)-    traverse f = sequenceA . fmap f--    -- | Evaluate each action in the structure from left to right,-    -- and collect the results.-    sequenceA :: Applicative f => t (f a) -> f (t a)-    sequenceA = traverse id--    -- | Map each element of a structure to a monadic action, evaluate-    -- these actions from left to right, and collect the results.-    mapM :: Monad m => (a -> m b) -> t a -> m (t b)-    mapM f = unwrapMonad . traverse (WrapMonad . f)--    -- | Evaluate each monadic action in the structure from left to right,-    -- and collect the results.-    sequence :: Monad m => t (m a) -> m (t a)-    sequence = mapM id-    {-# MINIMAL traverse | sequenceA #-}---- instances for Prelude types--instance Traversable Maybe where-    traverse _ Nothing = pure Nothing-    traverse f (Just x) = Just <$> f x--instance Traversable [] where-    {-# INLINE traverse #-} -- so that traverse can fuse-    traverse f = Prelude.foldr cons_f (pure [])-      where cons_f x ys = (:) <$> f x <*> ys--    mapM = Prelude.mapM--instance Traversable (Either a) where-    traverse _ (Left x) = pure (Left x)-    traverse f (Right y) = Right <$> f y--instance Traversable ((,) a) where-    traverse f (x, y) = (,) x <$> f y--instance Ix i => Traversable (Array i) where-    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)--instance Traversable Proxy where-    traverse _ _ = pure Proxy-    {-# INLINE traverse #-}-    sequenceA _ = pure Proxy-    {-# INLINE sequenceA #-}-    mapM _ _ = return Proxy-    {-# INLINE mapM #-}-    sequence _ = return Proxy-    {-# INLINE sequence #-}--instance Traversable (Const m) where-    traverse _ (Const m) = pure $ Const m---- general functions---- | 'for' is 'traverse' with its arguments flipped.-for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)-{-# INLINE for #-}-for = flip traverse---- | 'forM' is 'mapM' with its arguments flipped.-forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)-{-# INLINE forM #-}-forM = flip mapM---- left-to-right state transformer-newtype StateL s a = StateL { runStateL :: s -> (s, a) }--instance Functor (StateL s) where-    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)--instance Applicative (StateL s) where-    pure x = StateL (\ s -> (s, x))-    StateL kf <*> StateL kv = StateL $ \ s ->-        let (s', f) = kf s-            (s'', v) = kv s'-        in (s'', f v)---- |The 'mapAccumL' function behaves like a combination of 'fmap'--- and 'foldl'; it applies a function to each element of a structure,--- passing an accumulating parameter from left to right, and returning--- a final value of this accumulator together with the new structure.-mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s---- right-to-left state transformer-newtype StateR s a = StateR { runStateR :: s -> (s, a) }--instance Functor (StateR s) where-    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)--instance Applicative (StateR s) where-    pure x = StateR (\ s -> (s, x))-    StateR kf <*> StateR kv = StateR $ \ s ->-        let (s', v) = kv s-            (s'', f) = kf s'-        in (s'', f v)---- |The 'mapAccumR' function behaves like a combination of 'fmap'--- and 'foldr'; it applies a function to each element of a structure,--- passing an accumulating parameter from right to left, and returning--- a final value of this accumulator together with the new structure.-mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s---- | This function may be used as a value for `fmap` in a `Functor`---   instance, provided that 'traverse' is defined. (Using---   `fmapDefault` with a `Traversable` instance defined only by---   'sequenceA' will result in infinite recursion.)-fmapDefault :: Traversable t => (a -> b) -> t a -> t b-{-# INLINE fmapDefault #-}-fmapDefault f = getId . traverse (Id . f)---- | This function may be used as a value for `Data.Foldable.foldMap`--- in a `Foldable` instance.-foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m-foldMapDefault f = getConst . traverse (Const . f)---- local instances--newtype Id a = Id { getId :: a }--instance Functor Id where-    fmap f (Id x) = Id (f x)--instance Applicative Id where-    pure = Id-    Id f <*> Id x = Id (f x)-
− tests/examples/ghc710/Undefined5.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE QuasiQuotes #-}-module Algebra.Ring.Polynomial.Parser ( monomial, expression, variable, variableWithPower-                                      , number, integer, natural, parsePolyn) where-import           Algebra.Ring.Polynomial.Monomorphic-import           Control.Applicative                 hiding (many)-import qualified Data.Map                            as M-import           Data.Ratio-import qualified Numeric.Algebra as NA-import           Text.Peggy--[peggy|-expression :: Polynomial Rational-  = expr !.--letter :: Char-  = [a-zA-Z]--variable :: Variable-  = letter ('_' integer)? { Variable $1 (fromInteger <$> $2) }--variableWithPower :: (Variable, Integer)-  = variable "^" natural { ($1, $2) }-  / variable  { ($1, 1) }--expr :: Polynomial Rational-  = expr "+" term { $1 + $2 }-  / expr "-" term { $1 - $2 }-  / term--term :: Polynomial Rational-   = number space* monoms { injectCoeff $1 * $3 }-   / number { injectCoeff $1 }-   / monoms--monoms :: Polynomial Rational-  = monoms space * fact { $1 * $3 }-  / fact--fact :: Polynomial Rational-  = fact "^" natural { $1 ^ $2 }-  / "(" expr ")"-  / monomial { toPolyn [($1, 1)] }--monomial :: Monomial-  = variableWithPower+ { M.fromListWith (+) $1 }--number :: Rational-  = integer "/" integer { $1 % $2 }-  / integer '.' [0-9]+ { realToFrac (read (show $1 ++ '.' : $2) :: Double) }-  / integer { fromInteger $1 }--integer :: Integer-  = "-" natural { negate $1 }-  / natural--natural :: Integer-  = [1-9] [0-9]* { read ($1 : $2) }--|]--toPolyn :: [(Monomial, Ratio Integer)] -> Polynomial (Ratio Integer)-toPolyn = normalize . Polynomial . M.fromList--parsePolyn :: String -> Either ParseError (Polynomial Rational)-parsePolyn = parseString expression "polynomial"
− tests/examples/ghc710/Undefined6.hs 
@@ -1,238 +0,0 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses-           , TypeFamilies #-}--module Vision.Image.Class (-    -- * Classes-      Pixel (..), MaskedImage (..), Image (..), ImageChannel, FromFunction (..)-    , FunctorImage (..)-    -- * Functions-    , (!), (!?), nChannels, pixel-    -- * Conversion-    , Convertible (..), convert-    ) where--import Data.Convertible (Convertible (..), convert)-import Data.Int-import Data.Vector.Storable (Vector, generate, unfoldr)-import Data.Word-import Foreign.Storable (Storable)-import Prelude hiding (map, read)--import Vision.Primitive (-      Z (..), (:.) (..), Point, Size-    , fromLinearIndex, toLinearIndex, shapeLength-    )---- Classes ------------------------------------------------------------------------- | Determines the number of channels and the type of each pixel of the image--- and how images are represented.-class Pixel p where-    type PixelChannel p--    -- | Returns the number of channels of the pixel.-    ---    -- Must not consume 'p' (could be 'undefined').-    pixNChannels :: p -> Int--    pixIndex :: p -> Int -> PixelChannel p--instance Pixel Int16 where-    type PixelChannel Int16 = Int16-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Int32 where-    type PixelChannel Int32 = Int32-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Int where-    type PixelChannel Int = Int-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word8 where-    type PixelChannel Word8 = Word8-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word16 where-    type PixelChannel Word16 = Word16-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word32 where-    type PixelChannel Word32 = Word32-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word where-    type PixelChannel Word = Word-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Float where-    type PixelChannel Float = Float-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Double where-    type PixelChannel Double = Double-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Bool where-    type PixelChannel Bool = Bool-    pixNChannels _   = 1-    pixIndex     p _ = p---- | Provides an abstraction for images which are not defined for each of their--- pixels. The interface is similar to 'Image' except that indexing functions--- don't always return.------ Image origin (@'ix2' 0 0@) is located in the upper left corner.-class Storable (ImagePixel i) => MaskedImage i where-    type ImagePixel i--    shape :: i -> Size--    -- | Returns the pixel\'s value at 'Z :. y, :. x'.-    maskedIndex :: i -> Point -> Maybe (ImagePixel i)-    maskedIndex img = (img `maskedLinearIndex`) . toLinearIndex (shape img)-    {-# INLINE maskedIndex #-}--    -- | Returns the pixel\'s value as if the image was a single dimension-    -- vector (row-major representation).-    maskedLinearIndex :: i -> Int -> Maybe (ImagePixel i)-    maskedLinearIndex img = (img `maskedIndex`) . fromLinearIndex (shape img)-    {-# INLINE maskedLinearIndex #-}--    -- | Returns the non-masked values of the image.-    values :: i -> Vector (ImagePixel i)-    values !img =-        unfoldr step 0-      where-        !n = shapeLength (shape img)--        step !i | i >= n                              = Nothing-                | Just p <- img `maskedLinearIndex` i = Just (p, i + 1)-                | otherwise                           = step (i + 1)-    {-# INLINE values #-}--    {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-}--type ImageChannel i = PixelChannel (ImagePixel i)---- | Provides an abstraction over the internal representation of an image.------ Image origin is located in the lower left corner.-class MaskedImage i => Image i where-    -- | Returns the pixel value at 'Z :. y :. x'.-    index :: i -> Point -> ImagePixel i-    index img = (img `linearIndex`) . toLinearIndex (shape img)-    {-# INLINE index #-}--    -- | Returns the pixel value as if the image was a single dimension vector-    -- (row-major representation).-    linearIndex :: i -> Int -> ImagePixel i-    linearIndex img = (img `index`) . fromLinearIndex (shape img)-    {-# INLINE linearIndex #-}--    -- | Returns every pixel values as if the image was a single dimension-    -- vector (row-major representation).-    vector :: i -> Vector (ImagePixel i)-    vector img = generate (shapeLength $ shape img) (img `linearIndex`)-    {-# INLINE vector #-}--    {-# MINIMAL index | linearIndex #-}---- | Provides ways to construct an image from a function.-class FromFunction i where-    type FromFunctionPixel i--    -- | Generates an image by calling the given function for each pixel of the-    -- constructed image.-    fromFunction :: Size -> (Point -> FromFunctionPixel i) -> i--    -- | Generates an image by calling the last function for each pixel of the-    -- constructed image.-    ---    -- The first function is called for each line, generating a line invariant-    -- value.-    ---    -- This function is faster for some image representations as some recurring-    -- computation can be cached.-    fromFunctionLine :: Size -> (Int -> a)-                     -> (a -> Point -> FromFunctionPixel i) -> i-    fromFunctionLine size line f =-        fromFunction size (\pt@(Z :. y :. _) -> f (line y) pt)-    {-# INLINE fromFunctionLine #-}--    -- | Generates an image by calling the last function for each pixel of the-    -- constructed image.-    ---    -- The first function is called for each column, generating a column-    -- invariant value.-    ---    -- This function *can* be faster for some image representations as some-    -- recurring computations can be cached. However, it may requires a vector-    -- allocation for these values. If the column invariant is cheap to-    -- compute, prefer 'fromFunction'.-    fromFunctionCol :: Storable b => Size -> (Int -> b)-                    -> (b -> Point -> FromFunctionPixel i) -> i-    fromFunctionCol size col f =-        fromFunction size (\pt@(Z :. _ :. x) -> f (col x) pt)-    {-# INLINE fromFunctionCol #-}--    -- | Generates an image by calling the last function for each pixel of the-    -- constructed image.-    ---    -- The two first functions are called for each line and for each column,-    -- respectively, generating common line and column invariant values.-    ---    -- This function is faster for some image representations as some recurring-    -- computation can be cached. However, it may requires a vector-    -- allocation for column values. If the column invariant is cheap to-    -- compute, prefer 'fromFunctionLine'.-    fromFunctionCached :: Storable b => Size-                       -> (Int -> a)               -- ^ Line function-                       -> (Int -> b)               -- ^ Column function-                       -> (a -> b -> Point-                           -> FromFunctionPixel i) -- ^ Pixel function-                       -> i-    fromFunctionCached size line col f =-        fromFunction size (\pt@(Z :. y :. x) -> f (line y) (col x) pt)-    {-# INLINE fromFunctionCached #-}--    {-# MINIMAL fromFunction #-}---- | Defines a class for images on which a function can be applied. The class is--- different from 'Functor' as there could be some constraints and--- transformations the pixel and image types.-class (MaskedImage src, MaskedImage res) => FunctorImage src res where-    map :: (ImagePixel src -> ImagePixel res) -> src -> res---- Functions ----------------------------------------------------------------------- | Alias of 'maskedIndex'.-(!?) :: MaskedImage i => i -> Point -> Maybe (ImagePixel i)-(!?) = maskedIndex-{-# INLINE (!?) #-}---- | Alias of 'index'.-(!) :: Image i => i -> Point -> ImagePixel i-(!) = index-{-# INLINE (!) #-}---- | Returns the number of channels of an image.-nChannels :: (Pixel (ImagePixel i), MaskedImage i) => i -> Int-nChannels img = pixNChannels (pixel img)-{-# INLINE nChannels #-}---- | Returns an 'undefined' instance of a pixel of the image. This is sometime--- useful to satisfy the type checker as in a call to 'pixNChannels' :------ > nChannels img = pixNChannels (pixel img)-pixel :: MaskedImage i => i -> ImagePixel i-pixel _ = undefined
− tests/examples/ghc710/Undefined7.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, StandaloneDeriving, DeriveDataTypeable #-}--module Test where--import Control.Applicative-import Control.Monad-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.Binary-import Data.Binary.Get-import Data.Binary.Put-import qualified Data.Map as M-import Data.Generics--import Data.Binary.ISO8583-import Data.Binary.ISO8583.TH--[binary|-  Message-  2 pan embedded 2-  4 amount int 12-  11 stan int 6-  43 termAddress TermAddress 222-|]--deriving instance Eq Message-deriving instance Show Message--data TermAddress = TermAddress {-      tOwner :: B.ByteString,-      tCity :: B.ByteString,-      tOther :: L.ByteString }-  deriving (Eq, Show, Typeable)--instance Binary TermAddress where-  -- NB: this implementation is smth odd and usable only for this testcase.-  get =-    TermAddress-      <$> B.filter (/= 0x20) `fmap` getByteString 30-      <*> B.filter (/= 0x20) `fmap` getByteString 30-      <*> L.filter (/= 0x20) `fmap` getRemainingLazyByteString--  put (TermAddress owner city other) = do-    putByteStringPad 30 owner-    putByteStringPad 30 city-    putLazyByteStringPad 162 other--instance Binary Message where-  get = do-    m <- getBitmap getMessage-    return $ constructMessage m--  put msg = do-    putBitmap' (putMessage msg)--testMsg :: Message-testMsg = Message {-  pan = Just $ toBS "12345678",-  amount = Just $ 100500,-  stan = Just $ 123456,-  termAddress = Just $ TermAddress {-                  tOwner = toBS "TestBank",-                  tCity = toBS "Magnitogorsk",-                  tOther = L.empty }-}--test :: IO ()-test = do-  let bstr = encode testMsg-      msg = decode bstr-  if msg /= testMsg-    then fail $ "Encode/decode mismatch:\n" ++-           show testMsg ++ "\n /= \n" ++-           show msg-    else putStrLn "passed."-
− tests/examples/ghc710/Undefined8.hs 
@@ -1,134 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, PackageImports #-}--module Text.Markdown.Pap.Parser (-    parseMrd-) where--import Control.Arrow-import "monads-tf" Control.Monad.State-import "monads-tf" Control.Monad.Error-import Data.Maybe-import Data.Char-import Text.Papillon--import Text.Markdown.Pap.Text--parseMrd :: String -> Maybe [Text]-parseMrd src = case flip runState (0, [- 1]) $ runErrorT $ markdown $ parse src of-    (Right (r, _), _) -> Just r-    _ -> Nothing--clear :: State (Int, [Int]) Bool-clear = put (0, [- 1]) >> return True--reset :: State (Int, [Int]) Bool-reset = modify (first $ const 0) >> return True--count :: State (Int, [Int]) ()-count = modify $ first (+ 1)--deeper :: State (Int, [Int]) Bool-deeper = do-    (n, n0 : ns) <- get-    if n > n0 then put (n, n : n0 : ns) >> return True else return False--same :: State (Int, [Int]) Bool-same = do-    (n, n0 : _) <- get-    return $ n == n0--shallow :: State (Int, [Int]) Bool-shallow = do-    (n, n0 : ns) <- get-    if n < n0 then put (n, ns) >> return True else return False--[papillon|--monad: State (Int, [Int])--markdown :: [Text]-    = md:(m:markdown1 _:dmmy[clear] { return m })*      { return md }--markdown1 :: Text-    = h:header              { return h }-    / l:link '\n'*              { return l }-    / i:image '\n'*             { return i }-    / l:list '\n'*              { return $ List l }-    / c:code                { return $ Code c }-    / p:paras               { return $ Paras p }--header :: Text-    = n:sharps _:<isSpace>* l:line '\n'+    { return $ Header n l }-    / l:line '\n' _:equals '\n'+        { return $ Header 1 l }-    / l:line '\n' _:hyphens '\n'+       { return $ Header 2 l }--sharps :: Int-    = '#' n:sharps              { return $ n + 1 }-    / '#'                   { return 1 }--equals :: ()-    = '=' _:equals-    / '='--hyphens :: ()-    = '-' _:hyphens-    / '-'--line :: String-    = l:<(`notElem` "#\n")>+        { return l }--line' :: String-    = l:<(`notElem` "\n")>+         { return l }--code :: String-    = l:fourSpacesLine c:code       { return $ l ++ c }-    / l:fourSpacesLine          { return l }--fourSpacesLine :: String-    = _:fourSpaces l:line' ns:('\n' { return '\n' })+   { return $ l ++ ns }--fourSpaces :: ()-    = ' ' ' ' ' ' ' '--list :: List = _:cnt _:dmmy[deeper] l:list1 ls:list1'* _:shllw  { return $ l : ls }--cnt :: () = _:dmmy[reset] _:(' ' { count })*--list1' :: List1-    = _:cnt _:dmmy[same] l:list1        { return l }--list1 :: List1-    = _:listHead ' ' l:line '\n' ls:list?-        { return $ BulItem l $ fromMaybe [] ls }-    / _:nListHead ' ' l:line '\n' ls:list?-        { return $ OrdItem l $ fromMaybe [] ls }--listHead :: ()-    = '*' / '-' / '+'--nListHead :: ()-    = _:<isDigit>+ '.'--paras :: [String]-    = ps:para+              { return ps }--para :: String-    = ls:(!_:('!') !_:listHead !_:nListHead !_:header !_:fourSpaces l:line '\n' { return l })+ _:('\n' / !_ / !_:para)-                        { return $ unwords ls }--shllw :: ()-    = _:dmmy[shallow]-    / !_-    / !_:list--dmmy :: () =--link :: Text-    = '[' t:<(/= ']')>+ ']' ' '* '(' a:<(/= ')')>+ ')' { return $ Link t a "" }--image :: Text-    = '!' '[' alt:<(/= ']')>+ ']' ' '* '(' addrs:<(`notElem` ")\" ")>+ ' '*-        '"' t:<(/= '"')>+ '"' ')'-        { return $ Image alt addrs t }--|]
− tests/examples/ghc710/Undefined9.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies #-}--module Image.PNG (isPNG, pngSize) where--import Data.Maybe-import File.Binary.PNG-import File.Binary-import File.Binary.Instances-import File.Binary.Instances.BigEndian--isPNG :: String -> Bool-isPNG img = isJust (fromBinary () img :: Maybe (PNGHeader, String))--pngSize :: String -> Maybe (Double, Double)-pngSize src = case getChunks src of-    Right cs -> Just-        (fromIntegral $ width $ ihdr cs, fromIntegral $ height $ ihdr cs)-    _ -> Nothing--[binary|--PNGHeader deriving Show--1: 0x89-3: "PNG"-2: "\r\n"-1: "\SUB"-1: "\n"--|]
− tests/examples/ghc710/Unicode.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE UnicodeSyntax #-}--module Unicode where--import Control.Monad.Trans.State.Strict---- | We'll start off with a monad in which to manipulate ABTs; we'll need some--- state for fresh variable generation.----newtype M α-  = M-  { _M ∷ State Int α-  }---- | We'll run an ABT computation by starting the variable counter at @0@.----runM ∷ M α → α-runM (M m) = evalState m 0----- | To indicate that a term is in normal form.----stepsExhausted-  ∷ Applicative m-  ⇒ StepT m α-stepsExhausted = StepT . MaybeT $ pure Nothing--stepsExhausted2-  ∷ Applicative m-  => m α-stepsExhausted2 = undefined
− tests/examples/ghc710/UnicodeSyntaxFailure.hs 
@@ -1,3 +0,0 @@-{-# LANGUAGE UnicodeSyntax #-}--foo x = addToEnv (∀)
− tests/examples/ghc710/Utilities.hs 
@@ -1,17 +0,0 @@-module Utilities (toBinary, fl) where--import Stream-import Data.Ratio---- Convert from an Integer to its signed-digit representation-toBinary :: Integer -> Stream-toBinary 0 = [0]-toBinary x = toBinary t ++ [x `mod` 2]-             where t = x `div` 2----fl :: Stream -> Stream-fl (x:xs) = (f x):xs-          where f 0 = 1-                f 1 = 0
− tests/examples/ghc710/Utils2.hs 
@@ -1,86 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE StandaloneDeriving #-}-module Utils2 where---import Control.Applicative (Applicative(..))-import Control.Monad (when, liftM, ap)-import Control.Exception-import Data.Data-import Data.List-import Data.Maybe-import Data.Monoid---- import Language.Haskell.GHC.ExactPrint.Utils-import Language.Haskell.GHC.ExactPrint.Types hiding (showGhc)--import qualified Bag            as GHC-import qualified BasicTypes     as GHC-import qualified BooleanFormula as GHC-import qualified Class          as GHC-import qualified CoAxiom        as GHC-import qualified DynFlags       as GHC-import qualified FastString     as GHC-import qualified ForeignCall    as GHC-import qualified GHC            as GHC-import qualified GHC.Paths      as GHC-import qualified Lexer          as GHC-import qualified Name           as GHC-import qualified NameSet        as GHC-import qualified Outputable     as GHC-import qualified RdrName        as GHC-import qualified SrcLoc         as GHC-import qualified StringBuffer   as GHC-import qualified UniqSet        as GHC-import qualified Unique         as GHC-import qualified Var            as GHC--import qualified Data.Map as Map---- -----------------------------------------------------------------------instance AnnotateP GHC.RdrName where-  annotateP l n = do-    case rdrName2String n of-      "[]" -> do-        addDeltaAnnotation GHC.AnnOpenS -- '[' nonBUG-        addDeltaAnnotation GHC.AnnCloseS -- ']' BUG-      "()" -> do-        addDeltaAnnotation GHC.AnnOpenP -- '('-        addDeltaAnnotation GHC.AnnCloseP -- ')'-      "(##)" -> do-        addDeltaAnnotation GHC.AnnOpen -- '(#'-        addDeltaAnnotation GHC.AnnClose -- '#)'-      "[::]" -> do-        addDeltaAnnotation GHC.AnnOpen -- '[:'-        addDeltaAnnotation GHC.AnnClose -- ':]'-      _ ->  do-        addDeltaAnnotation GHC.AnnType-        addDeltaAnnotation GHC.AnnOpenP -- '('-        addDeltaAnnotationLs GHC.AnnBackquote 0-        addDeltaAnnotations GHC.AnnCommaTuple -- For '(,,,)'-        cnt <- countAnnsAP GHC.AnnVal-        cntT <- countAnnsAP GHC.AnnCommaTuple-        cntR <- countAnnsAP GHC.AnnRarrow-        case cnt of-          0 -> if cntT >0 || cntR >0 then return () else addDeltaAnnotationExt l GHC.AnnVal-          1 -> addDeltaAnnotation GHC.AnnVal-          x -> error $ "annotateP.RdrName: too many AnnVal :" ++ showGhc (l,x)-        addDeltaAnnotation GHC.AnnTildehsh-        addDeltaAnnotation GHC.AnnTilde-        addDeltaAnnotation GHC.AnnRarrow-        addDeltaAnnotationLs GHC.AnnBackquote 1-        addDeltaAnnotation GHC.AnnCloseP -- ')'--  -- temporary, for test-class (Typeable ast) => AnnotateP ast where-  annotateP :: GHC.SrcSpan -> ast -> IO ()--addDeltaAnnotation = undefined-addDeltaAnnotations = undefined-addDeltaAnnotationLs = undefined-addDeltaAnnotationExt = undefined-countAnnsAP = undefined-showGhc = undefined-rdrName2String = undefined-
− tests/examples/ghc710/ViewPatterns.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE ViewPatterns #-}---- From https://ghc.haskell.org/trac/ghc/wiki/ViewPatterns-import Prelude hiding (length)--data JList a = Empty-             | Single a-             | Join (JList a) (JList a)--data JListView a = Nil-                 | Cons a (JList a)---view :: JList a -> JListView a-view Empty = Nil-view (Single a) = Cons a Empty-view (Join (view -> Cons xh xt) y) = Cons xh $ Join xt y-view (Join (view -> Nil) y) = view y--length :: JList a -> Integer-length (view -> Nil) = 0-length (view -> Cons x xs) = 1 + length xs-
− tests/examples/ghc710/Warning.hs 
@@ -1,16 +0,0 @@--module Warning-{-# WARNINg ["This is a module warning",-             "multi-line"] #-}-  where--{-# Warning   foo ,  bar-         ["This is a multi-line",-          "deprecation message",-          "for foo"] #-}-foo :: Int-foo = 4--bar :: Char-bar = 'c'-
− tests/examples/ghc710/Zipper.hs 
@@ -1,168 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE Rank2Types #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Generics.Zipper--- Copyright   :  (c) Michael D. Adams, 2010--- License     :  BSD-style (see the LICENSE file)------ ``Scrap Your Zippers: A Generic Zipper for Heterogeneous Types.--- Michael D. Adams.  WGP '10: Proceedings of the 2010 ACM SIGPLAN--- workshop on Generic programming, 2010.''------ See <http://www.cs.indiana.edu/~adamsmd/papers/scrap_your_zippers/>-----------------------------------------------------------------------------------{-# OPTIONS -Wall #-}-{-# LANGUAGE Rank2Types, GADTs #-}--module Zipper where--import Data.Generics-import Control.Monad ((<=<), MonadPlus, mzero, mplus, liftM)-import Data.Maybe (fromJust)---- Core types---- | A generic zipper with a root object of type @root@.-data Zipper root =-  forall hole. (Data hole) =>-    Zipper hole (Context hole root)------ Internal types and functions-data Context hole root where-    CtxtNull :: Context a a-    CtxtCons ::-      forall hole root rights parent. (Data parent) =>-        Left (hole -> rights)-        -> Right rights parent-        -> Context parent root-        -> Context hole root--combine :: Left (hole -> rights)-         -> hole-         -> Right rights parent-         -> parent-combine lefts hole rights =-  fromRight ((fromLeft lefts) hole) rights--data Left expects-  = LeftUnit expects-  | forall b. (Data b) => LeftCons (Left (b -> expects)) b--toLeft :: (Data a) => a -> Left a-toLeft a = gfoldl LeftCons LeftUnit a--fromLeft :: Left r -> r-fromLeft (LeftUnit a)   = a-fromLeft (LeftCons f b) = fromLeft f b--data Right provides parent where-  RightNull :: Right parent parent-  RightCons ::-    (Data b) => b -> Right a t -> Right (b -> a) t--fromRight :: r -> Right r parent -> parent-fromRight f (RightNull)     = f-fromRight f (RightCons b r) = fromRight (f b) r---- | Apply a generic monadic transformation to the hole-transM :: (Monad m) => GenericM m -> Zipper a -> m (Zipper a)-transM f (Zipper hole ctxt) = do-  hole' <- f hole-  return (Zipper hole' ctxt)---- Generic zipper traversals----- Traversal helpers--- | A movement operation such as 'left', 'right', 'up', or 'down'.-type Move a = Zipper a -> Maybe (Zipper a)---- | Apply a generic query using the specified movement operation.-moveQ :: Move a -- ^ Move operation-      -> b -- ^ Default if can't move-      -> (Zipper a -> b) -- ^ Query if can move-      -> Zipper a -- ^ Zipper-      -> b-moveQ move b f z = case move z of-                     Nothing -> b-                     Just z' -> f z'---- | Repeatedly apply a monadic 'Maybe' generic transformation at the--- top-most, left-most position that the transformation returns--- 'Just'.  Behaves like iteratively applying 'zsomewhere' but is--- more efficient because it re-evaluates the transformation--- at only the parents of the last successful application.-zreduce :: GenericM Maybe -> Zipper a -> Zipper a-zreduce f z =-  case transM f z of-    Nothing ->-      downQ (g z) (zreduce f . leftmost) z where-        g z' = rightQ (upQ z' g z') (zreduce f) z'-    Just x  -> zreduce f (reduceAncestors1 f x x)--reduceAncestors1 ::-  GenericM Maybe -> Zipper a -> Zipper a -> Zipper a-reduceAncestors1 f z def = upQ def g z where-  g z' = reduceAncestors1 f z' def' where-    def' = case transM f z' of-             Nothing -> def-             Just x  -> reduceAncestors1 f x x-------- Query--- | Apply a generic query to the left sibling if one exists.-leftQ :: b -- ^ Value to return of no left sibling exists.-      -> (Zipper a -> b) -> Zipper a -> b-leftQ b f z = moveQ left b f z---- | Apply a generic query to the right sibling if one exists.-rightQ :: b -- ^ Value to return if no right sibling exists.-       -> (Zipper a -> b) -> Zipper a -> b-rightQ b f z = moveQ right b f z---- | Apply a generic query to the parent if it exists.-downQ :: b -- ^ Value to return if no children exist.-      -> (Zipper a -> b) -> Zipper a -> b-downQ b f z = moveQ down b f z---- | Apply a generic query to the rightmost child if one exists.-upQ :: b -- ^ Value to return if parent does not exist.-    -> (Zipper a -> b) -> Zipper a -> b-upQ b f z = moveQ up b f z------ Basic movement---- | Move left.  Returns 'Nothing' iff already at leftmost sibling.-left  :: Zipper a -> Maybe (Zipper a)-left (Zipper _ CtxtNull) = Nothing-left (Zipper _ (CtxtCons (LeftUnit _) _ _)) = Nothing-left (Zipper h (CtxtCons (LeftCons l h') r c)) =-  Just (Zipper h' (CtxtCons l (RightCons h r) c))---- | Move right.  Returns 'Nothing' iff already at rightmost sibling.-right :: Zipper a -> Maybe (Zipper a)-right (Zipper _ CtxtNull) = Nothing-right (Zipper _ (CtxtCons _ RightNull _)) = Nothing-right (Zipper h (CtxtCons l (RightCons h' r) c)) =-  Just (Zipper h' (CtxtCons (LeftCons l h) r c))---- | Move down.  Moves to rightmost immediate child.  Returns 'Nothing' iff at a leaf and thus no children exist.-down  :: Zipper a -> Maybe (Zipper a)-down (Zipper hole ctxt) =-  case toLeft hole of-    LeftUnit _ -> Nothing-    LeftCons l hole' ->-      Just (Zipper hole' (CtxtCons l RightNull ctxt))---- | Move up.  Returns 'Nothing' iff already at root and thus no parent exists.-up    :: Zipper a -> Maybe (Zipper a)-up (Zipper _ CtxtNull) = Nothing-up (Zipper hole (CtxtCons l r ctxt)) =-  Just (Zipper (combine l hole r) ctxt)-------- Movement--- | Move to the leftmost sibling.-leftmost :: Zipper a -> Zipper a-leftmost z = leftQ z leftmost z-
− tests/examples/ghc710/read018.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE DatatypeContexts #-}--- !!! Checking that empty contexts are permitted.-module ShouldCompile where--data () => Foo a = Foo a--newtype () => Bar = Bar Int--f :: () => Int -> Int-f = (+1)---class () => Fob a where--instance () => Fob Int where-instance () => Fob Float-
− tests/examples/ghc80/A.hs 
@@ -1,4 +0,0 @@-module A where--class A a where-  has :: a
− tests/examples/ghc80/AddParams2.hs 
@@ -1,9 +0,0 @@-module AddParams2 where--collapse rightInner rightOuter = right-  where-    right           = (rightInner, rightOuter)-    righ2           = (rightInner, (rightOuter baz bar))--baz = undefined-bar = undefined
− tests/examples/ghc80/Associated.hs 
@@ -1,9 +0,0 @@-module Associated(A(..)) where--import AssociatedInternal (A(..))--foo = MkA 5-baz = NoA--qux (MkA x) = x-qux NoA = 0
− tests/examples/ghc80/AssociatedInternal.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-module AssociatedInternal (A(NewA,MkA, NoA)) where--newtype A = NewA (Maybe Int)--pattern MkA n = NewA (Just n)--pattern NoA = NewA Nothing
− tests/examples/ghc80/B.hs 
@@ -1,4 +0,0 @@-module B where--class B a where-  has :: a
− tests/examples/ghc80/Base.hs 
@@ -1,6 +0,0 @@-module Base (AClass(..), BClass()) where--import Extends (BClass ())--class AClass a where-  has :: a
− tests/examples/ghc80/Bundle.hs 
@@ -1,9 +0,0 @@-module Bundle(A(..)) where--import BundleInternal (A(..))--foo = MkA 5-baz = NoA--qux (MkA x) = x-qux NoA = 0
− tests/examples/ghc80/Bundle1.hs 
@@ -1,9 +0,0 @@-module Associated1(A(..)) where--import BundleInternal1 (A(..))--foo = MkA 5-baz = NoA--qux (MkA x) = x-qux NoA = 0
− tests/examples/ghc80/BundleExport.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-module BundleExport(P(.., A), Q(B)) where--data P = P--data Q = Q--pattern A = P-pattern B = Q
− tests/examples/ghc80/BundleInternal.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-module BundleInternal (A(NewA,MkA, NoA)) where--newtype A = NewA (Maybe Int)--pattern MkA n = NewA (Just n)--pattern NoA = NewA Nothing
− tests/examples/ghc80/BundleInternal1.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-module BundleInternal1 (A(NewA,MkA, NoA)) where--newtype A = NewA (Maybe Int)--pattern MkA n = NewA (Just n)--pattern NoA = NewA Nothing
− tests/examples/ghc80/C.hs 
@@ -1,3 +0,0 @@-module C (oops) where--import {-# SOURCE #-} B
− tests/examples/ghc80/CheckUtils.hs 
@@ -1,117 +0,0 @@-{-# LANGUAGE RankNTypes #-}---- This program must be called with GHC's libdir and the file to be checked as--- the command line arguments.-module CheckUtils where--import Data.Data-import Data.List-import System.IO-import GHC-import BasicTypes-import DynFlags-import MonadUtils-import Outputable-import ApiAnnotation-import Bag (filterBag,isEmptyBag)-import System.Directory (removeFile)-import System.Environment( getArgs )-import qualified Data.Map as Map-import qualified Data.Set as Set-import Data.Dynamic ( fromDynamic,Dynamic )--_main::IO()-_main = do-        [libdir,fileName] <- getArgs-        testOneFile libdir fileName--testOneFile libdir fileName = do-       ((anns,cs),p) <- runGhc (Just libdir) $ do-                        dflags <- getSessionDynFlags-                        setSessionDynFlags dflags-                        let mn =mkModuleName fileName-                        addTarget Target { targetId = TargetModule mn-                                         , targetAllowObjCode = True-                                         , targetContents = Nothing }-                        load LoadAllTargets-                        modSum <- getModSummary mn-                        p <- parseModule modSum-                        return (pm_annotations p,p)--       let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)--           problems = filter (\(s,a) -> not (Set.member s spans))-                             $ getAnnSrcSpans (anns,cs)--           exploded = [((kw,ss),[anchor])-                      | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]--           exploded' = Map.toList $ Map.fromListWith (++) exploded--           problems' = filter (\(_,anchors)-                                -> not (any (\a -> Set.member a spans) anchors))-                              exploded'--       putStrLn "---Problems---------------------"-       putStrLn (intercalate "\n" [showAnns $ Map.fromList $ map snd problems])-       putStrLn "---Problems'--------------------"-       putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'])-       putStrLn "--------------------------------"-       putStrLn (intercalate "\n" [showAnns anns])--    where-      getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))]-      getAnnSrcSpans (anns,_) = map (\a@((ss,_),_) -> (ss,a)) $ Map.toList anns--      getAllSrcSpans :: (Data t) => t -> [SrcSpan]-      getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast-        where-          getSrcSpan :: SrcSpan -> [SrcSpan]-          getSrcSpan ss = [ss]---showAnns anns = "[\n" ++ (intercalate "\n"-   $ map (\((s,k),v)-              -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))-   $ Map.toList anns)-    ++ "]\n"--pp a = showPpr unsafeGlobalDynFlags a----- ------------------------------------------------------------------------- Copied from syb for the test----- | Generic queries of type \"r\",---   i.e., take any \"a\" and return an \"r\"----type GenericQ r = forall a. Data a => a -> r----- | Make a generic query;---   start from a type-specific case;---   return a constant otherwise----mkQ :: ( Typeable a-       , Typeable b-       )-    => r-    -> (b -> r)-    -> a-    -> r-(r `mkQ` br) a = case cast a of-                        Just b  -> br b-                        Nothing -> r------ | Summarise all nodes in top-down, left-to-right order-everything :: (r -> r -> r) -> GenericQ r -> GenericQ r---- Apply f to x to summarise top-level node;--- use gmapQ to recurse into immediate subterms;--- use ordinary foldl to reduce list of intermediate results--everything k f x = foldl k (f x) (gmapQ (everything k f) x)
− tests/examples/ghc80/Class.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-module Servant.Auth.Server.Internal.Class where--import Servant.Auth-import Data.Monoid-import Servant hiding (BasicAuth)--import Servant.Auth.Server.Internal.Types-import Servant.Auth.Server.Internal.ConfigTypes-import Servant.Auth.Server.Internal.BasicAuth-import Servant.Auth.Server.Internal.Cookie-import Servant.Auth.Server.Internal.JWT---- | @IsAuth a ctx v@ indicates that @a@ is an auth type that expects all--- elements of @ctx@ to be the in the Context and whose authentication check--- returns an @AuthCheck v@.-class IsAuth a v  where-  type family AuthArgs a :: [*]-  runAuth :: proxy a -> proxy v -> Unapp (AuthArgs a) (AuthCheck v)-
− tests/examples/ghc80/ClosedFam1a.hs 
@@ -1,3 +0,0 @@-module ClosedFam1a where--import {-# SOURCE #-} ClosedFam1
− tests/examples/ghc80/ClosedFam2a.hs 
@@ -1,2 +0,0 @@-module ClosedFam2a where-import {-# SOURCE #-} ClosedFam2
− tests/examples/ghc80/ClosedFam3a.hs 
@@ -1,3 +0,0 @@-module ClosedFam3a where--import {-# SOURCE #-} ClosedFam3
− tests/examples/ghc80/CmmSwitchTest.hs 
@@ -1,505 +0,0 @@-{-# LANGUAGE MagicHash #-}-import Control.Monad (unless, forM_)-import GHC.Exts-{-# NOINLINE aa #-}-aa :: Int# -> Int#-aa 1# = 42#-aa 2# = 43#-aa 3# = 43#-aa 4# = 44#-aa 5# = 44#-aa 6# = 45#-aa 7# = 45#-aa 8# = 46#-aa 9# = 46#-aa 10# = 47#-aa _ = 1337#--{-# NOINLINE ab #-}-ab :: Int# -> Int#-ab 0# = 42#-ab 1# = 42#-ab 2# = 43#-ab 3# = 43#-ab 4# = 44#-ab 5# = 44#-ab 6# = 45#-ab 7# = 45#-ab 8# = 46#-ab 9# = 46#-ab 10# = 47#-ab _ = 1337#--{-# NOINLINE ac #-}-ac :: Int# -> Int#-ac 1# = 42#-ac 2# = 43#-ac 3# = 43#-ac _ = 1337#--{-# NOINLINE ad #-}-ad :: Int# -> Int#-ad 1# = 42#-ad 2# = 43#-ad 3# = 43#-ad 4# = 44#-ad _ = 1337#--{-# NOINLINE ae #-}-ae :: Int# -> Int#-ae 1# = 42#-ae 2# = 43#-ae 3# = 43#-ae 4# = 44#-ae 5# = 44#-ae _ = 1337#--{-# NOINLINE af #-}-af :: Int# -> Int#-af -1# = 41#-af 0# = 42#-af 1# = 42#-af 2# = 43#-af 3# = 43#-af 4# = 44#-af 5# = 44#-af 6# = 45#-af 7# = 45#-af 8# = 46#-af 9# = 46#-af 10# = 47#-af _ = 1337#--{-# NOINLINE ag #-}-ag :: Int# -> Int#-ag -10# = 37#-ag -9# = 37#-ag -8# = 38#-ag -7# = 38#-ag -6# = 39#-ag -5# = 39#-ag -4# = 40#-ag -3# = 40#-ag -2# = 41#-ag -1# = 41#-ag 0# = 42#-ag 1# = 42#-ag 2# = 43#-ag 3# = 43#-ag 4# = 44#-ag 5# = 44#-ag 6# = 45#-ag 7# = 45#-ag 8# = 46#-ag 9# = 46#-ag 10# = 47#-ag _ = 1337#--{-# NOINLINE ah #-}-ah :: Int# -> Int#-ah -20# = 32#-ah -19# = 32#-ah -18# = 33#-ah -17# = 33#-ah -16# = 34#-ah -15# = 34#-ah -14# = 35#-ah -13# = 35#-ah -12# = 36#-ah -11# = 36#-ah -10# = 37#-ah 0# = 42#-ah 1# = 42#-ah 2# = 43#-ah 3# = 43#-ah 4# = 44#-ah 5# = 44#-ah 6# = 45#-ah 7# = 45#-ah 8# = 46#-ah 9# = 46#-ah 10# = 47#-ah _ = 1337#--{-# NOINLINE ai #-}-ai :: Int# -> Int#-ai -20# = 32#-ai -19# = 32#-ai -18# = 33#-ai -17# = 33#-ai -16# = 34#-ai -15# = 34#-ai -14# = 35#-ai -13# = 35#-ai -12# = 36#-ai -11# = 36#-ai -10# = 37#-ai 1# = 42#-ai 2# = 43#-ai 3# = 43#-ai 4# = 44#-ai 5# = 44#-ai 6# = 45#-ai 7# = 45#-ai 8# = 46#-ai 9# = 46#-ai 10# = 47#-ai _ = 1337#--{-# NOINLINE aj #-}-aj :: Int# -> Int#-aj -9223372036854775808# = -4611686018427387862#-aj 0# = 42#-aj 9223372036854775807# = 4611686018427387945#-aj _ = 1337#--{-# NOINLINE ak #-}-ak :: Int# -> Int#-ak 9223372036854775797# = 4611686018427387940#-ak 9223372036854775798# = 4611686018427387941#-ak 9223372036854775799# = 4611686018427387941#-ak 9223372036854775800# = 4611686018427387942#-ak 9223372036854775801# = 4611686018427387942#-ak 9223372036854775802# = 4611686018427387943#-ak 9223372036854775803# = 4611686018427387943#-ak 9223372036854775804# = 4611686018427387944#-ak 9223372036854775805# = 4611686018427387944#-ak 9223372036854775806# = 4611686018427387945#-ak 9223372036854775807# = 4611686018427387945#-ak _ = 1337#--{-# NOINLINE al #-}-al :: Int# -> Int#-al -9223372036854775808# = -4611686018427387862#-al -9223372036854775807# = -4611686018427387862#-al -9223372036854775806# = -4611686018427387861#-al -9223372036854775805# = -4611686018427387861#-al -9223372036854775804# = -4611686018427387860#-al -9223372036854775803# = -4611686018427387860#-al -9223372036854775802# = -4611686018427387859#-al -9223372036854775801# = -4611686018427387859#-al -9223372036854775800# = -4611686018427387858#-al -9223372036854775799# = -4611686018427387858#-al -9223372036854775798# = -4611686018427387857#-al 9223372036854775797# = 4611686018427387940#-al 9223372036854775798# = 4611686018427387941#-al 9223372036854775799# = 4611686018427387941#-al 9223372036854775800# = 4611686018427387942#-al 9223372036854775801# = 4611686018427387942#-al 9223372036854775802# = 4611686018427387943#-al 9223372036854775803# = 4611686018427387943#-al 9223372036854775804# = 4611686018427387944#-al 9223372036854775805# = 4611686018427387944#-al 9223372036854775806# = 4611686018427387945#-al 9223372036854775807# = 4611686018427387945#-al _ = 1337#--{-# NOINLINE am #-}-am :: Word# -> Word#-am 0## = 42##-am 1## = 42##-am 2## = 43##-am 3## = 43##-am 4## = 44##-am 5## = 44##-am 6## = 45##-am 7## = 45##-am 8## = 46##-am 9## = 46##-am 10## = 47##-am _ = 1337##--{-# NOINLINE an #-}-an :: Word# -> Word#-an 1## = 42##-an 2## = 43##-an 3## = 43##-an 4## = 44##-an 5## = 44##-an 6## = 45##-an 7## = 45##-an 8## = 46##-an 9## = 46##-an 10## = 47##-an _ = 1337##--{-# NOINLINE ao #-}-ao :: Word# -> Word#-ao 0## = 42##-ao _ = 1337##--{-# NOINLINE ap #-}-ap :: Word# -> Word#-ap 0## = 42##-ap 1## = 42##-ap _ = 1337##--{-# NOINLINE aq #-}-aq :: Word# -> Word#-aq 0## = 42##-aq 1## = 42##-aq 2## = 43##-aq _ = 1337##--{-# NOINLINE ar #-}-ar :: Word# -> Word#-ar 0## = 42##-ar 1## = 42##-ar 2## = 43##-ar 3## = 43##-ar _ = 1337##--{-# NOINLINE as #-}-as :: Word# -> Word#-as 0## = 42##-as 1## = 42##-as 2## = 43##-as 3## = 43##-as 4## = 44##-as _ = 1337##--{-# NOINLINE at #-}-at :: Word# -> Word#-at 1## = 42##-at _ = 1337##--{-# NOINLINE au #-}-au :: Word# -> Word#-au 1## = 42##-au 2## = 43##-au _ = 1337##--{-# NOINLINE av #-}-av :: Word# -> Word#-av 1## = 42##-av 2## = 43##-av 3## = 43##-av _ = 1337##--{-# NOINLINE aw #-}-aw :: Word# -> Word#-aw 1## = 42##-aw 2## = 43##-aw 3## = 43##-aw 4## = 44##-aw _ = 1337##--{-# NOINLINE ax #-}-ax :: Word# -> Word#-ax 1## = 42##-ax 2## = 43##-ax 3## = 43##-ax 4## = 44##-ax 5## = 44##-ax _ = 1337##--{-# NOINLINE ay #-}-ay :: Word# -> Word#-ay 0## = 42##-ay 18446744073709551615## = 9223372036854775849##-ay _ = 1337##--{-# NOINLINE az #-}-az :: Word# -> Word#-az 18446744073709551605## = 9223372036854775844##-az 18446744073709551606## = 9223372036854775845##-az 18446744073709551607## = 9223372036854775845##-az 18446744073709551608## = 9223372036854775846##-az 18446744073709551609## = 9223372036854775846##-az 18446744073709551610## = 9223372036854775847##-az 18446744073709551611## = 9223372036854775847##-az 18446744073709551612## = 9223372036854775848##-az 18446744073709551613## = 9223372036854775848##-az 18446744073709551614## = 9223372036854775849##-az 18446744073709551615## = 9223372036854775849##-az _ = 1337##--{-# NOINLINE ba #-}-ba :: Word# -> Word#-ba 0## = 42##-ba 1## = 42##-ba 2## = 43##-ba 3## = 43##-ba 4## = 44##-ba 5## = 44##-ba 6## = 45##-ba 7## = 45##-ba 8## = 46##-ba 9## = 46##-ba 10## = 47##-ba 18446744073709551605## = 9223372036854775844##-ba 18446744073709551606## = 9223372036854775845##-ba 18446744073709551607## = 9223372036854775845##-ba 18446744073709551608## = 9223372036854775846##-ba 18446744073709551609## = 9223372036854775846##-ba 18446744073709551610## = 9223372036854775847##-ba 18446744073709551611## = 9223372036854775847##-ba 18446744073709551612## = 9223372036854775848##-ba 18446744073709551613## = 9223372036854775848##-ba 18446744073709551614## = 9223372036854775849##-ba 18446744073709551615## = 9223372036854775849##-ba _ = 1337##--aa_check :: IO ()-aa_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do-   let r = I# (aa i)-   unless (r == o) $ putStrLn $ "ERR: aa (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ab_check :: IO ()-ab_check = forM_ [(-1,1337), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do-   let r = I# (ab i)-   unless (r == o) $ putStrLn $ "ERR: ab (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ac_check :: IO ()-ac_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,1337)] $ \(I# i,o) -> do-   let r = I# (ac i)-   unless (r == o) $ putStrLn $ "ERR: ac (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ad_check :: IO ()-ad_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,1337)] $ \(I# i,o) -> do-   let r = I# (ad i)-   unless (r == o) $ putStrLn $ "ERR: ad (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ae_check :: IO ()-ae_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,1337)] $ \(I# i,o) -> do-   let r = I# (ae i)-   unless (r == o) $ putStrLn $ "ERR: ae (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--af_check :: IO ()-af_check = forM_ [(-2,1337), (-1,41), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do-   let r = I# (af i)-   unless (r == o) $ putStrLn $ "ERR: af (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ag_check :: IO ()-ag_check = forM_ [(-11,1337), (-10,37), (-9,37), (-8,38), (-7,38), (-6,39), (-5,39), (-4,40), (-3,40), (-2,41), (-1,41), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do-   let r = I# (ag i)-   unless (r == o) $ putStrLn $ "ERR: ag (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ah_check :: IO ()-ah_check = forM_ [(-21,1337), (-20,32), (-19,32), (-18,33), (-17,33), (-16,34), (-15,34), (-14,35), (-13,35), (-12,36), (-11,36), (-10,37), (-9,1337), (-1,1337), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do-   let r = I# (ah i)-   unless (r == o) $ putStrLn $ "ERR: ah (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ai_check :: IO ()-ai_check = forM_ [(-21,1337), (-20,32), (-19,32), (-18,33), (-17,33), (-16,34), (-15,34), (-14,35), (-13,35), (-12,36), (-11,36), (-10,37), (-9,1337), (0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do-   let r = I# (ai i)-   unless (r == o) $ putStrLn $ "ERR: ai (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--aj_check :: IO ()-aj_check = forM_ [(-9223372036854775808,-4611686018427387862), (-9223372036854775807,1337), (-1,1337), (0,42), (1,1337), (9223372036854775806,1337), (9223372036854775807,4611686018427387945)] $ \(I# i,o) -> do-   let r = I# (aj i)-   unless (r == o) $ putStrLn $ "ERR: aj (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ak_check :: IO ()-ak_check = forM_ [(9223372036854775796,1337), (9223372036854775797,4611686018427387940), (9223372036854775798,4611686018427387941), (9223372036854775799,4611686018427387941), (9223372036854775800,4611686018427387942), (9223372036854775801,4611686018427387942), (9223372036854775802,4611686018427387943), (9223372036854775803,4611686018427387943), (9223372036854775804,4611686018427387944), (9223372036854775805,4611686018427387944), (9223372036854775806,4611686018427387945), (9223372036854775807,4611686018427387945)] $ \(I# i,o) -> do-   let r = I# (ak i)-   unless (r == o) $ putStrLn $ "ERR: ak (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--al_check :: IO ()-al_check = forM_ [(-9223372036854775808,-4611686018427387862), (-9223372036854775807,-4611686018427387862), (-9223372036854775806,-4611686018427387861), (-9223372036854775805,-4611686018427387861), (-9223372036854775804,-4611686018427387860), (-9223372036854775803,-4611686018427387860), (-9223372036854775802,-4611686018427387859), (-9223372036854775801,-4611686018427387859), (-9223372036854775800,-4611686018427387858), (-9223372036854775799,-4611686018427387858), (-9223372036854775798,-4611686018427387857), (-9223372036854775797,1337), (9223372036854775796,1337), (9223372036854775797,4611686018427387940), (9223372036854775798,4611686018427387941), (9223372036854775799,4611686018427387941), (9223372036854775800,4611686018427387942), (9223372036854775801,4611686018427387942), (9223372036854775802,4611686018427387943), (9223372036854775803,4611686018427387943), (9223372036854775804,4611686018427387944), (9223372036854775805,4611686018427387944), (9223372036854775806,4611686018427387945), (9223372036854775807,4611686018427387945)] $ \(I# i,o) -> do-   let r = I# (al i)-   unless (r == o) $ putStrLn $ "ERR: al (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--am_check :: IO ()-am_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(W# i,o) -> do-   let r = W# (am i)-   unless (r == o) $ putStrLn $ "ERR: am (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--an_check :: IO ()-an_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(W# i,o) -> do-   let r = W# (an i)-   unless (r == o) $ putStrLn $ "ERR: an (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ao_check :: IO ()-ao_check = forM_ [(0,42), (1,1337)] $ \(W# i,o) -> do-   let r = W# (ao i)-   unless (r == o) $ putStrLn $ "ERR: ao (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ap_check :: IO ()-ap_check = forM_ [(0,42), (1,42), (2,1337)] $ \(W# i,o) -> do-   let r = W# (ap i)-   unless (r == o) $ putStrLn $ "ERR: ap (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--aq_check :: IO ()-aq_check = forM_ [(0,42), (1,42), (2,43), (3,1337)] $ \(W# i,o) -> do-   let r = W# (aq i)-   unless (r == o) $ putStrLn $ "ERR: aq (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ar_check :: IO ()-ar_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,1337)] $ \(W# i,o) -> do-   let r = W# (ar i)-   unless (r == o) $ putStrLn $ "ERR: ar (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--as_check :: IO ()-as_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,44), (5,1337)] $ \(W# i,o) -> do-   let r = W# (as i)-   unless (r == o) $ putStrLn $ "ERR: as (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--at_check :: IO ()-at_check = forM_ [(0,1337), (1,42), (2,1337)] $ \(W# i,o) -> do-   let r = W# (at i)-   unless (r == o) $ putStrLn $ "ERR: at (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--au_check :: IO ()-au_check = forM_ [(0,1337), (1,42), (2,43), (3,1337)] $ \(W# i,o) -> do-   let r = W# (au i)-   unless (r == o) $ putStrLn $ "ERR: au (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--av_check :: IO ()-av_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,1337)] $ \(W# i,o) -> do-   let r = W# (av i)-   unless (r == o) $ putStrLn $ "ERR: av (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--aw_check :: IO ()-aw_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,1337)] $ \(W# i,o) -> do-   let r = W# (aw i)-   unless (r == o) $ putStrLn $ "ERR: aw (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ax_check :: IO ()-ax_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,1337)] $ \(W# i,o) -> do-   let r = W# (ax i)-   unless (r == o) $ putStrLn $ "ERR: ax (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ay_check :: IO ()-ay_check = forM_ [(0,42), (1,1337), (18446744073709551614,1337), (18446744073709551615,9223372036854775849)] $ \(W# i,o) -> do-   let r = W# (ay i)-   unless (r == o) $ putStrLn $ "ERR: ay (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--az_check :: IO ()-az_check = forM_ [(18446744073709551604,1337), (18446744073709551605,9223372036854775844), (18446744073709551606,9223372036854775845), (18446744073709551607,9223372036854775845), (18446744073709551608,9223372036854775846), (18446744073709551609,9223372036854775846), (18446744073709551610,9223372036854775847), (18446744073709551611,9223372036854775847), (18446744073709551612,9223372036854775848), (18446744073709551613,9223372036854775848), (18446744073709551614,9223372036854775849), (18446744073709551615,9223372036854775849)] $ \(W# i,o) -> do-   let r = W# (az i)-   unless (r == o) $ putStrLn $ "ERR: az (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--ba_check :: IO ()-ba_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337), (18446744073709551604,1337), (18446744073709551605,9223372036854775844), (18446744073709551606,9223372036854775845), (18446744073709551607,9223372036854775845), (18446744073709551608,9223372036854775846), (18446744073709551609,9223372036854775846), (18446744073709551610,9223372036854775847), (18446744073709551611,9223372036854775847), (18446744073709551612,9223372036854775848), (18446744073709551613,9223372036854775848), (18446744073709551614,9223372036854775849), (18446744073709551615,9223372036854775849)] $ \(W# i,o) -> do-   let r = W# (ba i)-   unless (r == o) $ putStrLn $ "ERR: ba (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"."--main = do-    aa_check-    ab_check-    ac_check-    ad_check-    ae_check-    af_check-    ag_check-    ah_check-    ai_check-    aj_check-    ak_check-    al_check-    am_check-    an_check-    ao_check-    ap_check-    aq_check-    ar_check-    as_check-    at_check-    au_check-    av_check-    aw_check-    ax_check-    ay_check-    az_check-    ba_check
− tests/examples/ghc80/CmmSwitchTestGen.hs 
@@ -1,115 +0,0 @@-{-# LANGUAGE TupleSections #-}---- Generates CmmSwitch.hs--import qualified Data.Set as S-import Data.Word-import Data.List--output :: Integer -> Integer-output n = n`div`2 + 42--def :: Integer-def = 1337--type Spec = (String, Bool, [Integer])--primtyp True = "Int#"-primtyp False = "Word#"--con True = "I#"-con False = "W#"--hash True = "#"-hash False = "##"--primLit s v = show v ++ hash s--genSwitch :: Spec -> String-genSwitch (name, signed, values) = unlines $-  [ "{-# NOINLINE " ++ name ++ " #-}" ] ++-  [ name ++ " :: " ++ primtyp signed ++ " -> " ++ primtyp signed ] ++-  [ name ++ " " ++ primLit signed v ++ " = " ++ primLit signed (output v)-  | v <- values] ++-  [ name ++ " _ = " ++ primLit signed def ]--genCheck :: Spec -> String-genCheck (name, signed, values) = unlines $-  [ checkName name ++ " :: IO ()"-  , checkName name ++ " = forM_ [" ++ pairs ++ "] $ \\(" ++ con signed ++ " i,o) -> do"-  , "   let r = " ++ con signed ++ " (" ++ name ++ " i)"-  , "   unless (r == o) $ putStrLn $ \"ERR: " ++ name ++ " (\" ++ show (" ++ con signed ++ " i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\""-  ]-  where-    f x | x `S.member` range = output x-        | otherwise          = def-    range = S.fromList values-    checkValues = S.toList $ S.fromList $-        [ v' | v <- values, v' <- [v-1,v,v+1],-               if signed then v' >= minS && v' <= maxS else v' >= minU && v' <= maxU ]-    pairs = intercalate ", " ["(" ++ show v ++ "," ++ show (f v) ++ ")" | v <- checkValues ]--checkName :: String -> String-checkName f = f ++ "_check"--genMain :: [Spec] -> String-genMain specs = unlines $ "main = do" : [ "    " ++ checkName n | (n,_,_) <- specs ]--genMod :: [Spec] -> String-genMod specs = unlines $-    "-- This file is generated from CmmSwitchGen!" :-    "{-# LANGUAGE MagicHash, NegativeLiterals #-}" :-    "import Control.Monad (unless, forM_)" :-    "import GHC.Exts" :-    map genSwitch specs ++-    map genCheck specs ++-    [ genMain specs ]--main = putStrLn $-    genMod $ zipWith (\n (s,v) -> (n,s,v)) names $ signedChecks ++ unsignedChecks---signedChecks :: [(Bool, [Integer])]-signedChecks = map (True,)-    [ [1..10]-    , [0..10]-    , [1..3]-    , [1..4]-    , [1..5]-    , [-1..10]-    , [-10..10]-    , [-20.. -10]++[0..10]-    , [-20.. -10]++[1..10]-    , [minS,0,maxS]-    , [maxS-10 .. maxS]-    , [minS..minS+10]++[maxS-10 .. maxS]-    ]--minU, maxU, minS, maxS :: Integer-minU = 0-maxU = fromIntegral (maxBound :: Word)-minS = fromIntegral (minBound :: Int)-maxS = fromIntegral (maxBound :: Int)---unsignedChecks :: [(Bool, [Integer])]-unsignedChecks = map (False,)-    [ [0..10]-    , [1..10]-    , [0]-    , [0..1]-    , [0..2]-    , [0..3]-    , [0..4]-    , [1]-    , [1..2]-    , [1..3]-    , [1..4]-    , [1..5]-    , [minU,maxU]-    , [maxU-10 .. maxU]-    , [minU..minU+10]++[maxU-10 .. maxU]-    ]--names :: [String]-names = [ c1:c2:[] | c1 <- ['a'..'z'], c2 <- ['a'..'z']]
− tests/examples/ghc80/Collapse1.hs 
@@ -1,16 +0,0 @@-module LiftToTop3evel.Collapse1 where--collapse' _ _ [] = []-collapse' left space (t:ts) = new : collapse' right space rest-  where-    (_, leftInner)  = left-    rightInner      = leftInner   + symbolSize t-    right           = (rightInner, (rightOuter rightInner rights))-    (rights, rest)  = span space ts-    new             = (t, Bounds left right)--rightOuter rightInner rights      = rightInner  + symbolSize rights--data Bounds = Bounds (Int,Int) (Int,Int)-symbolSize t = 4-
− tests/examples/ghc80/Compare.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE Trustworthy,-    TypeOperators,-    PolyKinds, DataKinds,-    TypeFamilies,-    UndecidableInstances #-}---module Type.Compare where--import Data.Ord-import GHC.TypeLits--type family (a :: Ordering) $$ (b :: Ordering) :: Ordering where-  LT $$ b = LT-  GT $$ b = GT-  EQ $$ b = b-infixl 0 $$---- | Compare two types of any (possibly different) kinds.--- Since `Compare` itself is a closed type family, add instances to `CompareUser` if you want to compare other types.-type family Compare (a :: k) (b :: k') :: Ordering where--  Compare '() '() = EQ
− tests/examples/ghc80/CustomTypeErrors01.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE DataKinds, UndecidableInstances #-}-module T1 where-import GHC.TypeLits---data MyType = MyType--instance-  TypeError (Text "Values of type 'MyType' cannot be compared for equality.")-    => Eq MyType where (==) = undefined--err x = x == MyType--
− tests/examples/ghc80/CustomTypeErrors02.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE DataKinds, UndecidableInstances #-}-{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleContexts #-}-module T2 where--import GHC.TypeLits--type family IntRep a where-  IntRep Int      = Integer-  IntRep Integer  = Integer-  IntRep Bool     = Integer-  IntRep a        = TypeError (Text "The type '" :<>: ShowType a :<>:-                               Text "' cannot be represented as an integer.")--convert :: Num (IntRep a) => a -> IntRep a-convert _ = 5--err = convert id--
− tests/examples/ghc80/CustomTypeErrors03.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE DataKinds #-}-module T3 where--import GHC.TypeLits--f :: TypeError (Text "This is a type error")-f = undefined
− tests/examples/ghc80/D.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--module D where--import A-import C--type instance F a b = a--unsafeCoerce :: a -> b-unsafeCoerce x = oops x x
− tests/examples/ghc80/DataFamilyInstanceLHS.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE TypeFamilies, GADTs, DataKinds, PolyKinds #-}-module DataFamilyInstanceLHS where--- Test case from #10586-data MyKind = A | B--data family Sing (a :: k)--data instance Sing (_ :: MyKind) where-    SingA :: Sing A-    SingB :: Sing B--foo :: Sing A-foo = SingA
− tests/examples/ghc80/DatatypeContexts.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE CPP              #-}-{-# LANGUAGE DatatypeContexts #-}-{-# LANGUAGE TemplateHaskell  #-}-{-# LANGUAGE TypeFamilies     #-}--- I don't know how to silence the -XDatatypeContexts warnings otherwise...-{-# OPTIONS_GHC -w #-}--{-|-Module:      Derived.DatatypeContexts-Copyright:   (C) 2014-2016 Ryan Scott-License:     BSD-style (see the file LICENSE)-Maintainer:  Ryan Scott-Stability:   Provisional-Portability: GHC--Defines data types with DatatypeContexts (which are gross, but still possible).--}-module Derived.DatatypeContexts where---data family TyFamily x y z :: *--data instance Ord a => TyFamily a b c = TyFamily a b c-  deriving Show-
− tests/examples/ghc80/Decision.hs 
@@ -1,726 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ImpredicativeTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}--module Airship.Internal.Decision-    ( flow-    , appendRequestPath-    ) where--import           Airship.Internal.Date (parseRfc1123Date, utcTimeToRfc1123)-import           Airship.Headers (addResponseHeader)-import           Airship.Types ( Response(..)-                               , ResponseBody(..)-                               , Webmachine-                               , etagToByteString-                               , getResponseBody-                               , getResponseHeaders-                               , halt-                               , pathInfo-                               , putResponseBody-                               , request-                               , requestHeaders-                               , requestMethod-                               , requestTime )--import           Airship.Resource(Resource(..), PostResponse(..))-import           Airship.Internal.Parsers (parseEtagList)-#if __GLASGOW_HASKELL__ < 710-import           Control.Applicative ((<$>))-#endif-import           Control.Monad (when)-import           Control.Monad.Trans (lift)-import           Control.Monad.Trans.State.Strict (StateT(..), evalStateT,-                                                   get, modify)-import           Control.Monad.Writer.Class (tell)--import           Blaze.ByteString.Builder (toByteString)-import           Data.Maybe (isJust)-import           Data.Text (Text)-import           Data.Time.Clock (UTCTime)-import           Data.ByteString                  (ByteString, intercalate)--import           Network.HTTP.Media-import qualified Network.HTTP.Types as HTTP----------------------------------------------------------------------------------- HTTP Headers--- These are headers not defined for us already in--- Network.HTTP.Types---------------------------------------------------------------------------------- TODO this exist in http-types-0.9, see CHANGES.txt-hAcceptCharset :: HTTP.HeaderName-hAcceptCharset = "Accept-Charset"--hAcceptEncoding :: HTTP.HeaderName-hAcceptEncoding = "Accept-Encoding"--hIfMatch :: HTTP.HeaderName-hIfMatch = "If-Match"--hIfUnmodifiedSince :: HTTP.HeaderName-hIfUnmodifiedSince = "If-Unmodified-Since"--hIfNoneMatch :: HTTP.HeaderName-hIfNoneMatch = "If-None-Match"----------------------------------------------------------------------------------- FlowState: StateT used for recording information as we walk the decision--- tree---------------------------------------------------------------------------------data FlowState m = FlowState-    { _contentType :: Maybe (MediaType, Webmachine m ResponseBody) }--type FlowStateT m a = StateT (FlowState m) (Webmachine m) a--type Flow m = Resource m -> FlowStateT m Response--initFlowState :: FlowState m-initFlowState = FlowState Nothing--flow :: Monad m => Resource m -> Webmachine m Response-flow r = evalStateT (b13 r) initFlowState--trace :: Monad m => Text -> FlowStateT m ()-trace t = lift $ tell [t]---------------------------------------------------------------------------------- Header value data newtypes---------------------------------------------------------------------------------newtype IfMatch = IfMatch ByteString-newtype IfNoneMatch = IfNoneMatch ByteString----------------------------------------------------------------------------------- Decision Helpers---------------------------------------------------------------------------------negotiateContentTypesAccepted :: Monad m => Resource m -> FlowStateT m ()-negotiateContentTypesAccepted Resource{..} = do-    req <- lift request-    accepted <- lift contentTypesAccepted-    let reqHeaders = requestHeaders req-        result = do-            cType <- lookup HTTP.hContentType reqHeaders-            mapContentMedia accepted cType-    case result of-        (Just process) -> lift process-        Nothing -> lift $ halt HTTP.status415--appendRequestPath :: Monad m => [Text] -> Webmachine m ByteString-appendRequestPath ts = do-    currentPath <- pathInfo <$> request-    return $ toByteString (HTTP.encodePathSegments (currentPath ++ ts))--requestHeaderDate :: Monad m => HTTP.HeaderName ->-                                Webmachine m (Maybe UTCTime)-requestHeaderDate headerName = do-    req <- request-    let reqHeaders = requestHeaders req-        dateHeader = lookup headerName reqHeaders-        parsedDate = dateHeader >>= parseRfc1123Date-    return parsedDate--writeCacheTags :: Monad m => Resource m -> FlowStateT m ()-writeCacheTags Resource{..} = lift $ do-    etag <- generateETag-    case etag of-       Nothing -> return ()-       Just t  -> addResponseHeader ("ETag", etagToByteString t)-    modified <- lastModified-    case modified of-       Nothing -> return ()-       Just d  -> addResponseHeader ("Last-Modified", utcTimeToRfc1123 d)----------------------------------------------------------------------------------- Type definitions for all decision nodes---------------------------------------------------------------------------------b13, b12, b11, b10, b09, b08, b07, b06, b05, b04, b03 :: Monad m => Flow  m-c04, c03 :: Monad m => Flow  m-d05, d04 :: Monad m => Flow  m-e06, e05 :: Monad m => Flow  m-f07, f06 :: Monad m => Flow  m-g11, g09 :: Monad m => IfMatch -> Flow m-g08, g07 :: Monad m => Flow  m-h12, h11, h10, h07 :: Monad m => Flow  m-i13 :: Monad m => IfNoneMatch -> Flow m-i12, i07, i04 :: Monad m => Flow  m-j18 :: Monad m => Flow  m-k13 :: Monad m => IfNoneMatch -> Flow m-k07, k05 :: Monad m => Flow  m-l17, l15, l14, l13, l07, l05 :: Monad m => Flow  m-m20, m16, m07, m05 :: Monad m => Flow  m-n16, n11, n05 :: Monad m => Flow  m-o20, o18, o16, o14 :: Monad m => Flow  m-p11, p03 :: Monad m => Flow  m----------------------------------------------------------------------------------- B column---------------------------------------------------------------------------------b13 r@Resource{..} = do-    trace "b13"-    available <- lift serviceAvailable-    if available-        then b12 r-        else lift $ halt HTTP.status503--b12 r@Resource{..} = do-    trace "b12"-    -- known method-    req <- lift request-    let knownMethods = [ HTTP.methodGet-                       , HTTP.methodPost-                       , HTTP.methodHead-                       , HTTP.methodPut-                       , HTTP.methodDelete-                       , HTTP.methodTrace-                       , HTTP.methodConnect-                       , HTTP.methodOptions-                       , HTTP.methodPatch-                       ]-    if requestMethod req `elem` knownMethods-        then b11 r-        else lift $ halt HTTP.status501--b11 r@Resource{..} = do-    trace "b11"-    long <- lift uriTooLong-    if long-        then lift $ halt HTTP.status414-        else b10 r--b10 r@Resource{..} = do-    trace "b10"-    req <- lift request-    allowed <- lift allowedMethods-    if requestMethod req `elem` allowed-        then b09 r-        else do-            lift $ addResponseHeader ("Allow",  intercalate "," allowed)-            lift $ halt HTTP.status405--b09 r@Resource{..} = do-    trace "b09"-    malformed <- lift malformedRequest-    if malformed-        then lift $ halt HTTP.status400-        else b08 r--b08 r@Resource{..} = do-    trace "b08"-    authorized <- lift isAuthorized-    if authorized-        then b07 r-        else lift $ halt HTTP.status401--b07 r@Resource{..} = do-    trace "b07"-    forbid <- lift forbidden-    if forbid-        then lift $ halt HTTP.status403-        else b06 r--b06 r@Resource{..} = do-    trace "b06"-    validC <- lift validContentHeaders-    if validC-        then b05 r-        else lift $ halt HTTP.status501--b05 r@Resource{..} = do-    trace "b05"-    known <- lift knownContentType-    if known-        then b04 r-        else lift $ halt HTTP.status415--b04 r@Resource{..} = do-    trace "b04"-    large <- lift entityTooLarge-    if large-        then lift $ halt HTTP.status413-        else b03 r--b03 r@Resource{..} = do-    trace "b03"-    req <- lift request-    allowed <- lift allowedMethods-    if requestMethod req == HTTP.methodOptions-        then do-            lift $ addResponseHeader ("Allow",  intercalate "," allowed)-            lift $ halt HTTP.status204-        else c03 r----------------------------------------------------------------------------------- C column---------------------------------------------------------------------------------c04 r@Resource{..} = do-    trace "c04"-    req <- lift request-    provided <- lift contentTypesProvided-    let reqHeaders = requestHeaders req-        result = do-            acceptStr <- lookup HTTP.hAccept reqHeaders-            (acceptTyp, resource) <- mapAcceptMedia provided' acceptStr-            Just (acceptTyp, resource)-            where-                -- this is so that in addition to getting back the resource-                -- that we match, we also return the content-type provided-                -- by that resource.-                provided' = map dupContentType provided-                dupContentType (a, b) = (a, (a, b))--    case result of-      Nothing -> lift $ halt HTTP.status406-      Just res -> do-        modify (\fs -> fs { _contentType = Just res })-        d04 r--c03 r@Resource{..} = do-    trace "c03"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup HTTP.hAccept reqHeaders of-        (Just _h) ->-            c04 r-        Nothing ->-            d04 r----------------------------------------------------------------------------------- D column---------------------------------------------------------------------------------d05 r@Resource{..} = do-    trace "d05"-    langAvailable <- lift languageAvailable-    if langAvailable-        then e05 r-        else lift $ halt HTTP.status406--d04 r@Resource{..} = do-    trace "d04"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup HTTP.hAcceptLanguage reqHeaders of-        (Just _h) ->-            d05 r-        Nothing ->-            e05 r----------------------------------------------------------------------------------- E column---------------------------------------------------------------------------------e06 r@Resource{..} = do-    trace "e06"-    -- TODO: charset negotiation-    f06 r--e05 r@Resource{..} = do-    trace "e05"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup hAcceptCharset reqHeaders of-        (Just _h) ->-            e06 r-        Nothing ->-            f06 r----------------------------------------------------------------------------------- F column---------------------------------------------------------------------------------f07 r@Resource{..} = do-    trace "f07"-    -- TODO: encoding negotiation-    g07 r--f06 r@Resource{..} = do-    trace "f06"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup hAcceptEncoding reqHeaders of-        (Just _h) ->-            f07 r-        Nothing ->-            g07 r----------------------------------------------------------------------------------- G column---------------------------------------------------------------------------------g11 (IfMatch ifMatch) r@Resource{..} = do-    trace "g11"-    let etags = parseEtagList ifMatch-    if null etags-        then lift $ halt HTTP.status412-        else h10 r--g09 ifMatch r@Resource{..} = do-    trace "g09"-    case ifMatch of-        -- TODO: should we be stripping whitespace here?-        (IfMatch "*") ->-            h10 r-        _ ->-            g11 ifMatch r--g08 r@Resource{..} = do-    trace "g08"-    req <- lift request-    let reqHeaders = requestHeaders req-    case IfMatch <$> lookup hIfMatch reqHeaders of-        (Just h) ->-            g09 h r-        Nothing ->-            h10 r--g07 r@Resource{..} = do-    trace "g07"-    -- TODO: set Vary headers-    exists <- lift resourceExists-    if exists-        then g08 r-        else h07 r----------------------------------------------------------------------------------- H column---------------------------------------------------------------------------------h12 r@Resource{..} = do-    trace "h12"-    modified <- lift lastModified-    parsedDate <- lift $ requestHeaderDate hIfUnmodifiedSince-    let maybeGreater = do-            lastM <- modified-            headerDate <- parsedDate-            return (lastM > headerDate)-    if maybeGreater == Just True-        then lift $ halt HTTP.status412-        else i12 r--h11 r@Resource{..} = do-    trace "h11"-    parsedDate <- lift $ requestHeaderDate hIfUnmodifiedSince-    if isJust parsedDate-        then h12 r-        else i12 r--h10 r@Resource{..} = do-    trace "h10"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup hIfUnmodifiedSince reqHeaders of-        (Just _h) ->-            h11 r-        Nothing ->-            i12 r--h07 r@Resource {..} = do-    trace "h07"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup hIfMatch reqHeaders of-        -- TODO: should we be stripping whitespace here?-        (Just "*") ->-            lift $ halt HTTP.status412-        _ ->-            i07 r----------------------------------------------------------------------------------- I column---------------------------------------------------------------------------------i13 ifNoneMatch r@Resource{..} = do-    trace "i13"-    case ifNoneMatch of-        -- TODO: should we be stripping whitespace here?-        (IfNoneMatch "*") ->-            j18 r-        _ ->-            k13 ifNoneMatch r--i12 r@Resource{..} = do-    trace "i12"-    req <- lift request-    let reqHeaders = requestHeaders req-    case IfNoneMatch <$> lookup hIfNoneMatch reqHeaders of-        (Just h) ->-            i13 h r-        Nothing ->-            l13 r--i07 r = do-    trace "i07"-    req <- lift request-    if requestMethod req == HTTP.methodPut-        then i04 r-        else k07 r--i04 r@Resource{..} = do-    trace "i04"-    moved <- lift movedPermanently-    case moved of-        (Just loc) -> do-            lift $ addResponseHeader ("Location", loc)-            lift $ halt HTTP.status301-        Nothing ->-            p03 r----------------------------------------------------------------------------------- J column---------------------------------------------------------------------------------j18 _ = do-    trace "j18"-    req <- lift request-    let getOrHead = [ HTTP.methodGet-                    , HTTP.methodHead-                    ]-    if requestMethod req `elem` getOrHead-        then lift $ halt HTTP.status304-        else lift $ halt HTTP.status412----------------------------------------------------------------------------------- K column---------------------------------------------------------------------------------k13 (IfNoneMatch ifNoneMatch) r@Resource{..} = do-    trace "k13"-    let etags = parseEtagList ifNoneMatch-    if null etags-        then l13 r-        else j18 r--k07 r@Resource{..} = do-    trace "k07"-    prevExisted <- lift previouslyExisted-    if prevExisted-        then k05 r-        else l07 r--k05 r@Resource{..} = do-    trace "k05"-    moved <- lift movedPermanently-    case moved of-        (Just loc) -> do-            lift $ addResponseHeader ("Location", loc)-            lift $ halt HTTP.status301-        Nothing ->-            l05 r----------------------------------------------------------------------------------- L column---------------------------------------------------------------------------------l17 r@Resource{..} = do-    trace "l17"-    parsedDate <- lift $ requestHeaderDate HTTP.hIfModifiedSince-    modified <- lift lastModified-    let maybeGreater = do-            lastM <- modified-            ifModifiedSince <- parsedDate-            return (lastM > ifModifiedSince)-    if maybeGreater == Just True-        then m16 r-        else lift $ halt HTTP.status304--l15 r@Resource{..} = do-    trace "l15"-    parsedDate <- lift $ requestHeaderDate HTTP.hIfModifiedSince-    now <- lift requestTime-    let maybeGreater = (> now) <$> parsedDate-    if maybeGreater == Just True-        then m16 r-        else l17 r--l14 r@Resource{..} = do-    trace "l14"-    req <- lift request-    let reqHeaders = requestHeaders req-        dateHeader = lookup HTTP.hIfModifiedSince reqHeaders-        validDate = isJust (dateHeader >>= parseRfc1123Date)-    if validDate-        then l15 r-        else m16 r--l13 r@Resource{..} = do-    trace "l13"-    req <- lift request-    let reqHeaders = requestHeaders req-    case lookup HTTP.hIfModifiedSince reqHeaders of-        (Just _h) ->-            l14 r-        Nothing ->-            m16 r--l07 r = do-    trace "l07"-    req <- lift request-    if requestMethod req == HTTP.methodPost-        then m07 r-        else lift $ halt HTTP.status404--l05 r@Resource{..} = do-    trace "l05"-    moved <- lift movedTemporarily-    case moved of-        (Just loc) -> do-            lift $ addResponseHeader ("Location", loc)-            lift $ halt HTTP.status307-        Nothing ->-            m05 r----------------------------------------------------------------------------------- M column---------------------------------------------------------------------------------m20 r@Resource{..} = do-    trace "m20"-    deleteAccepted <- lift deleteResource-    if deleteAccepted-        then do-            completed <- lift deleteCompleted-            if completed-                then o20 r-                else lift $ halt HTTP.status202-        else lift $ halt HTTP.status500--m16 r = do-    trace "m16"-    req <- lift request-    if requestMethod req == HTTP.methodDelete-        then m20 r-        else n16 r--m07 r@Resource{..} = do-    trace "m07"-    allowMissing <- lift allowMissingPost-    if allowMissing-        then n11 r-        else lift $ halt HTTP.status404--m05 r = do-    trace "m05"-    req <- lift request-    if requestMethod req == HTTP.methodPost-        then n05 r-        else lift $ halt HTTP.status410----------------------------------------------------------------------------------- N column---------------------------------------------------------------------------------n16 r = do-    trace "n16"-    req <- lift request-    if requestMethod req == HTTP.methodPost-        then n11 r-        else o16 r--n11 r@Resource{..} = trace "n11" >> lift processPost >>= flip processPostAction r--create :: Monad m => [Text] -> Resource m -> FlowStateT m ()-create ts r = do-    loc <- lift (appendRequestPath ts)-    lift (addResponseHeader ("Location", loc))-    negotiateContentTypesAccepted r--processPostAction :: Monad m => PostResponse m -> Flow  m-processPostAction (PostCreate ts) r = do-    create ts r-    p11 r-processPostAction (PostCreateRedirect ts) r = do-    create ts r-    lift $ halt HTTP.status303-processPostAction (PostProcess p) r =-    lift p >> p11 r-processPostAction (PostProcessRedirect ts) _r = do-    locBs <- lift ts-    lift $ addResponseHeader ("Location", locBs)-    lift $ halt HTTP.status303--n05 r@Resource{..} = do-    trace "n05"-    allow <- lift allowMissingPost-    if allow-        then n11 r-        else lift $ halt HTTP.status410----------------------------------------------------------------------------------- O column---------------------------------------------------------------------------------o20 r = do-    trace "o20"-    body <- lift getResponseBody-    -- ResponseBody is a little tough to make an instance of 'Eq',-    -- so we just use a pattern match-    case body of-        Empty   -> lift $ halt HTTP.status204-        _       -> o18 r--o18 r@Resource{..} = do-    trace "o18"-    multiple <- lift multipleChoices-    if multiple-        then lift $ halt HTTP.status300-        else do-            -- TODO: set etag, expiration, etc. headers-            req <- lift request-            let getOrHead = [ HTTP.methodGet-                            , HTTP.methodHead-                            ]-            when (requestMethod req `elem` getOrHead) $ do-                m <- _contentType <$> get-                (cType, body) <- case m of-                    Nothing -> do-                        provided <- lift contentTypesProvided-                        return (head provided)-                    Just (cType, body) ->-                        return (cType, body)-                b <- lift body-                lift $ putResponseBody b-                lift $ addResponseHeader ("Content-Type", renderHeader cType)-            writeCacheTags r-            lift $ halt HTTP.status200--o16 r = do-    trace "o16"-    req <- lift request-    if requestMethod req == HTTP.methodPut-        then o14 r-        else o18 r--o14 r@Resource{..} = do-    trace "o14"-    conflict <- lift isConflict-    if conflict-        then lift $ halt HTTP.status409-        else negotiateContentTypesAccepted r >> p11 r----------------------------------------------------------------------------------- P column---------------------------------------------------------------------------------p11 r = do-    trace "p11"-    headers <- lift getResponseHeaders-    case lookup HTTP.hLocation headers of-        (Just _) ->-            lift $ halt HTTP.status201-        _ ->-            o20 r--p03 r@Resource{..} = do-    trace "p03"-    conflict <- lift isConflict-    if conflict-        then lift $ halt HTTP.status409-        else negotiateContentTypesAccepted r >> p11 r
− tests/examples/ghc80/Defer03.hs 
@@ -1,7 +0,0 @@-module Main where--a :: Int-a = 'p'--main :: IO ()-main = print "No errors!"
− tests/examples/ghc80/Dep1.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE TypeInType #-}--module Dep1 where--import Data.Kind--data Proxy k (a :: k) = P--x :: Proxy * Int-x = P--y :: Proxy Bool True-y = P
− tests/examples/ghc80/Dep2.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE PolyKinds, GADTs #-}--module Dep2 where--data G (a :: k) where-  G1 :: G Int-  G2 :: G Maybe
− tests/examples/ghc80/DepFail1.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE TypeInType #-}--module DepFail1 where--data Proxy k (a :: k) = P--z :: Proxy Bool-z = P--a :: Proxy Int Bool-a = P
− tests/examples/ghc80/DeprM.hs 
@@ -1,4 +0,0 @@-module DeprM {-# DEPRECATED "Here can be your menacing deprecation warning!" #-} where--f :: Int-f = 42
− tests/examples/ghc80/DeprU.hs 
@@ -1,6 +0,0 @@-module A where--import DeprM -- here should be emitted deprecation warning--g :: Int-g = f
− tests/examples/ghc80/Deprecation.hs 
@@ -1,16 +0,0 @@--module Deprecation-{-# Deprecated ["This is a module \"deprecation\"",-             "multi-line",-             "with unicode: Frère" ] #-}-   ( foo )- where--{-# DEPRECATEd   foo-         ["This is a multi-line",-          "deprecation message",-          "for foo"] #-}-foo :: Int-foo = 4--{-# DEPRECATED withBool        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
− tests/examples/ghc80/DsStrict.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE Strict #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}-module Main where--import Debug.Trace--f0 a = "fun"-f0' ~a = "fun2"--f1 ~n =-  case n of-    a -> "case"-f1' ~n =-  case n of-    ~a -> "case2"--f2 = \a -> "lamda"-f2' = \ ~a -> "lambda2"--newtype Age = MkAge Int--f4, f4' :: Age -> String-f4 (MkAge a) = "newtype"-f4' ~(MkAge a) = "newtype2"--main :: IO ()-main = mapM_ (\(what,f) -> putStrLn (f (v what))) fs-  where fs =-          [("fun",f0 )-          ,("fun lazy",f0')-          ,("case",f1)-          ,("case lazy",f1')-          ,("lambda",f2)-          ,("lambda lazy",f2')-          ,("newtype",(\ ~i -> f4 (MkAge i)))-          ,("newtype lazy",(\ ~i -> f4' (MkAge i)))]-        v n = trace ("evaluated in " ++ n) 1
− tests/examples/ghc80/DsStrictData.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, StrictData, GADTs #-}---- | Tests the StrictData LANGUAGE pragma.-module Main where--import qualified Control.Exception as E-import System.IO.Unsafe (unsafePerformIO)--data Strict a = S a-data Strict2 b = S2 !b-data Strict3 c where-  S3 :: c -> Strict3 c--data UStrict = US {-# UNPACK #-} Int--data Lazy d = L ~d-data Lazy2 e where-  L2 :: ~e -> Lazy2 e--main :: IO ()-main =-  do print (isBottom (S bottom))-     print (isBottom (S2 bottom))-     print (isBottom (US bottom))-     print (isBottom (S3 bottom))-     putStrLn ""-     print (not (isBottom (L bottom)))-     print (not (isBottom (L2 bottom)))-     print (not (isBottom (Just bottom))) -- sanity check----------------------------------------------------------------------------- Support for testing for bottom--bottom :: a-bottom = error "_|_"--isBottom :: a -> Bool-isBottom f = unsafePerformIO $-  (E.evaluate f >> return False) `E.catches`-    [ E.Handler (\(_ :: E.ArrayException)   -> return True)-    , E.Handler (\(_ :: E.ErrorCall)        -> return True)-    , E.Handler (\(_ :: E.NoMethodError)    -> return True)-    , E.Handler (\(_ :: E.NonTermination)   -> return True)-    , E.Handler (\(_ :: E.PatternMatchFail) -> return True)-    , E.Handler (\(_ :: E.RecConError)      -> return True)-    , E.Handler (\(_ :: E.RecSelError)      -> return True)-    , E.Handler (\(_ :: E.RecUpdError)      -> return True)-    ]
− tests/examples/ghc80/DsStrictFail.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE Strict #-}-module Main where--main = let False = True-       in return ()
− tests/examples/ghc80/DsStrictLet.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE Strict #-}-module Main where--import Debug.Trace--main = let False = trace "no binders" False -- evaluated--           a :: a -> a-           a = trace "polymorphic" id -- evaluated--           f :: Eq a => a -> a -> Bool-           f = trace "overloaded" (==) -- not evaluated--           xs :: [Int]-           xs = (trace "recursive" (:) 1 xs) -- evaluated-       in return ()
− tests/examples/ghc80/DsStrictWarn.hs 
@@ -1,7 +0,0 @@-{-# OPTIONS_GHC -fwarn-incomplete-uni-patterns #-}-{-# LANGUAGE Strict #-}-module DsStrictWarn where---- should warn about non-exhaustive pattern match-w :: String -> String-w x = let (_:_) = x in "1"
− tests/examples/ghc80/Eq.hs 
@@ -1,63 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies,-             RankNTypes, FlexibleContexts, TemplateHaskell,-             UndecidableInstances, GADTs, DefaultSignatures #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Eq--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines the SEq singleton version of the Eq type class.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Eq (-  PEq(..), SEq(..),-  (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$)-  ) where--import Data.Singletons.Prelude.Bool-import Data.Singletons-import Data.Singletons.Single-import Data.Singletons.Prelude.Instances-import Data.Singletons.Util-import Data.Singletons.Promote-import Data.Type.Equality---- NB: These must be defined by hand because of the custom handling of the--- default for (:==) to use Data.Type.Equality.==---- | The promoted analogue of 'Eq'. If you supply no definition for '(:==)',--- then it defaults to a use of '(==)', from @Data.Type.Equality@.-class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where-  type (:==) (x :: a) (y :: a) :: Bool-  type (:/=) (x :: a) (y :: a) :: Bool--  type (x :: a) :== (y :: a) = x == y-  type (x :: a) :/= (y :: a) = Not (x :== y)--infix 4 :==-infix 4 :/=--$(genDefunSymbols [''(:==), ''(:/=)])---- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is required--- that instances define a body for '(%:==)'. You may also supply a body for '(%:/=)'.-class (kparam ~ 'KProxy) => SEq (kparam :: KProxy k) where-  -- | Boolean equality on singletons-  (%:==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :== b)-  infix 4 %:==--  -- | Boolean disequality on singletons-  (%:/=) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :/= b)-  default (%:/=) :: forall (a :: k) (b :: k).-                    ((a :/= b) ~ Not (a :== b))-                 => Sing a -> Sing b -> Sing (a :/= b)-  a %:/= b = sNot (a %:== b)-  infix 4 %:/=--$(singEqInstances basicTypes)
− tests/examples/ghc80/ExpandSynsFail1.hs 
@@ -1,4 +0,0 @@-type Foo = Int-type Bar = Bool--main = print $ (1 :: Foo) == (False :: Bar)
− tests/examples/ghc80/ExpandSynsFail2.hs 
@@ -1,19 +0,0 @@--- In case of types with nested type synonyms, all synonyms should be expanded--{-# LANGUAGE RankNTypes #-}--import Control.Monad.ST--type Foo = Int-type Bar = Bool--type MyFooST s = ST s Foo-type MyBarST s = ST s Bar--fooGen :: forall s . MyFooST s-fooGen = undefined--barGen :: forall s . MyBarST s-barGen = undefined--main = print (runST fooGen == runST barGen)
− tests/examples/ghc80/ExpandSynsFail3.hs 
@@ -1,23 +0,0 @@--- We test two things here:------ 1. We expand only as much as necessary. In this case, we shouldn't expand T.--- 2. When we find a difference(T3 and T5 in this case), we do minimal expansion---    e.g. we don't expand both of them to T1, instead we expand T5 to T3.--module Main where--type T5 = T4-type T4 = T3-type T3 = T2-type T2 = T1-type T1 = Int--type T a = Int -> Bool -> a -> String--f :: T (T3, T5, Int) -> Int-f = undefined--a :: Int-a = f (undefined :: T (T5, T3, Bool))--main = print a
− tests/examples/ghc80/ExpandSynsFail4.hs 
@@ -1,11 +0,0 @@--- Synonyms shouldn't be expanded since type error is visible without--- expansions. Error message should not have `Type synonyms expanded: ...` part.--module Main where--type T a = [a]--f :: T Int -> String-f = undefined--main = putStrLn $ f (undefined :: T Bool)
− tests/examples/ghc80/ExportSyntax.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}--module ExportSyntax ( A(.., NoA), Q(F,..), G(T,..,U)) where--data A = A | B--pattern NoA = B--data Q a = Q a--pattern F a = Q a--data G = G | H--pattern T = G--pattern U = H
− tests/examples/ghc80/ExportSyntaxImport.hs 
@@ -1,7 +0,0 @@-module ExportSyntaxImport where--import ExportSyntax--foo = NoA--baz = A
− tests/examples/ghc80/ExprSigLocal.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}--module ExprSigLocal where---- We expect this to compile fine,--- reporting that '_' stands 'a'--y :: forall b. b->b-y  = ((\x -> x) :: forall a. a -> _)--g :: forall a. a -> _-g x = x
− tests/examples/ghc80/Extends.hs 
@@ -1,4 +0,0 @@-module Extends where--class BClass b where-  has :: b
− tests/examples/ghc80/ExtraConstraintsWildcardInExpressionSignature.hs 
@@ -1,3 +0,0 @@-module ExtraConstraintsWildcardInExpressionSignature where--foo x y = ((==) :: _ => _) x y
− tests/examples/ghc80/ExtraConstraintsWildcardInPatternSignature.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module ExtraConstraintsWildcardInPatternSignature where--foo (x :: _ => _) y = x == y
− tests/examples/ghc80/ExtraConstraintsWildcardInPatternSplice.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE ScopedTypeVariables #-}-module ExtraConstraintsWildcardInPatternSplice where--foo $( [p| (x :: _) |] ) = x
− tests/examples/ghc80/ExtraConstraintsWildcardInTypeSplice.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module ExtraConstraintsWildcardInTypeSplice where--import Language.Haskell.TH--metaType :: TypeQ-metaType = [t| _ => _ |]
− tests/examples/ghc80/ExtraConstraintsWildcardInTypeSplice2.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module ExtraConstraintsWildcardInTypeSplice2 where--import Language.Haskell.TH.Lib (wildCardT)--show' :: $(wildCardT) => a -> String-show' x = show x
− tests/examples/ghc80/ExtraConstraintsWildcardInTypeSpliceUsed.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module ExtraConstraintsWildcardInTypeSpliceUsed where--import ExtraConstraintsWildcardInTypeSplice---- An extra-constraints wild card is not supported in type splices-eq :: $(metaType)-eq x y = x == y
− tests/examples/ghc80/ExtraConstraintsWildcardTwice.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE PartialTypeSignatures #-}-module ExtraConstraintsWildcardTwice where--foo :: ((_), _) => a -> a-foo = undefined
− tests/examples/ghc80/F.hs 
@@ -1,20 +0,0 @@--- | Thompson's group F.------ See eg. <https://en.wikipedia.org/wiki/Thompson_groups>------ Based mainly on James Michael Belk's PhD thesis \"THOMPSON'S GROUP F\";--- see <http://www.math.u-psud.fr/~breuilla/Belk.pdf>-----{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, BangPatterns, PatternSynonyms, DeriveFunctor #-}-module Math.Combinat.Groups.Thompson.F where---- | Remove the carets with the given indices--- (throws an error if there is no caret at the given index)-removeCarets :: [Int] -> T -> T-removeCarets idxs tree = if null rem then final else error ("removeCarets: some stuff remained: " ++ show rem) where--  (_,rem,final) =  go 0 idxs tree where--  go :: Int -> [Int] -> T -> (Int,[Int],T)-  go !x []         t  = (x + treeWidth t , [] , t)
− tests/examples/ghc80/FDsFromGivens2.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, GADTs #-}--module FDsFromGivens2 where--class C a b | a -> b where-   cop :: a -> b -> ()--data KCC where-  KCC :: C Char Char => () -> KCC--f :: C Char [a] => a -> a-f = undefined--bar (KCC _) = f
− tests/examples/ghc80/Families.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds, KindSignatures,-    TypeOperators, UndecidableInstances #-}--{-# LANGUAGE RankNTypes, LiberalTypeSynonyms, EmptyDataDecls #-}---- | A prelude for type-level programming with type families--module Prelude.Type.Families where---- >>> T :: T ((I 4) `Minus` (I 7))--- -3-type family (a :: k) `Minus` (b :: k) :: k-type instance a `Minus` b = a + Negate b-
− tests/examples/ghc80/FooBar.hs 
@@ -1,4 +0,0 @@-module FooBar where--import Foo-import Bar
− tests/examples/ghc80/ForFree.hs 
@@ -1,23 +0,0 @@--{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}--- {-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE UndecidableInstances #-}--module Control.ForFree where {---- | Free monad from a functor-;-  data Free f x = Pure x | Free (f (Free f x));--  deriving instance (Eq (f (Free f a)), Eq a) => Eq (Free f a);-  deriving instance (Ord (f (Free f a)), Ord a) => Ord (Free f a);-  deriving instance (Read (f (Free f a)), Read a) => Read (Free f a);-  deriving instance (Show (f (Free f a)), Show a) => Show (Free f a);-}
− tests/examples/ghc80/FromGrin2.hs 
@@ -1,6 +0,0 @@---- ./hackage-roundtrip-work/ajhc-0.8.0.10/src/C/FromGrin2.hs--- orig line 588-convertExp :: Exp -> C (Statement,Expression)-convertExp (Prim Func { primArgTypes = as, primRetType = r, primRetArgs = rs@(_:_), ..} vs ty) = do-    return (mempty,e)
− tests/examples/ghc80/FrontendPlugin.hs 
@@ -1,52 +0,0 @@-module FrontendPlugin where--import GhcPlugins-import qualified GHC-import GHC              ( Ghc, LoadHowMuch(..) )--import DriverPipeline hiding ( hsc_env )-import DriverPhases-import System.Exit-import Control.Monad-import Data.List--frontendPlugin :: FrontendPlugin-frontendPlugin = defaultFrontendPlugin {-        frontend = doMake-    }---- Copypasted from ghc/Main.hs-doMake :: [String] -> [(String,Maybe Phase)] -> Ghc ()-doMake opts srcs  = do-    liftIO $ print opts-    let (hs_srcs, non_hs_srcs) = partition haskellish srcs--        haskellish (f,Nothing) =-          looksLikeModuleName f || isHaskellUserSrcFilename f || '.' `notElem` f-        haskellish (_,Just phase) =-          phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm-                          , StopLn]--    hsc_env <- GHC.getSession--    -- if we have no haskell sources from which to do a dependency-    -- analysis, then just do one-shot compilation and/or linking.-    -- This means that "ghc Foo.o Bar.o -o baz" links the program as-    -- we expect.-    if (null hs_srcs)-       then liftIO (oneShot hsc_env StopLn srcs)-       else do--    o_files <- mapM (\x -> liftIO $ compileFile hsc_env StopLn x)-                 non_hs_srcs-    dflags <- GHC.getSessionDynFlags-    let dflags' = dflags { ldInputs = map (FileOption "") o_files-                                      ++ ldInputs dflags }-    _ <- GHC.setSessionDynFlags dflags'--    targets <- mapM (uncurry GHC.guessTarget) hs_srcs-    GHC.setTargets targets-    ok_flag <- GHC.load LoadAllTargets--    when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))-    return ()
− tests/examples/ghc80/GA1r.hs 
@@ -1,5 +0,0 @@-module GA1r where-import Text.ParserCombinators.Parsec--parseStr :: CharParser () String-parseStr = char '"' *> (many1 (noneOf "\"")) <* char '"'
− tests/examples/ghc80/Generate.hs 
@@ -1,7 +0,0 @@-import Control.Monad (forM_)--main :: IO ()-main = forM_ [0..0xffff] $ \i -> do-   putStrLn $ ".section s" ++ show i ++ ",\"\",@progbits"-   putStrLn $ ".asciz \"Section " ++ show i ++ "\""-   putStrLn ""
− tests/examples/ghc80/Generic.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-}-module Env.Generic-  ( Record(..)-  , type (?)(..)-  ) where--import Data.Promotion.Prelude (type (:+$), type (:*$), type (:^$), type (:-$))-import Options.Generic (Generic, ParseRecord, type (<?>)(..))
− tests/examples/ghc80/IPLocation.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE ImplicitParams, RankNTypes #-}-{-# OPTIONS_GHC -dcore-lint #-}-module Main where--import GHC.Exception-import GHC.Types--f0 = putStrLn $ showCallStack ?loc-     -- should just show the location of ?loc--f1 :: (?loc :: CallStack) => IO ()-f1 = putStrLn $ showCallStack ?loc-     -- should show the location of ?loc *and* f1's call-site--f2 :: (?loc :: CallStack) => IO ()-f2 = do putStrLn $ showCallStack ?loc-        putStrLn $ showCallStack ?loc-     -- each ?loc should refer to a different location, but they should-     -- share f2's call-site--f3 :: ((?loc :: CallStack) => () -> IO ()) -> IO ()-f3 x = x ()-       -- the call-site for the functional argument should be added to the-       -- stack..--f4 :: (?loc :: CallStack) => ((?loc :: CallStack) => () -> IO ()) -> IO ()-f4 x = x ()-       -- as should the call-site for f4 itself--f5 :: (?loc1 :: CallStack) => ((?loc2 :: CallStack) => () -> IO ()) -> IO ()-f5 x = x ()-       -- we only push new call-sites onto CallStacks with the name IP name--f6 :: (?loc :: CallStack) => Int -> IO ()-f6 0 = putStrLn $ showCallStack ?loc-f6 n = f6 (n-1)-       -- recursive functions add a SrcLoc for each recursive call--main = do f0-          f1-          f2-          f3 (\ () -> putStrLn $ showCallStack ?loc)-          f4 (\ () -> putStrLn $ showCallStack ?loc)-          f5 (\ () -> putStrLn $ showCallStack ?loc3)-          f6 5
− tests/examples/ghc80/Improvement.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-module Foo where--type family F a-type instance F Int = Bool--class C a b where--instance (b~Int) => C Bool b--blug :: C (F a) a => a -> F a-blug = error "Urk"--foo :: Bool-foo = blug undefined--- [W] C (F a0) a0, F a0 ~ Bool-
− tests/examples/ghc80/KindEqualities.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE PolyKinds, GADTs, ExplicitForAll #-}-{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}--module KindEqualities where--data TyRep1 :: * -> * where-  TyInt1 :: TyRep1 Int-  TyBool1 :: TyRep1 Bool--zero1 :: forall a. TyRep1 a -> a-zero1 TyInt1 = 0-zero1 TyBool1 = False--data Proxy (a :: k) = P--data TyRep :: k -> * where-  TyInt :: TyRep Int-  TyBool :: TyRep Bool-  TyMaybe :: TyRep Maybe-  TyApp :: TyRep a -> TyRep b -> TyRep (a b)--zero :: forall (a :: *). TyRep a -> a-zero TyInt = 0-zero TyBool = False-zero (TyApp TyMaybe _) = Nothing
− tests/examples/ghc80/KindLevels.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE DataKinds, PolyKinds #-}--module KindLevels where--data A-data B :: A -> *-data C :: B a -> *-data D :: C b -> *-data E :: D c -> *
− tests/examples/ghc80/ListComprehensions.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE ParallelListComp,-             TransformListComp,-             RecordWildCards #-}---             MonadComprehensions,--module ListComprehensions where----import GHC.Exts-import qualified Data.Map as M-import Data.Ord (comparing)-import Data.List (sortBy)---- Let’s look at a simple, normal list comprehension to start:--parallelListComp :: [Int]-parallelListComp = [ x + y * z-                   | x <- [0..10]-                   | y <- [10..20]-                   | z <- [20..30]-                   ]--oldest :: [Int] -> [String]-oldest tbl = [ "str"-             | n <- tbl-             , then id-             ]
− tests/examples/ghc80/LiteralsTest2.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE MagicHash #-}-module LiteralsTest2 where--x,y :: Int-x = 0003-y = 0x04--s :: String-s = "\x20"--c :: Char-c = '\x20'--d :: Double-d = 0.00--blah = x-  where-    charH = '\x41'#-    intH = 0004#-    wordH = 005##-    floatH = 3.20#-    doubleH = 04.16##-    x = 1
− tests/examples/ghc80/Main.hs 
@@ -1,14 +0,0 @@--- Copyright (C) 2015, Luke Iannini--{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE ForeignFunctionInterface #-}--module Main where-import Printf ( pr )--foreign import ccall "talkToCxx" talkToCxx :: IO ()--main :: IO ()-main = do-  putStrLn ( $(pr "Hello From Template Haskell!") )-  talkToCxx
− tests/examples/ghc80/Manipulate.hs 
@@ -1,39 +0,0 @@-{- |-Module      :  Control.Comonad.Sheet.Manipulate-Description :  Generic functions for manipulating multi-dimensional comonadic spreadsheets.-Copyright   :  Copyright (c) 2014 Kenneth Foner--Maintainer  :  kenneth.foner@gmail.com-Stability   :  experimental-Portability :  non-portable--This module defines the 'take', 'view', 'go', and 'insert' functions generically for any dimensionality of sheet. These-constitute the preferred way of manipulating sheets, providing an interface to: take finite slices ('take'), infinite-slices ('view'), move to locations ('go'), and insert finite or infinite structures ('insert').--}--{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}--module Control.Comonad.Sheet.Manipulate where----- | In the case of a @Nested@ structure, @asDimensionalAs@ defaults to @asNestedAs@.-instance (NestedAs x (Nested ts y), AsDimensionalAs x (Nested ts y) ~ AsNestedAs x (Nested ts y)) => DimensionalAs x (Nested ts y) where-   type x `AsDimensionalAs` (Nested ts a) = x `AsNestedAs` (Nested ts a)-   asDimensionalAs = asNestedAs---- | @DimensionalAs@ also knows the dimensionality of an 'Indexed' sheet as well as regular @Nested@ structures.-instance (NestedAs x (Nested ts y)) => DimensionalAs x (Indexed ts y) where-   type x `AsDimensionalAs` (Indexed ts a) = x `AsNestedAs` (Nested ts a)-   x `asDimensionalAs` (Indexed i t)       = x `asNestedAs` t---instance DepIndex (a,b) TH_0 where-    type (a,b) `DepIndexResult` TH_0 = a-    (a,b) # TH_0 = a
− tests/examples/ghc80/Match.hs 
@@ -1,38 +0,0 @@-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE PatternGuards       #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE TypeOperators       #-}-{-# OPTIONS_HADDOCK hide #-}---- Discriminate binary functions that commute, and if so return the operands in--- a stable ordering such that matching recognises expressions modulo--- commutativity.----commutes-    :: forall acc env aenv a r.-       HashAcc acc-    -> PrimFun (a -> r)-    -> PreOpenExp acc env aenv a-    -> Maybe (PreOpenExp acc env aenv a)-commutes h f x = case f of-  PrimAdd _     -> Just (swizzle x)-  PrimMul _     -> Just (swizzle x)-  PrimBAnd _    -> Just (swizzle x)-  PrimBOr _     -> Just (swizzle x)-  PrimBXor _    -> Just (swizzle x)-  PrimEq _      -> Just (swizzle x)-  PrimNEq _     -> Just (swizzle x)-  PrimMax _     -> Just (swizzle x)-  PrimMin _     -> Just (swizzle x)-  PrimLAnd      -> Just (swizzle x)-  PrimLOr       -> Just (swizzle x)-  _             -> Nothing-  where-    swizzle :: PreOpenExp acc env aenv (a',a') -> PreOpenExp acc env aenv (a',a')-    swizzle exp-      | Tuple (NilTup `SnocTup` a `SnocTup` b)  <- exp-      , hashPreOpenExp h a > hashPreOpenExp h b = Tuple (NilTup `SnocTup` b `SnocTup` a)-      ---      | otherwise                               = exp
− tests/examples/ghc80/MonadFailErrors.hs 
@@ -1,95 +0,0 @@--- Test purpose:--- Break properly if MonadFail is live--{- # LANGUAGE MonadFailDesugaring # -}--module MonadFailWarnings where--import Control.Monad.Fail-import Control.Monad.ST-import Data.Functor.Identity----general :: Monad m => m a-general = do-    Just x <- undefined-    undefined----general' :: MonadFail m => m a-general' = do-    Just x <- undefined-    undefined----identity :: Identity a-identity = do-    Just x <- undefined-    undefined----io :: IO a-io = do-    Just x <- undefined-    undefined----st :: ST s a-st = do-    Just x <- undefined-    undefined----reader :: r -> a-reader = do-    Just x <- undefined-    undefined----newtype Newtype a = Newtype a-newtypeMatch :: Identity a-newtypeMatch = do-    Newtype x <- undefined-    undefined----data Data a = Data a-singleConMatch :: Identity a-singleConMatch = do-    Data x <- undefined-    undefined----data Maybe' a = Nothing' | Just' a-instance Functor Maybe' where fmap = undefined-instance Applicative Maybe' where pure = undefined; (<*>) = undefined-instance Monad Maybe' where (>>=) = undefined-instance MonadFail Maybe' where fail = undefined-customFailable :: Maybe' a-customFailable = do-    Just x <- undefined-    undefined---wildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a-wildcardx = do-    x <- undefined-    undefined-explicitlyIrrefutable = do-    ~(x:y) <- undefined-    undefined-wildcard_ = do-    _ <- undefined-    undefined-tuple = do-    (a,b) <- undefined-    undefined
− tests/examples/ghc80/MonadFailWarnings.hs 
@@ -1,107 +0,0 @@--- Test purpose:--- Ensure that MonadFail warnings are issued correctly if the warning flag--- is enabled--{-# OPTIONS_GHC -fwarn-missing-monadfail-instance #-}--module MonadFailWarnings where--import Control.Monad.Fail-import Control.Monad.ST-import Data.Functor.Identity------ should warn, because the do-block gets a general Monad constraint,--- but should have MonadFail-general :: Monad m => m a-general = do-    Just x <- undefined-    undefined------ should NOT warn, because the constraint is correct-general' :: MonadFail m => m a-general' = do-    Just x <- undefined-    undefined------ should warn, because Identity isn't MonadFail-identity :: Identity a-identity = do-    Just x <- undefined-    undefined------ should NOT warn, because IO is MonadFail-io :: IO a-io = do-    Just x <- undefined-    undefined------ should warn, because (ST s) is not MonadFail-st :: ST s a-st = do-    Just x <- undefined-    undefined------ should warn, because (r ->) is not MonadFail-reader :: r -> a-reader = do-    Just x <- undefined-    undefined------ should NOT warn, because matching against newtype-newtype Newtype a = Newtype a-newtypeMatch :: Identity a-newtypeMatch = do-    Newtype x <- undefined-    undefined------ should NOT warn, because Data has only one constructor-data Data a = Data a-singleConMatch :: Identity a-singleConMatch = do-    Data x <- undefined-    undefined------ should NOT warn, because Maybe' has a MonadFail instance-data Maybe' a = Nothing' | Just' a-instance Functor Maybe' where fmap = undefined-instance Applicative Maybe' where pure = undefined; (<*>) = undefined-instance Monad Maybe' where (>>=) = undefined-instance MonadFail Maybe' where fail = undefined-customFailable :: Maybe' a-customFailable = do-    Just x <- undefined-    undefined----- should NOT warn, because patterns always match-wildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a-wildcardx = do-    x <- undefined-    undefined-explicitlyIrrefutable = do-    ~(x:y) <- undefined-    undefined-wildcard_ = do-    _ <- undefined-    undefined-tuple = do-    (a,b) <- undefined-    undefined
− tests/examples/ghc80/MonadFailWarningsDisabled.hs 
@@ -1,94 +0,0 @@--- Test purpose:--- Make sure that not enabling MonadFail warnings makes code compile just--- as it did in < 8.0--module MonadFailWarnings where--import Control.Monad.Fail-import Control.Monad.ST-import Data.Functor.Identity----general :: Monad m => m a-general = do-    Just x <- undefined-    undefined----general' :: MonadFail m => m a-general' = do-    Just x <- undefined-    undefined----identity :: Identity a-identity = do-    Just x <- undefined-    undefined----io :: IO a-io = do-    Just x <- undefined-    undefined----st :: ST s a-st = do-    Just x <- undefined-    undefined----reader :: r -> a-reader = do-    Just x <- undefined-    undefined----newtype Newtype a = Newtype a-newtypeMatch :: Identity a-newtypeMatch = do-    Newtype x <- undefined-    undefined----data Data a = Data a-singleConMatch :: Identity a-singleConMatch = do-    Data x <- undefined-    undefined----data Maybe' a = Nothing' | Just' a-instance Functor Maybe' where fmap = undefined-instance Applicative Maybe' where pure = undefined; (<*>) = undefined-instance Monad Maybe' where (>>=) = undefined-instance MonadFail Maybe' where fail = undefined-customFailable :: Maybe' a-customFailable = do-    Just x <- undefined-    undefined---wildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a-wildcardx = do-    x <- undefined-    undefined-explicitlyIrrefutable = do-    ~(x:y) <- undefined-    undefined-wildcard_ = do-    _ <- undefined-    undefined-tuple = do-    (a,b) <- undefined-    undefined
− tests/examples/ghc80/MonadFailWarningsWithRebindableSyntax.hs 
@@ -1,14 +0,0 @@--- Test purpose:--- RebindableSyntax does not play that well with MonadFail, so here we ensure--- that when both settings are enabled we get the proper warning.--{-# OPTIONS_GHC -fwarn-missing-monadfail-instance #-}-{-# LANGUAGE RebindableSyntax #-}--module MonadFailWarningsWithRebindableSyntax where--import Prelude--test1 f g = do-    Just x <- f-    g
− tests/examples/ghc80/MonadT.hs 
@@ -1,48 +0,0 @@-{-# OPTIONS -XRank2Types #-}--module Control.Monatron.MonadT (-  MonadT(..), FMonadT(..), MMonadT(..), FComp(..), FunctorD(..), tmap, mtmap,-  module Control.Monad-) where--import Control.Monad---------------------------------------------------------------- Class of monad transformers with--- a lifting of first-order operations-------------------------------------------------------------class MonadT t where-    lift    :: Monad m  => m a -> t m a-    treturn :: Monad m => a -> t m a-    treturn =  lift. return-    tbind   :: Monad m => t m a -> (a -> t m b) -> t m b--newtype FunctorD f = FunctorD {fmapD :: forall a b . (a -> b) -> f a -> f b}--functor :: Functor f => FunctorD f-functor = FunctorD fmap--class MonadT t => FMonadT t where-    tmap' :: FunctorD m -> FunctorD n -> (a -> b) -> (forall x. m x -> n x) -> t m a -> t n b--tmap :: (FMonadT t, Functor m, Functor n) => (forall b. m b -> n b) -> t m a -> t n a-tmap = tmap' functor functor id--mtmap :: FMonadT t => FunctorD f -> (a -> b) -> t f a -> t f b-mtmap fd f = tmap' fd fd f id--class FMonadT t => MMonadT t where-    flift      :: Functor f => f a -> t f a --should coincide with lift!-    monoidalT  :: (Functor f, Functor g) => t f (t g a) -> t (FComp f g) a--------------------------------------------- Functor Composition-------------------------------------------newtype (FComp f g) a = Comp {deComp :: (f (g a)) }--instance (Functor f, Functor g) => Functor (FComp f g) where-    fmap f (Comp fga) = Comp (fmap (fmap f) fga)-
− tests/examples/ghc80/MultiLineWarningPragma.hs 
@@ -1,18 +0,0 @@--{-# WARNING Logic-          , mkSolver-          , mkSimpleSolver-          , mkSolverForLogic-          , solverSetParams-          , solverPush-          , solverPop-          , solverReset-          , solverGetNumScopes-          , solverAssertCnstr-          , solverAssertAndTrack-          , solverCheck-          , solverCheckAndGetModel-          , solverGetReasonUnknown-          "New Z3 API support is still incomplete and fragile: \-          \you may experience segmentation faults!"-  #-}
− tests/examples/ghc80/MultiQuote.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes#-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE EmptyCase #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- | Internal API for the store package. The functions here which are--- not re-exported by "Data.Store" are less likely to have stable APIs.------ This module also defines most of the included 'Store' instances, for--- types from the base package and other commonly used packages--- (bytestring, containers, text, time, etc).-module Data.Store.Internal where----------------------------------------------------------------------------- Instances generated by TH--$($(derive [d|-    -- TODO-    -- instance Deriving (Store ())-    instance Deriving (Store All)-    instance Deriving (Store Any)-    instance Deriving (Store Void)-    instance Deriving (Store Bool)-    |]))-
− tests/examples/ghc80/MultiWayIf.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE MultiWayIf #-}-module MultiWayIf where--foo = if | test1 -> e1-         | test2 witharg -> e2-         | otherwise -> def--bar = if { | test1 -> if { | test2 -> e1-                           | test3 -> e2 }-           | test4 -> e3-         }---- taken from GHC's test suite-x  = 10-x1 = if | x < 10 -> "< 10" | otherwise -> ""-x2 = if | x < 10 -> "< 10"-        | otherwise -> ""-x3 = if | x < 10 -> "< 10"-        | otherwise -> ""-x4 = if | True -> "yes"-x5 = if | True -> if | False -> 1 | True -> 2--x6 = if | x < 10 -> if | True -> "yes"-                       | False -> "no"-        | otherwise -> "maybe"--x7 = (if | True -> 0)---- issue #98-spam = if | () <- () -> ()
− tests/examples/ghc80/NamedWildcardInDataFamilyInstanceLHS.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE TypeFamilies, GADTs, DataKinds, PolyKinds, NamedWildCards #-}-module NamedWildcardInDataFamilyInstanceLHS where--data MyKind = A | B--data family Sing (a :: k)--data instance Sing (_a :: MyKind) where-    SingA :: Sing A-    SingB :: Sing B
− tests/examples/ghc80/NamedWildcardInTypeFamilyInstanceLHS.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE NamedWildCards #-}-module NamedWildcardInTypeFamilyInstanceLHS where--type family F a where-  F _t = Int
− tests/examples/ghc80/NamedWildcardInTypeSplice.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE NamedWildCards #-}-module NamedWildcardInTypeSplice where--import Language.Haskell.TH--metaType :: TypeQ-metaType = [t| _a -> _a |]
− tests/examples/ghc80/OutOfHeap.hs 
@@ -1,10 +0,0 @@-import qualified Data.Array.Unboxed as UA-import Data.Word--main :: IO ()-main = print (UA.listArray (1, 2^(20::Int)) (repeat 0)-              :: UA.UArray Int Word64)-       -- this unboxed array should at least take:-       --   2^20 * 64 bits-       -- = 8 * (2^20 bytes)-       -- = 8 MiB (in heap)
− tests/examples/ghc80/OverloadedRecFldsFail04_A.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}--module OverloadedRecFldsFail04_A (U(..), V(MkV, x), Unused(..), u) where--data U = MkU { x :: Bool, y :: Bool }-data V = MkV { x :: Int }-data Unused = MkUnused { unused :: Bool }--u = MkU False True
− tests/examples/ghc80/OverloadedRecFldsFail06_A.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# OPTIONS_GHC -fwarn-unused-binds #-}--module OverloadedRecFldsFail06_A (U(..), V(..), Unused(unused), u, getX, getY, z) where--data U = MkU { x :: Bool, y :: Bool } | MkU2 { used_locally :: Bool }-  deriving Show-data V = MkV { x :: Int } | MkV2 { y :: Bool }-data Unused = MkUnused { unused :: Bool, unused2 :: Bool, used_locally :: Bool }--u = MkU False True--z MkU2{used_locally=used_locally} = used_locally--getX MkU{x=x} = x-getY MkV2{y=y} = y
− tests/examples/ghc80/OverloadedRecFldsFail10_A.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module OverloadedRecFldsFail10_A where--data family F a-data instance F Int = MkFInt { foo :: Int }
− tests/examples/ghc80/OverloadedRecFldsFail10_B.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module OverloadedRecFldsFail10_B (F(..)) where--import OverloadedRecFldsFail10_A hiding (foo)--data instance F Bool = MkFBool { foo :: Int }
− tests/examples/ghc80/OverloadedRecFldsFail10_C.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}-module OverloadedRecFldsFail10_C (F(..)) where--import OverloadedRecFldsFail10_A--data instance F Char = MkFChar { foo :: Char }
− tests/examples/ghc80/OverloadedRecFldsFail11_A.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-module OverloadedRecFldsFail11_A where--{-# WARNING foo "Warning on a record field" #-}-data S = MkS { foo :: Bool }-data T = MkT { foo :: Int }
− tests/examples/ghc80/OverloadedRecFldsFail12_A.hs 
@@ -1,5 +0,0 @@-module OverloadedRecFldsFail12_A where--{-# WARNING foo "Deprecated foo" #-}-{-# WARNING bar "Deprecated bar" #-}-data T = MkT { foo :: Int, bar :: Int }
− tests/examples/ghc80/OverloadedRecFldsRun02_A.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}--module OverloadedRecFldsRun02_A (U(..), V(MkV, x), Unused(..), u) where--data U = MkU { x :: Bool, y :: Bool }-data V = MkV { x :: Int }-data Unused = MkUnused { unused :: Bool }--u = MkU False True
− tests/examples/ghc80/P.hs 
@@ -1,12 +0,0 @@-module P where--import qualified Map-import qualified Set--foo = do-    let x = Map.insert 0 "foo"-          . Map.insert (6 :: Int) "foo"-          $ Map.empty-    print (Map.lookup 1 x)-    print (Set.size (Map.keysSet x))-    return x
− tests/examples/ghc80/PSQ.hs 
@@ -1,4 +0,0 @@--data TourView a = Null-                | Single {-# UNPACK #-} !(Elem a)-                | (PSQ a) `Play` (PSQ a)
− tests/examples/ghc80/ParenFunBind.hs 
@@ -1,5 +0,0 @@-module ParenFunBind where--(foo x)   y  = x + y-((bar x)) y  = x + y-((baz x)) (y) = x + y
− tests/examples/ghc80/ParenTypeSynonym.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-module ParenTypeSynonym where--type Is = (~)
− tests/examples/ghc80/PartialClassMethodSignature2.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE PartialTypeSignatures #-}-module PartialClassMethodSignature2 where--class Foo a where-  foo :: (Eq a, _) => a -> a
− tests/examples/ghc80/PluralS.hs 
@@ -1,27 +0,0 @@--- Test purpose:------ Ensure the plural "s" in warnings is only shown if there are more than--- one entries--{-# OPTIONS_GHC -Wredundant-constraints #-}-{-# OPTIONS_GHC -Wtype-defaults #-}--module PluralS () where------ Defaulting type classes--defaultingNum = 123 `seq` ()--defaultingNumAndShow = show 123------ Redundant constraints--redundantNum :: (Num a, Num a) => a-redundantNum = 123--redundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a-redundantMultiple = 123
− tests/examples/ghc80/PolyInstances.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE PolyKinds, FlexibleInstances, ScopedTypeVariables,-             UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}--module PolyInstances where--import GHC.Exts-import Data.Proxy--class C (a :: k)--instance (C a, C b) => C (a b)--data Dict :: Constraint -> *--instance C Dict--foo :: C p => proxy p -> ()-foo = undefined--bar :: forall (p :: Constraint) proxy. C p => proxy p -> ()-bar _ = foo (Proxy :: Proxy (Dict p))
− tests/examples/ghc80/PopCnt.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE MagicHash,GHCForeignImportPrim,UnliftedFFITypes #-}-module Main where--import GHC.Exts--foreign import prim "do_popcnt32" popcnt32 :: Int# -> Int#--main = print (I# (popcnt32 0xffff#))-
− tests/examples/ghc80/Ppr017.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ExplicitNamespaces #-}-module Imports( f, type (+), pattern Single ) where--import GHC.TypeLits--pattern Single x = [x]--f = undefined
− tests/examples/ghc80/Primop.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE GHCForeignImportPrim, MagicHash,-             UnliftedFFITypes, UnboxedTuples #-}--import GHC.Exts--foreign import prim "dummy"-   dummy :: Word# -> Word#--foreign import prim "dummy2"-   dummy2 :: Any -> State# RealWorld -> (# State# RealWorld, Word# #)
− tests/examples/ghc80/Printf.hs 
@@ -1,34 +0,0 @@--- Copyright (C) 2015, Luke Iannini--{-# LANGUAGE TemplateHaskell #-}-module Printf where---- Skeletal printf from the paper:--- http://research.microsoft.com/pubs/67015/meta-haskell.pdf--- It needs to be in a separate module to the one where--- you intend to use it.---- Import some Template Haskell syntax-import Language.Haskell.TH---- Describe a format string-data Format = D | S | L String---- Parse a format string.  This is left largely to you--- as we are here interested in building our first ever--- Template Haskell program and not in building printf.-parse :: String -> [Format]-parse s   = [ L s ]---- Generate Haskell source code from a parsed representation--- of the format string.  This code will be spliced into--- the module which calls "pr", at compile time.-gen :: [Format] -> Q Exp-gen [D]   = [| \n -> show n |]-gen [S]   = [| \s -> s |]-gen [L s] = stringE s---- Here we generate the Haskell code for the splice--- from an input format string.-pr :: String -> Q Exp-pr s = gen (parse s)
− tests/examples/ghc80/PromotedClass.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE TypeInType, GADTs #-}--module PromotedClass where--import Data.Proxy--data X a where-  MkX :: Show a => a -> X a--foo :: Proxy ('MkX 'True)-foo = Proxy
− tests/examples/ghc80/Q.hs 
@@ -1,7 +0,0 @@-module Q where--import qualified Map-import Map(Map)--mymember :: Int -> Map Int a -> Bool-mymember k m = Map.member k m || Map.member (k + 1) m
− tests/examples/ghc80/QQ.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module QQ where--import Language.Haskell.TH.Quote-import Language.Haskell.TH.Syntax-import Language.Haskell.TH--pq = QuasiQuoter { quoteDec = \_ -> return [sig],-                   quoteType = \_ -> undefined,-                   quoteExp = \_ -> undefined,-                   quotePat = \_ -> undefined }--sig = SigD (mkName "f") (ArrowT `AppT` int `AppT` int)-int = ConT (mkName "Int")
− tests/examples/ghc80/Query.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE CPP #-}--module AWS.Lib.Query where--requestQuery = do-    if st < 400-#ifdef DEBUG-        do  e-#else-        then return body-        else fail "not reached"-#endif-
− tests/examples/ghc80/RandomPGC.hs 
@@ -1,597 +0,0 @@-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 701-{-# LANGUAGE Trustworthy #-}-#endif---------------------------------------------------------------------------------- |--- Module      :  System.Random--- Copyright   :  (c) The University of Glasgow 2001--- License     :  BSD-style (see the file LICENSE in the 'random' repository)------ Maintainer  :  libraries@haskell.org--- Stability   :  stable--- Portability :  portable------ This library deals with the common task of pseudo-random number--- generation. The library makes it possible to generate repeatable--- results, by starting with a specified initial random number generator,--- or to get different results on each run by using the system-initialised--- generator or by supplying a seed from some other source.------ The library is split into two layers:------ * A core /random number generator/ provides a supply of bits.---   The class 'RandomGen' provides a common interface to such generators.---   The library provides one instance of 'RandomGen', the abstract---   data type 'StdGen'.  Programmers may, of course, supply their own---   instances of 'RandomGen'.------ * The class 'Random' provides a way to extract values of a particular---   type from a random number generator.  For example, the 'Float'---   instance of 'Random' allows one to generate random values of type---   'Float'.------ This implementation uses the Portable Combined Generator of L'Ecuyer--- ["System.Random\#LEcuyer"] for 32-bit computers, transliterated by--- Lennart Augustsson.  It has a period of roughly 2.30584e18.-----------------------------------------------------------------------------------#include "MachDeps.h"--module RandomPGC-        (--        -- $intro--        -- * Random number generators--#ifdef ENABLE_SPLITTABLEGEN-          RandomGen(next, genRange)-        , SplittableGen(split)-#else-          RandomGen(next, genRange, split)-#endif-        -- ** Standard random number generators-        , StdGen-        , mkStdGen--        -- ** The global random number generator--        -- $globalrng--        , getStdRandom-        , getStdGen-        , setStdGen-        , newStdGen--        -- * Random values of various types-        , Random ( random,   randomR,-                   randoms,  randomRs,-                   randomIO, randomRIO )--        -- * References-        -- $references--        ) where--import Prelude--import Data.Bits-import Data.Int-import Data.Word-import Foreign.C.Types--#ifdef __NHC__-import CPUTime          ( getCPUTime )-import Foreign.Ptr      ( Ptr, nullPtr )-import Foreign.C        ( CTime, CUInt )-#else-import System.CPUTime   ( getCPUTime )-import Data.Time        ( getCurrentTime, UTCTime(..) )-import Data.Ratio       ( numerator, denominator )-#endif-import Data.Char        ( isSpace, chr, ord )-import System.IO.Unsafe ( unsafePerformIO )-import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )-import Data.IORef       ( atomicModifyIORef' )-import Numeric          ( readDec )--#ifdef __GLASGOW_HASKELL__-import GHC.Exts         ( build )-#else--- | A dummy variant of build without fusion.-{-# INLINE build #-}-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build g = g (:) []-#endif---- The standard nhc98 implementation of Time.ClockTime does not match--- the extended one expected in this module, so we lash-up a quick--- replacement here.-#ifdef __NHC__-foreign import ccall "time.h time" readtime :: Ptr CTime -> IO CTime-getTime :: IO (Integer, Integer)-getTime = do CTime t <- readtime nullPtr;  return (toInteger t, 0)-#else-getTime :: IO (Integer, Integer)-getTime = do-  utc <- getCurrentTime-  let daytime = toRational $ utctDayTime utc-  return $ quotRem (numerator daytime) (denominator daytime)-#endif---- | The class 'RandomGen' provides a common interface to random number--- generators.----#ifdef ENABLE_SPLITTABLEGEN--- Minimal complete definition: 'next'.-#else--- Minimal complete definition: 'next' and 'split'.-#endif--class RandomGen g where--   -- |The 'next' operation returns an 'Int' that is uniformly distributed-   -- in the range returned by 'genRange' (including both end points),-   -- and a new generator.-   next     :: g -> (Int, g)--   -- |The 'genRange' operation yields the range of values returned by-   -- the generator.-   ---   -- It is required that:-   ---   -- * If @(a,b) = 'genRange' g@, then @a < b@.-   ---   -- * 'genRange' always returns a pair of defined 'Int's.-   ---   -- The second condition ensures that 'genRange' cannot examine its-   -- argument, and hence the value it returns can be determined only by the-   -- instance of 'RandomGen'.  That in turn allows an implementation to make-   -- a single call to 'genRange' to establish a generator's range, without-   -- being concerned that the generator returned by (say) 'next' might have-   -- a different range to the generator passed to 'next'.-   ---   -- The default definition spans the full range of 'Int'.-   genRange :: g -> (Int,Int)--   -- default method-   genRange _ = (minBound, maxBound)--#ifdef ENABLE_SPLITTABLEGEN--- | The class 'SplittableGen' proivides a way to specify a random number---   generator that can be split into two new generators.-class SplittableGen g where-#endif-   -- |The 'split' operation allows one to obtain two distinct random number-   -- generators. This is very useful in functional programs (for example, when-   -- passing a random number generator down to recursive calls), but very-   -- little work has been done on statistically robust implementations of-   -- 'split' (["System.Random\#Burton", "System.Random\#Hellekalek"]-   -- are the only examples we know of).-   split    :: g -> (g, g)--{- |-The 'StdGen' instance of 'RandomGen' has a 'genRange' of at least 30 bits.--The result of repeatedly using 'next' should be at least as statistically-robust as the /Minimal Standard Random Number Generator/ described by-["System.Random\#Park", "System.Random\#Carta"].-Until more is known about implementations of 'split', all we require is-that 'split' deliver generators that are (a) not identical and-(b) independently robust in the sense just given.--The 'Show' and 'Read' instances of 'StdGen' provide a primitive way to save the-state of a random number generator.-It is required that @'read' ('show' g) == g@.--In addition, 'reads' may be used to map an arbitrary string (not necessarily one-produced by 'show') onto a value of type 'StdGen'. In general, the 'Read'-instance of 'StdGen' has the following properties:--* It guarantees to succeed on any string.--* It guarantees to consume only a finite portion of the string.--* Different argument strings are likely to result in different results.---}--data StdGen- = StdGen !Int32 !Int32--instance RandomGen StdGen where-  next  = stdNext-  genRange _ = stdRange--#ifdef ENABLE_SPLITTABLEGEN-instance SplittableGen StdGen where-#endif-  split = stdSplit--instance Show StdGen where-  showsPrec p (StdGen s1 s2) =-     showsPrec p s1 .-     showChar ' ' .-     showsPrec p s2--instance Read StdGen where-  readsPrec _p = \ r ->-     case try_read r of-       r'@[_] -> r'-       _   -> [stdFromString r] -- because it shouldn't ever fail.-    where-      try_read r = do-         (s1, r1) <- readDec (dropWhile isSpace r)-         (s2, r2) <- readDec (dropWhile isSpace r1)-         return (StdGen s1 s2, r2)--{-- If we cannot unravel the StdGen from a string, create- one based on the string given.--}-stdFromString         :: String -> (StdGen, String)-stdFromString s        = (mkStdGen num, rest)-        where (cs, rest) = splitAt 6 s-              num        = foldl (\a x -> x + 3 * a) 1 (map ord cs)---{- |-The function 'mkStdGen' provides an alternative way of producing an initial-generator, by mapping an 'Int' into a generator. Again, distinct arguments-should be likely to produce distinct generators.--}-mkStdGen :: Int -> StdGen -- why not Integer ?-mkStdGen s = mkStdGen32 $ fromIntegral s--{--From ["System.Random\#LEcuyer"]: "The integer variables s1 and s2 ... must be-initialized to values in the range [1, 2147483562] and [1, 2147483398]-respectively."--}-mkStdGen32 :: Int32 -> StdGen-mkStdGen32 sMaybeNegative = StdGen (s1+1) (s2+1)-      where-        -- We want a non-negative number, but we can't just take the abs-        -- of sMaybeNegative as -minBound == minBound.-        s       = sMaybeNegative .&. maxBound-        (q, s1) = s `divMod` 2147483562-        s2      = q `mod` 2147483398--createStdGen :: Integer -> StdGen-createStdGen s = mkStdGen32 $ fromIntegral s--{- |-With a source of random number supply in hand, the 'Random' class allows the-programmer to extract random values of a variety of types.--Minimal complete definition: 'randomR' and 'random'.---}--class Random a where-  -- | Takes a range /(lo,hi)/ and a random number generator-  -- /g/, and returns a random value uniformly distributed in the closed-  -- interval /[lo,hi]/, together with a new generator. It is unspecified-  -- what happens if /lo>hi/. For continuous types there is no requirement-  -- that the values /lo/ and /hi/ are ever produced, but they may be,-  -- depending on the implementation and the interval.-  randomR :: RandomGen g => (a,a) -> g -> (a,g)--  -- | The same as 'randomR', but using a default range determined by the type:-  ---  -- * For bounded types (instances of 'Bounded', such as 'Char'),-  --   the range is normally the whole type.-  ---  -- * For fractional types, the range is normally the semi-closed interval-  -- @[0,1)@.-  ---  -- * For 'Integer', the range is (arbitrarily) the range of 'Int'.-  random  :: RandomGen g => g -> (a, g)--  -- | Plural variant of 'randomR', producing an infinite list of-  -- random values instead of returning a new generator.-  {-# INLINE randomRs #-}-  randomRs :: RandomGen g => (a,a) -> g -> [a]-  randomRs ival g = build (\cons _nil -> buildRandoms cons (randomR ival) g)--  -- | Plural variant of 'random', producing an infinite list of-  -- random values instead of returning a new generator.-  {-# INLINE randoms #-}-  randoms  :: RandomGen g => g -> [a]-  randoms  g      = build (\cons _nil -> buildRandoms cons random g)--  -- | A variant of 'randomR' that uses the global random number generator-  -- (see "System.Random#globalrng").-  randomRIO :: (a,a) -> IO a-  randomRIO range  = getStdRandom (randomR range)--  -- | A variant of 'random' that uses the global random number generator-  -- (see "System.Random#globalrng").-  randomIO  :: IO a-  randomIO         = getStdRandom random---- | Produce an infinite list-equivalent of random values.-{-# INLINE buildRandoms #-}-buildRandoms :: RandomGen g-             => (a -> as -> as)  -- ^ E.g. '(:)' but subject to fusion-             -> (g -> (a,g))     -- ^ E.g. 'random'-             -> g                -- ^ A 'RandomGen' instance-             -> as-buildRandoms cons rand = go-  where-    -- The seq fixes part of #4218 and also makes fused Core simpler.-    go g = x `seq` (x `cons` go g') where (x,g') = rand g---instance Random Integer where-  randomR ival g = randomIvalInteger ival g-  random g       = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g--instance Random Int        where randomR = randomIvalIntegral; random = randomBounded-instance Random Int8       where randomR = randomIvalIntegral; random = randomBounded-instance Random Int16      where randomR = randomIvalIntegral; random = randomBounded-instance Random Int32      where randomR = randomIvalIntegral; random = randomBounded-instance Random Int64      where randomR = randomIvalIntegral; random = randomBounded--#ifndef __NHC__--- Word is a type synonym in nhc98.-instance Random Word       where randomR = randomIvalIntegral; random = randomBounded-#endif-instance Random Word8      where randomR = randomIvalIntegral; random = randomBounded-instance Random Word16     where randomR = randomIvalIntegral; random = randomBounded-instance Random Word32     where randomR = randomIvalIntegral; random = randomBounded-instance Random Word64     where randomR = randomIvalIntegral; random = randomBounded--instance Random CChar      where randomR = randomIvalIntegral; random = randomBounded-instance Random CSChar     where randomR = randomIvalIntegral; random = randomBounded-instance Random CUChar     where randomR = randomIvalIntegral; random = randomBounded-instance Random CShort     where randomR = randomIvalIntegral; random = randomBounded-instance Random CUShort    where randomR = randomIvalIntegral; random = randomBounded-instance Random CInt       where randomR = randomIvalIntegral; random = randomBounded-instance Random CUInt      where randomR = randomIvalIntegral; random = randomBounded-instance Random CLong      where randomR = randomIvalIntegral; random = randomBounded-instance Random CULong     where randomR = randomIvalIntegral; random = randomBounded-instance Random CPtrdiff   where randomR = randomIvalIntegral; random = randomBounded-instance Random CSize      where randomR = randomIvalIntegral; random = randomBounded-instance Random CWchar     where randomR = randomIvalIntegral; random = randomBounded-instance Random CSigAtomic where randomR = randomIvalIntegral; random = randomBounded-instance Random CLLong     where randomR = randomIvalIntegral; random = randomBounded-instance Random CULLong    where randomR = randomIvalIntegral; random = randomBounded-instance Random CIntPtr    where randomR = randomIvalIntegral; random = randomBounded-instance Random CUIntPtr   where randomR = randomIvalIntegral; random = randomBounded-instance Random CIntMax    where randomR = randomIvalIntegral; random = randomBounded-instance Random CUIntMax   where randomR = randomIvalIntegral; random = randomBounded--instance Random Char where-  randomR (a,b) g =-       case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of-         (x,g') -> (chr x, g')-  random g        = randomR (minBound,maxBound) g--instance Random Bool where-  randomR (a,b) g =-      case (randomIvalInteger (bool2Int a, bool2Int b) g) of-        (x, g') -> (int2Bool x, g')-       where-         bool2Int :: Bool -> Integer-         bool2Int False = 0-         bool2Int True  = 1--         int2Bool :: Int -> Bool-         int2Bool 0     = False-         int2Bool _     = True--  random g        = randomR (minBound,maxBound) g--{-# INLINE randomRFloating #-}-randomRFloating :: (Fractional a, Num a, Ord a, Random a, RandomGen g) => (a, a) -> g -> (a, g)-randomRFloating (l,h) g-    | l>h       = randomRFloating (h,l) g-    | otherwise = let (coef,g') = random g in-                  (2.0 * (0.5*l + coef * (0.5*h - 0.5*l)), g')  -- avoid overflow--instance Random Double where-  randomR = randomRFloating-  random rng     =-    case random rng of-      (x,rng') ->-          -- We use 53 bits of randomness corresponding to the 53 bit significand:-          ((fromIntegral (mask53 .&. (x::Int64)) :: Double)-           /  fromIntegral twoto53, rng')-   where-    twoto53 = (2::Int64) ^ (53::Int64)-    mask53 = twoto53 - 1--instance Random Float where-  randomR = randomRFloating-  random rng =-    -- TODO: Faster to just use 'next' IF it generates enough bits of randomness.-    case random rng of-      (x,rng') ->-          -- We use 24 bits of randomness corresponding to the 24 bit significand:-          ((fromIntegral (mask24 .&. (x::Int32)) :: Float)-           /  fromIntegral twoto24, rng')-         -- Note, encodeFloat is another option, but I'm not seeing slightly-         --  worse performance with the following [2011.06.25]:---         (encodeFloat rand (-24), rng')-   where-     mask24 = twoto24 - 1-     twoto24 = (2::Int32) ^ (24::Int32)---- CFloat/CDouble are basically the same as a Float/Double:-instance Random CFloat where-  randomR = randomRFloating-  random rng = case random rng of-                 (x,rng') -> (realToFrac (x::Float), rng')--instance Random CDouble where-  randomR = randomRFloating-  -- A MYSTERY:-  -- Presently, this is showing better performance than the Double instance:-  -- (And yet, if the Double instance uses randomFrac then its performance is much worse!)-  random  = randomFrac-  -- random rng = case random rng of-  --             (x,rng') -> (realToFrac (x::Double), rng')--mkStdRNG :: Integer -> IO StdGen-mkStdRNG o = do-    ct          <- getCPUTime-    (sec, psec) <- getTime-    return (createStdGen (sec * 12345 + psec + ct + o))--randomBounded :: (RandomGen g, Random a, Bounded a) => g -> (a, g)-randomBounded = randomR (minBound, maxBound)---- The two integer functions below take an [inclusive,inclusive] range.-randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)-randomIvalIntegral (l,h) = randomIvalInteger (toInteger l, toInteger h)--{-# SPECIALIZE randomIvalInteger :: (Num a) =>-    (Integer, Integer) -> StdGen -> (a, StdGen) #-}--randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)-randomIvalInteger (l,h) rng- | l > h     = randomIvalInteger (h,l) rng- | otherwise = case (f 1 0 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')-     where-       (genlo, genhi) = genRange rng-       b = fromIntegral genhi - fromIntegral genlo + 1--       -- Probabilities of the most likely and least likely result-       -- will differ at most by a factor of (1 +- 1/q).  Assuming the RandomGen-       -- is uniform, of course--       -- On average, log q / log b more random values will be generated-       -- than the minimum-       q = 1000-       k = h - l + 1-       magtgt = k * q--       -- generate random values until we exceed the target magnitude-       f mag v g | mag >= magtgt = (v, g)-                 | otherwise = v' `seq`f (mag*b) v' g' where-                        (x,g') = next g-                        v' = (v * b + (fromIntegral x - fromIntegral genlo))----- The continuous functions on the other hand take an [inclusive,exclusive) range.-randomFrac :: (RandomGen g, Fractional a) => g -> (a, g)-randomFrac = randomIvalDouble (0::Double,1) realToFrac--randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)-randomIvalDouble (l,h) fromDouble rng-  | l > h     = randomIvalDouble (h,l) fromDouble rng-  | otherwise =-       case (randomIvalInteger (toInteger (minBound::Int32), toInteger (maxBound::Int32)) rng) of-         (x, rng') ->-            let-             scaled_x =-                fromDouble (0.5*l + 0.5*h) +                   -- previously (l+h)/2, overflowed-                fromDouble ((0.5*h - 0.5*l) / (0.5 * realToFrac int32Count)) *  -- avoid overflow-                fromIntegral (x::Int32)-            in-            (scaled_x, rng')--int32Count :: Integer-int32Count = toInteger (maxBound::Int32) - toInteger (minBound::Int32) + 1  -- GHC ticket #3982--stdRange :: (Int,Int)-stdRange = (1, 2147483562)--stdNext :: StdGen -> (Int, StdGen)--- Returns values in the range stdRange-stdNext (StdGen s1 s2) = (fromIntegral z', StdGen s1'' s2'')-        where   z'   = if z < 1 then z + 2147483562 else z-                z    = s1'' - s2''--                k    = s1 `quot` 53668-                s1'  = 40014 * (s1 - k * 53668) - k * 12211-                s1'' = if s1' < 0 then s1' + 2147483563 else s1'--                k'   = s2 `quot` 52774-                s2'  = 40692 * (s2 - k' * 52774) - k' * 3791-                s2'' = if s2' < 0 then s2' + 2147483399 else s2'--stdSplit            :: StdGen -> (StdGen, StdGen)-stdSplit std@(StdGen s1 s2)-                     = (left, right)-                       where-                        -- no statistical foundation for this!-                        left    = StdGen new_s1 t2-                        right   = StdGen t1 new_s2--                        new_s1 | s1 == 2147483562 = 1-                               | otherwise        = s1 + 1--                        new_s2 | s2 == 1          = 2147483398-                               | otherwise        = s2 - 1--                        StdGen t1 t2 = snd (next std)---- The global random number generator--{- $globalrng #globalrng#--There is a single, implicit, global random number generator of type-'StdGen', held in some global variable maintained by the 'IO' monad. It is-initialised automatically in some system-dependent fashion, for example, by-using the time of day, or Linux's kernel random number generator. To get-deterministic behaviour, use 'setStdGen'.--}---- |Sets the global random number generator.-setStdGen :: StdGen -> IO ()-setStdGen sgen = writeIORef theStdGen sgen---- |Gets the global random number generator.-getStdGen :: IO StdGen-getStdGen  = readIORef theStdGen--theStdGen :: IORef StdGen-theStdGen  = unsafePerformIO $ do-   rng <- mkStdRNG 0-   newIORef rng---- |Applies 'split' to the current global random generator,--- updates it with one of the results, and returns the other.-newStdGen :: IO StdGen-newStdGen = atomicModifyIORef' theStdGen split--{- |Uses the supplied function to get a value from the current global-random generator, and updates the global generator with the new generator-returned by the function. For example, @rollDice@ gets a random integer-between 1 and 6:-->  rollDice :: IO Int->  rollDice = getStdRandom (randomR (1,6))---}--getStdRandom :: (StdGen -> (a,StdGen)) -> IO a-getStdRandom f = atomicModifyIORef' theStdGen (swap . f)-  where swap (v,g) = (g,v)--{- $references--1. FW #Burton# Burton and RL Page, /Distributed random number generation/,-Journal of Functional Programming, 2(2):203-212, April 1992.--2. SK #Park# Park, and KW Miller, /Random number generators --good ones are hard to find/, Comm ACM 31(10), Oct 1988, pp1192-1201.--3. DG #Carta# Carta, /Two fast implementations of the minimal standard-random number generator/, Comm ACM, 33(1), Jan 1990, pp87-88.--4. P #Hellekalek# Hellekalek, /Don\'t trust parallel Monte Carlo/,-Department of Mathematics, University of Salzburg,-<http://random.mat.sbg.ac.at/~peter/pads98.ps>, 1998.--5. Pierre #LEcuyer# L'Ecuyer, /Efficient and portable combined random-number generators/, Comm ACM, 31(6), Jun 1988, pp742-749.--The Web site <http://random.mat.sbg.ac.at/> is a great source of information.---}
− tests/examples/ghc80/RepArrow.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module RepArrow where--import Data.Ord ( Down )  -- convenient "Id" newtype, without its constructor-import Data.Coerce--foo :: Coercible (Down (Int -> Int)) (Int -> Int) => Down (Int -> Int) -> Int -> Int-foo = coerce
− tests/examples/ghc80/Roles12a.hs 
@@ -1,2 +0,0 @@-module Roles12a where-import {-# SOURCE #-} Roles12
− tests/examples/ghc80/RuleDefiningPlugin.hs 
@@ -1,8 +0,0 @@-module RuleDefiningPlugin where--import GhcPlugins--{-# RULES "unsound" forall x. show x = "SHOWED" #-}--plugin :: Plugin-plugin = defaultPlugin
− tests/examples/ghc80/RulePragma.hs 
@@ -1,7 +0,0 @@-module Data.Text.Internal.Fusion.Common where--{-#-  RULES "STREAM map/map fusion" forall f g s.-     map f (map g s) = map (\x -> f (g x)) s- #-}-
− tests/examples/ghc80/SH_Overlap1.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE FlexibleInstances #-}---- | Compilation should fail as we have overlapping instances that don't obey--- our heuristics.-module SH_Overlap1 where--import safe SH_Overlap1_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap10.hs 
@@ -1,17 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as `SH_Overlap6`, but now we are inferring safety. Safe since--- overlapped instance declares itself overlappable.-module SH_Overlap10 where--import SH_Overlap10_A--instance-  {-# OVERLAPS #-}-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap10_A.hs 
@@ -1,13 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap10_A (-    C(..)-  ) where--import SH_Overlap10_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap10_B.hs 
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-module SH_Overlap10_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap11.hs 
@@ -1,18 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as `SH_Overlap6`, but now we are inferring safety. Should be inferred--- unsafe due to overlapping instances at call site `f`.------ Testing that we are given correct reason.-module SH_Overlap11 where--import SH_Overlap11_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap11_A.hs 
@@ -1,13 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap11_A (-    C(..)-  ) where--import SH_Overlap11_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap11_B.hs 
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-module SH_Overlap11_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap1_A.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap1_A (-    C(..)-  ) where--import SH_Overlap1_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap1_B.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE Safe #-}-module SH_Overlap1_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap2.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as SH_Overlap1, but SH_Overlap2_A is not imported as 'safe'.------ Question: Should the OI-check be enforced? Y, see reasoning in--- `SH_Overlap4.hs` for why the Safe Haskell overlapping instance check should--- be tied to Safe Haskell mode only, and not to safe imports.-module SH_Overlap2 where--import SH_Overlap2_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap2_A.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap2_A (-    C(..)-  ) where--import SH_Overlap2_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap2_B.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE Safe #-}-module SH_Overlap2_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap3.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE Unsafe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as SH_Overlap1, but module where overlap occurs (SH_Overlap3) is--- marked `Unsafe`. Compilation should succeed (symetry with inferring safety).-module SH_Overlap3 where--import SH_Overlap3_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap3_A.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap3_A (-    C(..)-  ) where--import SH_Overlap3_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap3_B.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE Safe #-}-module SH_Overlap3_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap4.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE Unsafe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as SH_Overlap3, however, SH_Overlap4_A is imported as `safe`.------ Question: Should compilation now fail? N. At first it seems a nice idea to--- tie the overlap check to safe imports. However, instances are a global--- entity and can be imported by multiple import paths. How should safe imports--- interact with this? Especially when considering transitive situations...------ Simplest is to just enforce the overlap check in Safe and Trustworthy--- modules, but not in Unsafe ones.-module SH_Overlap4 where--import safe SH_Overlap4_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap4_A.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap4_A (-    C(..)-  ) where--import SH_Overlap4_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap4_B.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE Safe #-}-module SH_Overlap4_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap5.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Compilation should fail as we have overlapping instances that don't obey--- our heuristics.-module SH_Overlap5 where--import safe SH_Overlap5_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap5_A.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap5_A (-    C(..)-  ) where--import SH_Overlap5_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap5_B.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE Safe #-}-module SH_Overlap5_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap6.hs 
@@ -1,15 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as `SH_Overlap5` but dependencies are now inferred-safe, not--- explicitly marked. Compilation should still fail.-module SH_Overlap6 where--import safe SH_Overlap6_A--instance C [a] where-  f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap6_A.hs 
@@ -1,13 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap6_A (-    C(..)-  ) where--import SH_Overlap6_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap6_B.hs 
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-module SH_Overlap6_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap7.hs 
@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as `SH_Overlap6`, but now we are inferring safety. Should be inferred--- unsafe due to overlapping instances at call site `f`.-module SH_Overlap7 where--import SH_Overlap7_A--instance C [a] where-  f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap7_A.hs 
@@ -1,14 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE Safe #-}-module SH_Overlap7_A (-    C(..)-  ) where--import SH_Overlap7_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap7_B.hs 
@@ -1,9 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE Safe #-}-module SH_Overlap7_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SH_Overlap8.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Overlapping instances, but with a single parameter type-class and no--- orphans. So `SH_Overlap8` decided to explictly depend on `SH_Overlap8_A`--- since that's where the type-class `C` with function `f` is defined.------ Question: Safe or Unsafe? Safe-module SH_Overlap8 where--import safe SH_Overlap8_A--instance C [a] where-  f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap8_A.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE Safe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap8_A (-    C(..)-  ) where--class C a where-  f :: a -> String--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap9.hs 
@@ -1,16 +0,0 @@-{-# OPTIONS_GHC -fwarn-safe #-}-{-# LANGUAGE FlexibleInstances #-}---- | Same as `SH_Overlap6`, but now we are inferring safety. Should be inferred--- unsafe due to overlapping instances at call site `f`.-module SH_Overlap9 where--import SH_Overlap9_A--instance-  C [a] where-    f _ = "[a]"--test :: String-test = f ([1,2,3,4] :: [Int])-
− tests/examples/ghc80/SH_Overlap9_A.hs 
@@ -1,13 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-{-# LANGUAGE FlexibleInstances #-}-module SH_Overlap9_A (-    C(..)-  ) where--import SH_Overlap9_B--instance-  {-# OVERLAPS #-}-  C [Int] where-    f _ = "[Int]"-
− tests/examples/ghc80/SH_Overlap9_B.hs 
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -fwarn-unsafe #-}-module SH_Overlap9_B (-    C(..)-  ) where--class C a where-  f :: a -> String-
− tests/examples/ghc80/SayAnnNames.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module SayAnnNames (plugin, SomeAnn(..)) where-import GhcPlugins-import Control.Monad (unless)-import Data.Data--data SomeAnn = SomeAnn deriving (Data, Typeable)--plugin :: Plugin-plugin = defaultPlugin {-  installCoreToDos = install-  }--install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]-install _ todo = do-  reinitializeGlobals-  return (CoreDoPluginPass "Say name" pass : todo)--pass :: ModGuts -> CoreM ModGuts-pass g = do-          dflags <- getDynFlags-          mapM_ (printAnn dflags g) (mg_binds g) >> return g-  where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind-        printAnn dflags guts bndr@(NonRec b _) = do-          anns <- annotationsOn guts b :: CoreM [SomeAnn]-          unless (null anns) $ putMsgS $-            "Annotated binding found: " ++  showSDoc dflags (ppr b)-          return bndr-        printAnn _ _ bndr = return bndr--annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]-annotationsOn guts bndr = do-  anns <- getAnnotations deserializeWithData guts-  return $ lookupWithDefaultUFM anns [] (varUnique bndr)
− tests/examples/ghc80/SelfDep.hs 
@@ -1,3 +0,0 @@-module SelfDep where--data T :: T -> *
− tests/examples/ghc80/SemicolonIf.hs 
@@ -1,15 +0,0 @@-module Bar where--import Data.Text as Text--replace :: Text -> Text-replace = Text.map (\c -> if c == '_' then '.'; else c)--replace1 :: Text -> Text-replace1 = Text.map (\c -> if c == '_' ; then '.' else c)--replace2 :: Text -> Text-replace2 = Text.map (\c -> if c == '_'; then '.'; else c)--replace4 :: Text -> Text-replace4 = Text.map (\c -> if c == '_' then '.' else c)
− tests/examples/ghc80/SemigroupWarnings.hs 
@@ -1,34 +0,0 @@--- Test purpose:--- Ensure that missing semigroup warnings are issued--- correctly if the warning flag is enabled--{-# OPTIONS_GHC -fwarn-semigroup #-}--module SemigroupWarnings where----import Data.Semigroup------ Bad instance, should complain about missing Semigroup parent-data LacksSemigroup-instance Monoid LacksSemigroup where-    mempty = undefined-    mappend = undefined------ Correct instance, should not warn-data HasSemigroup-instance Semigroup HasSemigroup where-    (<>) = undefined-instance Monoid HasSemigroup where-    mempty = undefined-    mappend = undefined------ Should issue a Prelude clash warning-(<>) = undefined
− tests/examples/ghc80/Setup.hs 
@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain
− tests/examples/ghc80/ShouldFail.hs 
@@ -1,1 +0,0 @@-import Set
− tests/examples/ghc80/SigTvKinds.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE PolyKinds #-}--module SigTvKinds where--data T (a :: k1) x = MkT (S a ())-data S (b :: k2) y = MkS (T b ())-  -- tests TcTyClsDecls.no_sig_tv
− tests/examples/ghc80/SigTvKinds2.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE PolyKinds #-}--module SigTvKinds2 where--data SameKind :: k -> k -> *--data Q (a :: k1) (b :: k2) c = MkQ (SameKind a b)
− tests/examples/ghc80/SpecializePhaseControl.hs 
@@ -1,15 +0,0 @@-{-# SPECIALISE [1] x ::-        Integer -> Integer -> Integer,-        Integer -> Int -> Integer,-        Int -> Int -> Int #-}-{-# INLINABLE [1] x #-}-x :: (Num a, Integral b) => a -> b -> a-x = undefined--{-# SPECIALISE INLINE [999] y ::-        Integer -> Integer -> Integer,-        Integer -> Int -> Integer,-        Int -> Int -> Int #-}-{-# INLINABLE [1] y #-}-y :: (Num a, Integral b) => a -> b -> a-y = undefined
− tests/examples/ghc80/Splices.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE NamedWildCards #-}-module Splices where--import Language.Haskell.TH-import Language.Haskell.TH.Lib (wildCardT)--metaType1 :: TypeQ-metaType1 = wildCardT--metaType2 :: TypeQ-metaType2 = [t| _ |]--metaType3 :: TypeQ-metaType3 = [t| _ -> _ -> _ |]--metaDec1 :: Q [Dec]-metaDec1 = [d| foo :: _ => _-               foo x y = x == y |]--metaDec2 :: Q [Dec]-metaDec2 = [d| bar :: _a -> _b -> (_a, _b)-               bar x y = (not x, y) |]---- An expression with a partial type annotation-metaExp1 :: ExpQ-metaExp1 = [| Just True :: Maybe _ |]--metaExp2 :: ExpQ-metaExp2 = [| id :: _a -> _a |]
− tests/examples/ghc80/SplicesUsed.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE PartialTypeSignatures #-}-module SplicesUsed where--import Splices--maybeBool :: $(metaType1)-maybeBool = $(metaExp2) $(metaExp1)--charA :: a -> $(metaType2)-charA x = ('x', x)--filter' :: $(metaType3)-filter' = filter--$(metaDec1)--$(metaDec2)
− tests/examples/ghc80/StackOverflow.hs 
@@ -1,4 +0,0 @@-main :: IO ()-main = main' ()-  where-    main' _ = main >> main' ()
− tests/examples/ghc80/Structure8.hs 
@@ -1,1 +0,0 @@-foo x | otherwise = y
− tests/examples/ghc80/Structure8a.hs 
@@ -1,1 +0,0 @@-foo x = y
− tests/examples/ghc80/T10009.hs 
@@ -1,150 +0,0 @@-{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-module T10009 where---type family F a-type family UnF a--f :: (UnF (F b) ~ b) => F b -> ()-f = error "urk"--g :: forall a. (UnF (F a) ~ a) => a -> ()-g _ = f (undefined :: F a)---{- ----------------[G] UnF (F b) ~ b--[W] UnF (F beta) ~ beta-[W] F a ~ F beta----------------------[G] g1: F a ~ fsk1         fsk1 := F a-[G] g2: UnF fsk1 ~ fsk2    fsk2 := UnF fsk1-[G] g3: fsk2 ~ a--[W] w1: F beta ~ fmv1-[W] w2: UnF fmv1 ~ fmv2-[W] w3: fmv2 ~ beta-[W] w5: fsk1 ~ fmv1   -- From F a ~ F beta-                      -- using flat-cache------ No progress in solving -------- Unflatten:--[W] w3: UnF (F beta) ~ beta-[W] w5: fsk1 ~ F beta----- Improvement--[D] F beta ~ fmv1-[D] UnF fmv1 ~ fmv2    -- (A)-[D] fmv2 ~ beta-[D] fmv1 ~ fsk1        -- (B) From F a ~ F beta-                       -- NB: put fmv on left----> rewrite (A) with (B), and match with g2--[D] F beta ~ fmv1-[D] fmv2 ~ fsk2        -- (C)-[D] fmv2 ~ beta        -- (D)-[D] fmv1 ~ fsk1----> rewrite (D) with (C) and re-orient--[D] F beta ~ fmv1-[D] fmv2 ~ fsk2-[D] beta ~ fsk2       -- (E)-[D] fmv1 ~ fsk1---- Now we can unify beta!--}----{---------Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy--wl: [W] F b_amr ~ F b_amt--work item: [W] UnF (F b_amt) ~ b_amt-  b_amt is the unification variable--===>      b_amt := s_amF--Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy--wl: [W] F b_amr ~ F b_amt-    [W] UnF s_amD ~ s_amF--work item: [W] F b_amt ~ s_amD---===>-wl: [W] F b_amr ~ F b_amt-    [W] UnF s_amD ~ s_amF--Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy-       [W] F s_amF ~ s_amD--===>-wl: [W] F b_amr ~ F b_amt--Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy-       [W] F s_amF ~ s_amD-       [W] UnF s_amD ~ s_amF--===>-Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy-       [W] UnF s_amD ~ s_amF-       [W] F s_amF ~ s_amD--wl:--work-item: [W] F b_amr ~ F b_amt---> fsk_amy ~ s_amD---> s_amD ~ fsk_amy--===>-Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy-       [W] UnF s_amD ~ s_amF-       [W] F s_amF ~ s_amD-       [W] s_amD ~ fsk_amy--wl:--work item: [D] UnF s_amD ~ s_amF----> [D] UnF fsk_amy ~ s_amF---> [D] s_amF ~ fsk_amA--===>-Inert: [G] fsk_amA ~ b_amr-       [G] UnF fsk_amy ~ fsk_amA-       [G} F b_amr ~ fsk_amy-       [W] UnF s_amD ~ s_amF-       [W] F s_amF ~ s_amD-       [W] s_amD ~ fsk_amy-       [D] s_amF ~ fsk_amA--wl:--work item: [D] F s_amF ~ s_amD---> F fsk_amA ~ s_amD---> s_amd ~ b_amr--}
− tests/examples/ghc80/T10030.hs 
@@ -1,7 +0,0 @@-module Main where--import GHC.Generics--main = do-  putStrLn $ packageName $ from $ Just True-  putStrLn $ packageName $ from $ True
− tests/examples/ghc80/T10041.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds #-}-{-# LANGUAGE TypeOperators, GADTs, InstanceSigs #-}--module T10041 where--data family Sing (a :: k)-data instance Sing (xs :: [k]) where-  SNil :: Sing '[]--class SingI (a :: ĸ) where
− tests/examples/ghc80/T10045.hs 
@@ -1,8 +0,0 @@-module T10045 where--newtype Meta = Meta ()--foo (Meta ws1) =-     let copy :: _-         copy w from = copy w True-     in copy ws1 False
− tests/examples/ghc80/T10047.hs 
@@ -1,7 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module T10047 where--import Language.Haskell.TH-import Language.Haskell.TH.Quote--n = QuasiQuoter { quoteExp = dyn }
− tests/examples/ghc80/T10052-input.hs 
@@ -1,1 +0,0 @@-main = let (x :: String) = "hello" in putStrLn x
− tests/examples/ghc80/T10052.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -Wall #-}-module Main where--import System.Environment-import GHC--main :: IO ()-main = do-    flags <- getArgs-    runGhc' flags $ do-      setTargets [Target (TargetFile "T10052-input.hs" Nothing) True Nothing]-      _success <- load LoadAllTargets-      return ()--runGhc' :: [String] -> Ghc a -> IO a-runGhc' args act = do-    let libdir = head args-        flags  = tail args-    (dynFlags, _warns) <- parseStaticFlags (map noLoc flags)-    runGhc (Just libdir) $ do-      dflags0 <- getSessionDynFlags-      (dflags1, _leftover, _warns) <- parseDynamicFlags dflags0 dynFlags-      let dflags2 = dflags1 {-              hscTarget = HscInterpreted-            , ghcLink   = LinkInMemory-            , verbosity = 1-            }-      _newPkgs <- setSessionDynFlags dflags2-      act
− tests/examples/ghc80/T10083.hs 
@@ -1,5 +0,0 @@-module T10083 where-  import T10083a-  data RSR = MkRSR SR-  eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)-  foo x y = not (eqRSR x y)
− tests/examples/ghc80/T10083a.hs 
@@ -1,4 +0,0 @@-module T10083a where-  import {-# SOURCE #-} T10083-  data SR = MkSR RSR-  eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2
− tests/examples/ghc80/T10100.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE UndecidableInstances   #-}--module T10100 where--data Zero-data Succ a--class Add a b ab | a b -> ab, a ab -> b-instance Add Zero b b-instance (Add a b ab) => Add (Succ a) b (Succ ab)
− tests/examples/ghc80/T10104.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE MagicHash #-}-module Main where--import GHC.Prim--data P = Positives Int# Float# Double# Char# Word# deriving Show-data N = Negatives Int# Float# Double# deriving Show--main = do-  print $ Positives 42# 4.23# 4.23## '4'# 4##-  print $ Negatives -4# -4.0# -4.0##
− tests/examples/ghc80/T10109.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FunctionalDependencies,-             UndecidableInstances, FlexibleInstances #-}--module T10109 where--data Succ a--class Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab-instance (Add a b ab) => Add (Succ a) b (Succ ab)-
− tests/examples/ghc80/T10110A.hs 
@@ -1,4 +0,0 @@-module T10110A (a) where-{-# NOINLINE a #-}-a :: Int-a = 3
− tests/examples/ghc80/T10110B.hs 
@@ -1,3 +0,0 @@-module T10110B (b) where-b :: Int-b = 5
− tests/examples/ghc80/T10110C.hs 
@@ -1,5 +0,0 @@-module T10110C (c) where-import T10110A (a)-import T10110B (b)-c :: Int-c = a+b
− tests/examples/ghc80/T10112.hs

file too large to diff

− tests/examples/ghc80/T10134.hs

file too large to diff

− tests/examples/ghc80/T10139.hs

file too large to diff

− tests/examples/ghc80/T10141.hs

file too large to diff

− tests/examples/ghc80/T10148.hs

file too large to diff

− tests/examples/ghc80/T10156.hs

file too large to diff

− tests/examples/ghc80/T10180.hs

file too large to diff

− tests/examples/ghc80/T10181.hs

file too large to diff

− tests/examples/ghc80/T10182.hs

file too large to diff

− tests/examples/ghc80/T10182a.hs

file too large to diff

− tests/examples/ghc80/T10184.hs

file too large to diff

− tests/examples/ghc80/T10185.hs

file too large to diff

− tests/examples/ghc80/T10188.hs

file too large to diff

− tests/examples/ghc80/T10194.hs

file too large to diff

− tests/examples/ghc80/T10195.hs

file too large to diff

− tests/examples/ghc80/T10196.hs

file too large to diff

− tests/examples/ghc80/T10215.hs

file too large to diff

− tests/examples/ghc80/T10218.hs

file too large to diff

− tests/examples/ghc80/T10220B.hs

file too large to diff

− tests/examples/ghc80/T10226.hs

file too large to diff

− tests/examples/ghc80/T10233.hs

file too large to diff

− tests/examples/ghc80/T10233a.hs

file too large to diff

− tests/examples/ghc80/T10245.hs

file too large to diff

− tests/examples/ghc80/T10246.hs

file too large to diff

− tests/examples/ghc80/T10251.hs

file too large to diff

− tests/examples/ghc80/T10263.hs

file too large to diff

− tests/examples/ghc80/T10267.hs

file too large to diff

− tests/examples/ghc80/T10267a.hs

file too large to diff

− tests/examples/ghc80/T10279.hs

file too large to diff

− tests/examples/ghc80/T10283.hs

file too large to diff

− tests/examples/ghc80/T10284.hs

file too large to diff

− tests/examples/ghc80/T10285.hs

file too large to diff

− tests/examples/ghc80/T10285a.hs

file too large to diff

− tests/examples/ghc80/T10294.hs

file too large to diff

− tests/examples/ghc80/T10294a.hs

file too large to diff

− tests/examples/ghc80/T10306.hs

file too large to diff

− tests/examples/ghc80/T10318.hs

file too large to diff

− tests/examples/ghc80/T10322A.hs

file too large to diff

− tests/examples/ghc80/T10322B.hs

file too large to diff

− tests/examples/ghc80/T10322C.hs

file too large to diff

− tests/examples/ghc80/T10335.hs

file too large to diff

− tests/examples/ghc80/T10340.hs

file too large to diff

− tests/examples/ghc80/T10348.hs

file too large to diff

− tests/examples/ghc80/T10351.hs

file too large to diff

− tests/examples/ghc80/T10359.hs

file too large to diff

− tests/examples/ghc80/T10361a.hs

file too large to diff

− tests/examples/ghc80/T10361b.hs

file too large to diff

− tests/examples/ghc80/T10370.hs

file too large to diff

− tests/examples/ghc80/T10384.hs

file too large to diff

− tests/examples/ghc80/T10390.hs

file too large to diff

− tests/examples/ghc80/T10398.hs

file too large to diff

− tests/examples/ghc80/T10403.hs

file too large to diff

− tests/examples/ghc80/T10414.hs

file too large to diff

− tests/examples/ghc80/T10420.hs

file too large to diff

− tests/examples/ghc80/T10420a.hs

file too large to diff

− tests/examples/ghc80/T10423.hs

file too large to diff

− tests/examples/ghc80/T10428.hs

file too large to diff

− tests/examples/ghc80/T10438.hs

file too large to diff

− tests/examples/ghc80/T10447.hs

file too large to diff

− tests/examples/ghc80/T10451.hs

file too large to diff

− tests/examples/ghc80/T10460.hs

file too large to diff

− tests/examples/ghc80/T10461.hs

file too large to diff

− tests/examples/ghc80/T10463.hs

file too large to diff

− tests/examples/ghc80/T10481.hs

file too large to diff

− tests/examples/ghc80/T10482.hs

file too large to diff

− tests/examples/ghc80/T10482a.hs

file too large to diff

− tests/examples/ghc80/T10487.hs

file too large to diff

− tests/examples/ghc80/T10487_M.hs

file too large to diff

− tests/examples/ghc80/T10489.hs

file too large to diff

− tests/examples/ghc80/T10493.hs

file too large to diff

− tests/examples/ghc80/T10494.hs

file too large to diff

− tests/examples/ghc80/T10495.hs

file too large to diff

− tests/examples/ghc80/T10503.hs

file too large to diff

− tests/examples/ghc80/T10507.hs

file too large to diff

− tests/examples/ghc80/T10508_api.hs

file too large to diff

− tests/examples/ghc80/T10516.hs

file too large to diff

− tests/examples/ghc80/T10519.hs

file too large to diff

− tests/examples/ghc80/T10521.hs

file too large to diff

− tests/examples/ghc80/T10521b.hs

file too large to diff

− tests/examples/ghc80/T10524.hs

file too large to diff

− tests/examples/ghc80/T10534.hs

file too large to diff

− tests/examples/ghc80/T10534a.hs

file too large to diff

− tests/examples/ghc80/T10549.hs

file too large to diff

− tests/examples/ghc80/T10549a.hs

file too large to diff

− tests/examples/ghc80/T10561.hs

file too large to diff

− tests/examples/ghc80/T10562.hs

file too large to diff

− tests/examples/ghc80/T10564.hs

file too large to diff

− tests/examples/ghc80/T10570.hs

file too large to diff

− tests/examples/ghc80/T10590.hs

file too large to diff

− tests/examples/ghc80/T10596.hs

file too large to diff

− tests/examples/ghc80/T10602.hs

file too large to diff

− tests/examples/ghc80/T10602b.hs

file too large to diff

− tests/examples/ghc80/T10615.hs

file too large to diff

− tests/examples/ghc80/T10618.hs

file too large to diff

− tests/examples/ghc80/T10620.hs

file too large to diff

− tests/examples/ghc80/T10627.hs

file too large to diff

− tests/examples/ghc80/T10632.hs

file too large to diff

− tests/examples/ghc80/T10634.hs

file too large to diff

− tests/examples/ghc80/T10637.hs

file too large to diff

− tests/examples/ghc80/T10638.hs

file too large to diff

− tests/examples/ghc80/T10642.hs

file too large to diff

− tests/examples/ghc80/T10662.hs

file too large to diff

− tests/examples/ghc80/T10667.hs

file too large to diff

− tests/examples/ghc80/T10668.hs

file too large to diff

− tests/examples/ghc80/T10670.hs

file too large to diff

− tests/examples/ghc80/T10670a.hs

file too large to diff

− tests/examples/ghc80/T10678.hs

file too large to diff

− tests/examples/ghc80/T10689.hs

file too large to diff

− tests/examples/ghc80/T10694.hs

file too large to diff

− tests/examples/ghc80/T10698.hs

file too large to diff

− tests/examples/ghc80/T10704.hs

file too large to diff

− tests/examples/ghc80/T10704a.hs

file too large to diff

− tests/examples/ghc80/T10713.hs

file too large to diff

− tests/examples/ghc80/T10734.hs

file too large to diff

− tests/examples/ghc80/T10742.hs

file too large to diff

− tests/examples/ghc80/T10744.hs

file too large to diff

− tests/examples/ghc80/T10747.hs

file too large to diff

− tests/examples/ghc80/T10753.hs

file too large to diff

− tests/examples/ghc80/T10767.hs

file too large to diff

− tests/examples/ghc80/T10781.hs

file too large to diff

− tests/examples/ghc80/T10796a.hs

file too large to diff

− tests/examples/ghc80/T10796b.hs

file too large to diff

− tests/examples/ghc80/T10806.hs

file too large to diff

− tests/examples/ghc80/T10815.hs

file too large to diff

− tests/examples/ghc80/T10819.hs

file too large to diff

− tests/examples/ghc80/T10819_Lib.hs

file too large to diff

− tests/examples/ghc80/T10820.hs

file too large to diff

− tests/examples/ghc80/T10826.hs

file too large to diff

− tests/examples/ghc80/T10830.hs

file too large to diff

− tests/examples/ghc80/T10836.hs

file too large to diff

− tests/examples/ghc80/T10845.hs

file too large to diff

− tests/examples/ghc80/T10846.hs

file too large to diff

− tests/examples/ghc80/T10870.hs

file too large to diff

− tests/examples/ghc80/T10890.hs

file too large to diff

− tests/examples/ghc80/T10890_1.hs

file too large to diff

− tests/examples/ghc80/T10890_2.hs

file too large to diff

− tests/examples/ghc80/T10890_2A.hs

file too large to diff

− tests/examples/ghc80/T10890_2B.hs

file too large to diff

− tests/examples/ghc80/T10891.hs

file too large to diff

− tests/examples/ghc80/T10895.hs

file too large to diff

− tests/examples/ghc80/T10897a.hs

file too large to diff

− tests/examples/ghc80/T10897b.hs

file too large to diff

− tests/examples/ghc80/T10904.hs

file too large to diff

− tests/examples/ghc80/T10908.hs

file too large to diff

− tests/examples/ghc80/T10929.hs

file too large to diff

− tests/examples/ghc80/T10931.hs

file too large to diff

− tests/examples/ghc80/T10935.hs

file too large to diff

− tests/examples/ghc80/T10942.hs

file too large to diff

− tests/examples/ghc80/T10942_A.hs

file too large to diff

− tests/examples/ghc80/T10945.hs

file too large to diff

− tests/examples/ghc80/T10946.hs

file too large to diff

− tests/examples/ghc80/T10955dyn.hs

file too large to diff

− tests/examples/ghc80/T10962.hs

file too large to diff

− tests/examples/ghc80/T10971a.hs

file too large to diff

− tests/examples/ghc80/T10971b.hs

file too large to diff

− tests/examples/ghc80/T10971c.hs

file too large to diff

− tests/examples/ghc80/T10971d.hs

file too large to diff

− tests/examples/ghc80/T10997.hs

file too large to diff

− tests/examples/ghc80/T10997_1.hs

file too large to diff

− tests/examples/ghc80/T10997_1a.hs

file too large to diff

− tests/examples/ghc80/T10997a.hs

file too large to diff

− tests/examples/ghc80/T10999.hs

file too large to diff

− tests/examples/ghc80/T11010.hs

file too large to diff

− tests/examples/ghc80/T11016.hs

file too large to diff

− tests/examples/ghc80/T11039.hs

file too large to diff

− tests/examples/ghc80/T11053.hs

file too large to diff

− tests/examples/ghc80/T11067.hs

file too large to diff

− tests/examples/ghc80/T11071.hs

file too large to diff

− tests/examples/ghc80/T11071a.hs

file too large to diff

− tests/examples/ghc80/T11076.hs

file too large to diff

− tests/examples/ghc80/T11076A.hs

file too large to diff

− tests/examples/ghc80/T11077.hs

file too large to diff

− tests/examples/ghc80/T11103.hs

file too large to diff

− tests/examples/ghc80/T11112.hs

file too large to diff

− tests/examples/ghc80/T11128.hs

file too large to diff

− tests/examples/ghc80/T11136.hs

file too large to diff

− tests/examples/ghc80/T11148.hs

file too large to diff

− tests/examples/ghc80/T11155.hs

file too large to diff

− tests/examples/ghc80/T11164.hs

file too large to diff

− tests/examples/ghc80/T11164a.hs

file too large to diff

− tests/examples/ghc80/T11164b.hs

file too large to diff

− tests/examples/ghc80/T11167.hs

file too large to diff

− tests/examples/ghc80/T11167_ambig.hs

file too large to diff

− tests/examples/ghc80/T11167_ambiguous_fixity.hs

file too large to diff

− tests/examples/ghc80/T11167_ambiguous_fixity_A.hs

file too large to diff

− tests/examples/ghc80/T11167_ambiguous_fixity_B.hs

file too large to diff

− tests/examples/ghc80/T11173.hs

file too large to diff

− tests/examples/ghc80/T11173a.hs

file too large to diff

− tests/examples/ghc80/T11182.hs

file too large to diff

− tests/examples/ghc80/T11187.hs

file too large to diff

− tests/examples/ghc80/T11192.hs

file too large to diff

− tests/examples/ghc80/T11193.hs

file too large to diff

− tests/examples/ghc80/T11208.hs

file too large to diff

− tests/examples/ghc80/T11216.hs

file too large to diff

− tests/examples/ghc80/T11224.hs

file too large to diff

− tests/examples/ghc80/T11232.hs

file too large to diff

− tests/examples/ghc80/T11237.hs

file too large to diff

− tests/examples/ghc80/T1133Aa.hs

file too large to diff

− tests/examples/ghc80/T1133a.hs

file too large to diff

− tests/examples/ghc80/T11381.hs

file too large to diff

− tests/examples/ghc80/T11959.hs

file too large to diff

− tests/examples/ghc80/T17a.hs

file too large to diff

− tests/examples/ghc80/T17b.hs

file too large to diff

− tests/examples/ghc80/T17c.hs

file too large to diff

− tests/examples/ghc80/T17d.hs

file too large to diff

− tests/examples/ghc80/T17e.hs

file too large to diff

− tests/examples/ghc80/T1830_1.hs

file too large to diff

− tests/examples/ghc80/T1830_2.hs

file too large to diff

− tests/examples/ghc80/T1830_3.hs

file too large to diff

− tests/examples/ghc80/T1830_3a.hs

file too large to diff

− tests/examples/ghc80/T2006.hs

file too large to diff

− tests/examples/ghc80/T2204.hs

file too large to diff

− tests/examples/ghc80/T2632.hs

file too large to diff

− tests/examples/ghc80/T2931.hs

file too large to diff

− tests/examples/ghc80/T2991.hs

file too large to diff

− tests/examples/ghc80/T3078.hs

file too large to diff

− tests/examples/ghc80/T322.hs

file too large to diff

− tests/examples/ghc80/T3468a.hs

file too large to diff

− tests/examples/ghc80/T3572.hs

file too large to diff

− tests/examples/ghc80/T365.hs

file too large to diff

− tests/examples/ghc80/T366.hs

file too large to diff

− tests/examples/ghc80/T3927.hs

file too large to diff

− tests/examples/ghc80/T3927a.hs

file too large to diff

− tests/examples/ghc80/T4056.hs

file too large to diff

− tests/examples/ghc80/T4139.hs

file too large to diff

− tests/examples/ghc80/T4169.hs

file too large to diff

− tests/examples/ghc80/T4170.hs

file too large to diff

− tests/examples/ghc80/T5001b.hs

file too large to diff

− tests/examples/ghc80/T5333.hs

file too large to diff

− tests/examples/ghc80/T5721.hs

file too large to diff

− tests/examples/ghc80/T5821.hs

file too large to diff

− tests/examples/ghc80/T5884Other.hs

file too large to diff

− tests/examples/ghc80/T5908.hs

file too large to diff

− tests/examples/ghc80/T6018.hs

file too large to diff

− tests/examples/ghc80/T6018Afail.hs

file too large to diff

− tests/examples/ghc80/T6018Bfail.hs

file too large to diff

− tests/examples/ghc80/T6018Cfail.hs

file too large to diff

− tests/examples/ghc80/T6018Dfail.hs

file too large to diff

− tests/examples/ghc80/T6018a.hs

file too large to diff

− tests/examples/ghc80/T6018fail.hs

file too large to diff

− tests/examples/ghc80/T6018failclosed.hs

file too large to diff

− tests/examples/ghc80/T6018failclosed2.hs

file too large to diff

− tests/examples/ghc80/T6018rnfail.hs

file too large to diff

− tests/examples/ghc80/T6018th.hs

file too large to diff

− tests/examples/ghc80/T6062.hs

file too large to diff

− tests/examples/ghc80/T6124.hs

file too large to diff

− tests/examples/ghc80/T7411.hs

file too large to diff

− tests/examples/ghc80/T7669a.hs

file too large to diff

− tests/examples/ghc80/T7672.hs

file too large to diff

− tests/examples/ghc80/T7672a.hs

file too large to diff

− tests/examples/ghc80/T7765.hs

file too large to diff

− tests/examples/ghc80/T7788.hs

file too large to diff

− tests/examples/ghc80/T8030.hs

file too large to diff

− tests/examples/ghc80/T8034.hs

file too large to diff

− tests/examples/ghc80/T8101b.hs

file too large to diff

− tests/examples/ghc80/T8131b.hs

file too large to diff

− tests/examples/ghc80/T8274.hs

file too large to diff

− tests/examples/ghc80/T8455.hs

file too large to diff

− tests/examples/ghc80/T8550.hs

file too large to diff

− tests/examples/ghc80/T8555.hs

file too large to diff

− tests/examples/ghc80/T8633.hs

file too large to diff

− tests/examples/ghc80/T8743a.hs

file too large to diff

− tests/examples/ghc80/T8759a.hs

file too large to diff

− tests/examples/ghc80/T8799.hs

file too large to diff

− tests/examples/ghc80/T8970.hs

file too large to diff

− tests/examples/ghc80/T9015.hs

file too large to diff

− tests/examples/ghc80/T9017.hs

file too large to diff

− tests/examples/ghc80/T9177a.hs

file too large to diff

− tests/examples/ghc80/T9204a.hs

file too large to diff

− tests/examples/ghc80/T9204b.hs

file too large to diff

− tests/examples/ghc80/T9204b2.hs

file too large to diff

− tests/examples/ghc80/T9233.hs

file too large to diff

− tests/examples/ghc80/T9233a.hs

file too large to diff

− tests/examples/ghc80/T9238.hs

file too large to diff

− tests/examples/ghc80/T9260.hs

file too large to diff

− tests/examples/ghc80/T9430.hs

file too large to diff

− tests/examples/ghc80/T9554.hs

file too large to diff

− tests/examples/ghc80/T9600-1.hs

file too large to diff

− tests/examples/ghc80/T9600.hs

file too large to diff

− tests/examples/ghc80/T9824.hs

file too large to diff

− tests/examples/ghc80/T9839_02.hs

file too large to diff

− tests/examples/ghc80/T9839_03.hs

file too large to diff

− tests/examples/ghc80/T9839_04.hs

file too large to diff

− tests/examples/ghc80/T9839_05.hs

file too large to diff

− tests/examples/ghc80/T9839_06.hs

file too large to diff

− tests/examples/ghc80/T9840.hs

file too large to diff

− tests/examples/ghc80/T9840a.hs

file too large to diff

− tests/examples/ghc80/T9858a.hs

file too large to diff

− tests/examples/ghc80/T9858b.hs

file too large to diff

− tests/examples/ghc80/T9858c.hs

file too large to diff

− tests/examples/ghc80/T9858d.hs

file too large to diff

− tests/examples/ghc80/T9858e.hs

file too large to diff

− tests/examples/ghc80/T9867.hs

file too large to diff

− tests/examples/ghc80/T9878b.hs

file too large to diff

− tests/examples/ghc80/T9938.hs

file too large to diff

− tests/examples/ghc80/T9938B.hs

file too large to diff

− tests/examples/ghc80/T9939.hs

file too large to diff

− tests/examples/ghc80/T9951.hs

file too large to diff

− tests/examples/ghc80/T9951b.hs

file too large to diff

− tests/examples/ghc80/T9964.hs

file too large to diff

− tests/examples/ghc80/T9968.hs

file too large to diff

− tests/examples/ghc80/T9968a.hs

file too large to diff

− tests/examples/ghc80/T9973.hs

file too large to diff

− tests/examples/ghc80/T9975a.hs

file too large to diff

− tests/examples/ghc80/T9975b.hs

file too large to diff

− tests/examples/ghc80/TH_abstractFamily.hs

file too large to diff

− tests/examples/ghc80/TH_bracket1.hs

file too large to diff

− tests/examples/ghc80/TH_bracket2.hs

file too large to diff

− tests/examples/ghc80/TH_bracket3.hs

file too large to diff

− tests/examples/ghc80/TH_finalizer.hs

file too large to diff

− tests/examples/ghc80/TH_localname.hs

file too large to diff

− tests/examples/ghc80/TH_namePackage.hs

file too large to diff

− tests/examples/ghc80/TH_nameSpace.hs

file too large to diff

− tests/examples/ghc80/TH_ppr1.hs

file too large to diff

− tests/examples/ghc80/TH_reifyType1.hs

file too large to diff

− tests/examples/ghc80/TH_reifyType2.hs

file too large to diff

− tests/examples/ghc80/TH_repE1.hs

file too large to diff

− tests/examples/ghc80/TH_repE3.hs

file too large to diff

− tests/examples/ghc80/TH_scope.hs

file too large to diff

− tests/examples/ghc80/TH_spliceE5_prof_ext.hs

file too large to diff

− tests/examples/ghc80/TH_spliceE5_prof_ext_Lib.hs

file too large to diff

− tests/examples/ghc80/TH_tf2.hs

file too large to diff

− tests/examples/ghc80/TcCustomSolverSuper.hs

file too large to diff

− tests/examples/ghc80/Templates.hs

file too large to diff

− tests/examples/ghc80/Test.hs

file too large to diff

− tests/examples/ghc80/Test10255.hs

file too large to diff

− tests/examples/ghc80/Test10268.hs

file too large to diff

− tests/examples/ghc80/Test10269.hs

file too large to diff

− tests/examples/ghc80/Test10276.hs

file too large to diff

− tests/examples/ghc80/Test10278.hs

file too large to diff

− tests/examples/ghc80/Test10280.hs

file too large to diff

− tests/examples/ghc80/Test10307.hs

file too large to diff

− tests/examples/ghc80/Test10309.hs

file too large to diff

− tests/examples/ghc80/Test10312.hs

file too large to diff

− tests/examples/ghc80/Test10313.hs

file too large to diff

− tests/examples/ghc80/Test10354.hs

file too large to diff

− tests/examples/ghc80/Test10357.hs

file too large to diff

− tests/examples/ghc80/Test10358.hs

file too large to diff

− tests/examples/ghc80/Test10396.hs

file too large to diff

− tests/examples/ghc80/Test11018.hs

file too large to diff

− tests/examples/ghc80/TestBoolFormula.hs

file too large to diff

− tests/examples/ghc80/TestUtils.hs

file too large to diff

− tests/examples/ghc80/Trac10045.hs

file too large to diff

− tests/examples/ghc80/TransAssociated.hs

file too large to diff

− tests/examples/ghc80/TransBundle.hs

file too large to diff

− tests/examples/ghc80/TypeFamilyInstanceLHS.hs

file too large to diff

− tests/examples/ghc80/TypeLevelVec.hs

file too large to diff

− tests/examples/ghc80/TypeSkolEscape.hs

file too large to diff

− tests/examples/ghc80/TypedSplice.hs

file too large to diff

− tests/examples/ghc80/UnicodeRules.hs

file too large to diff

− tests/examples/ghc80/Vta1.hs

file too large to diff

− tests/examples/ghc80/Vta2.hs

file too large to diff

− tests/examples/ghc80/WCompatWarningsNotOn.hs

file too large to diff

− tests/examples/ghc80/WCompatWarningsOff.hs

file too large to diff

− tests/examples/ghc80/WCompatWarningsOn.hs

file too large to diff

− tests/examples/ghc80/WCompatWarningsOnOff.hs

file too large to diff

− tests/examples/ghc80/Zwaluw.hs

file too large to diff

− tests/examples/ghc80/ado001.hs

file too large to diff

− tests/examples/ghc80/ado002.hs

file too large to diff

− tests/examples/ghc80/ado003.hs

file too large to diff

− tests/examples/ghc80/ado004.hs

file too large to diff

− tests/examples/ghc80/ado005.hs

file too large to diff

− tests/examples/ghc80/ado006.hs

file too large to diff

− tests/examples/ghc80/ado007.hs

file too large to diff

− tests/examples/ghc80/boolFormula.hs

file too large to diff

− tests/examples/ghc80/determinism001.hs

file too large to diff

− tests/examples/ghc80/export-class.hs

file too large to diff

− tests/examples/ghc80/export-ps-rec-sel.hs

file too large to diff

− tests/examples/ghc80/export-record-selector.hs

file too large to diff

− tests/examples/ghc80/export-super-class-fail.hs

file too large to diff

− tests/examples/ghc80/export-super-class.hs

file too large to diff

− tests/examples/ghc80/export-syntax.hs

file too large to diff

− tests/examples/ghc80/export-type-synonym.hs

file too large to diff

− tests/examples/ghc80/export-type.hs

file too large to diff

− tests/examples/ghc80/frontend01.hs

file too large to diff

− tests/examples/ghc80/haddockA034.hs

file too large to diff

− tests/examples/ghc80/listcomps.hs

file too large to diff

− tests/examples/ghc80/mixed-pat-syn-record-sels.hs

file too large to diff

− tests/examples/ghc80/multi-export.hs

file too large to diff

− tests/examples/ghc80/overloadedlabelsfail01.hs

file too large to diff

− tests/examples/ghc80/overloadedlabelsrun01.hs

file too large to diff

− tests/examples/ghc80/overloadedlabelsrun02.hs

file too large to diff

− tests/examples/ghc80/overloadedlabelsrun03.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail01.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail02.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail03.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail04.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail05.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail06.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail07.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail08.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail09.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail10.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail11.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail12.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail13.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsfail14.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsrun01.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsrun02.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsrun03.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsrun04.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsrun05.hs

file too large to diff

− tests/examples/ghc80/overloadedrecfldsrun06.hs

file too large to diff

− tests/examples/ghc80/performGC.hs

file too large to diff

− tests/examples/ghc80/plugins07.hs

file too large to diff

− tests/examples/ghc80/pmc001.hs

file too large to diff

− tests/examples/ghc80/pmc002.hs

file too large to diff

− tests/examples/ghc80/pmc003.hs

file too large to diff

− tests/examples/ghc80/pmc004.hs

file too large to diff

− tests/examples/ghc80/pmc005.hs

file too large to diff

− tests/examples/ghc80/pmc006.hs

file too large to diff

− tests/examples/ghc80/pmc007.hs

file too large to diff

− tests/examples/ghc80/poly-export-fail2.hs

file too large to diff

− tests/examples/ghc80/poly-export.hs

file too large to diff

− tests/examples/ghc80/poly-export2.hs

file too large to diff

− tests/examples/ghc80/poly-export3.hs

file too large to diff

− tests/examples/ghc80/records-check-sels.hs

file too large to diff

− tests/examples/ghc80/records-compile.hs

file too large to diff

− tests/examples/ghc80/records-exquant.hs

file too large to diff

− tests/examples/ghc80/records-mixing-fields.hs

file too large to diff

− tests/examples/ghc80/records-no-uni-update.hs

file too large to diff

− tests/examples/ghc80/records-no-uni-update2.hs

file too large to diff

− tests/examples/ghc80/records-poly-update.hs

file too large to diff

− tests/examples/ghc80/records-poly.hs

file too large to diff

− tests/examples/ghc80/records-prov-req.hs

file too large to diff

− tests/examples/ghc80/records-req-only.hs

file too large to diff

− tests/examples/ghc80/records-req.hs

file too large to diff

− tests/examples/ghc80/records-run.hs

file too large to diff

− tests/examples/ghc80/spec-inline-determ.hs

file too large to diff

− tests/examples/ghc80/stringSource.hs

file too large to diff

− tests/examples/ghc80/t10255.hs

file too large to diff

− tests/examples/ghc80/t10268.hs

file too large to diff

− tests/examples/ghc80/t10269.hs

file too large to diff

− tests/examples/ghc80/t10278.hs

file too large to diff

− tests/examples/ghc80/t10280.hs

file too large to diff

− tests/examples/ghc80/t10307.hs

file too large to diff

− tests/examples/ghc80/t10309.hs

file too large to diff

− tests/examples/ghc80/t10312.hs

file too large to diff

− tests/examples/ghc80/t10354.hs

file too large to diff

− tests/examples/ghc80/t10357.hs

file too large to diff

− tests/examples/ghc80/t10358.hs

file too large to diff

− tests/examples/ghc80/t10396.hs

file too large to diff

− tests/examples/ghc80/t10399.hs

file too large to diff

− tests/examples/ghc80/tc265.hs

file too large to diff

− tests/examples/ghc80/tcfail223.hs

file too large to diff

− tests/examples/ghc80/update-existential.hs

file too large to diff

− tests/examples/ghc810/T16326_Compile1.hs

file too large to diff

− tests/examples/ghc810/T17296.hs

file too large to diff

− tests/examples/ghc810/T3391.hs

file too large to diff

− tests/examples/ghc810/TH_scope.hs

file too large to diff

− tests/examples/ghc810/TH_unresolvedInfix.hs

file too large to diff

− tests/examples/ghc810/TH_unresolvedInfix_Lib.hs

file too large to diff

− tests/examples/ghc810/mod181.hs

file too large to diff

− tests/examples/ghc810/saks029.hs

file too large to diff

− tests/examples/ghc810/saks032.hs

file too large to diff

− tests/examples/ghc82/Completesig03A.hs

file too large to diff

− tests/examples/ghc82/Lib.hs

file too large to diff

− tests/examples/ghc82/List2.hs

file too large to diff

− tests/examples/ghc82/Ppr048.hs

file too large to diff

− tests/examples/ghc82/T11727.hs

file too large to diff

− tests/examples/ghc82/T13050.hs

file too large to diff

− tests/examples/ghc82/T13594.hs

file too large to diff

− tests/examples/ghc82/brackets.hs

file too large to diff

− tests/examples/ghc82/completesig01.hs

file too large to diff

− tests/examples/ghc84/Functors.hs

file too large to diff

− tests/examples/ghc84/Main.hs

file too large to diff

− tests/examples/ghc84/T13747.hs

file too large to diff

− tests/examples/ghc84/Types.hs

file too large to diff

− tests/examples/ghc86/Arith.hs

file too large to diff

− tests/examples/ghc86/BadTelescope.hs

file too large to diff

− tests/examples/ghc86/BadTelescope2.hs

file too large to diff

− tests/examples/ghc86/BadTelescope3.hs

file too large to diff

− tests/examples/ghc86/BadTelescope4.hs

file too large to diff

− tests/examples/ghc86/Boot1.hs

file too large to diff

− tests/examples/ghc86/ConDeclEmptyCtx.hs

file too large to diff

− tests/examples/ghc86/Dep3.hs

file too large to diff

− tests/examples/ghc86/GADT.hs

file too large to diff

− tests/examples/ghc86/HashTab.hs

file too large to diff

− tests/examples/ghc86/KindEqualities2.hs

file too large to diff

− tests/examples/ghc86/LiftedConstructors.hs

file too large to diff

− tests/examples/ghc86/Parser.hs

file too large to diff

− tests/examples/ghc86/RAE_T32a.hs

file too large to diff

− tests/examples/ghc86/RAE_T32b.hs

file too large to diff

− tests/examples/ghc86/Rae31.hs

file too large to diff

− tests/examples/ghc86/RaeBlogPost.hs

file too large to diff

− tests/examples/ghc86/RenamingStar.hs

file too large to diff

− tests/examples/ghc86/ST.hs

file too large to diff

− tests/examples/ghc86/SlidingTypeSyn.hs

file too large to diff

− tests/examples/ghc86/T10134a.hs

file too large to diff

− tests/examples/ghc86/T10279.hs

file too large to diff

− tests/examples/ghc86/T10321.hs

file too large to diff

− tests/examples/ghc86/T10638.hs

file too large to diff

− tests/examples/ghc86/T10689a.hs

file too large to diff

− tests/examples/ghc86/T10819.hs

file too large to diff

− tests/examples/ghc86/T10891.hs

file too large to diff

− tests/examples/ghc86/T10934.hs

file too large to diff

− tests/examples/ghc86/T11142.hs

file too large to diff

− tests/examples/ghc86/T11484.hs

file too large to diff

− tests/examples/ghc86/T12478_5.hs

file too large to diff

− tests/examples/ghc86/T14164.hs

file too large to diff

− tests/examples/ghc86/T14650.hs

file too large to diff

− tests/examples/ghc86/T2632.hs

file too large to diff

− tests/examples/ghc86/T3263-2.hs

file too large to diff

− tests/examples/ghc86/T3391.hs

file too large to diff

− tests/examples/ghc86/T3572.hs

file too large to diff

− tests/examples/ghc86/T3927b.hs

file too large to diff

− tests/examples/ghc86/T4056.hs

file too large to diff

− tests/examples/ghc86/T4169.hs

file too large to diff

− tests/examples/ghc86/T4170.hs

file too large to diff

− tests/examples/ghc86/T5217.hs

file too large to diff

− tests/examples/ghc86/T6018th.hs

file too large to diff

− tests/examples/ghc86/T6062.hs

file too large to diff

− tests/examples/ghc86/T8455.hs

file too large to diff

− tests/examples/ghc86/T8759a.hs

file too large to diff

− tests/examples/ghc86/T8807.hs

file too large to diff

− tests/examples/ghc86/T9367.hs

file too large to diff

− tests/examples/ghc86/T9632.hs

file too large to diff

− tests/examples/ghc86/T9662.hs

file too large to diff

− tests/examples/ghc86/T9824.hs

file too large to diff

− tests/examples/ghc86/TH_abstractFamily.hs

file too large to diff

− tests/examples/ghc86/TH_bracket1.hs

file too large to diff

− tests/examples/ghc86/TH_bracket2.hs

file too large to diff

− tests/examples/ghc86/TH_bracket3.hs

file too large to diff

− tests/examples/ghc86/TH_class1.hs

file too large to diff

− tests/examples/ghc86/TH_dataD1.hs

file too large to diff

− tests/examples/ghc86/TH_localname.hs

file too large to diff

− tests/examples/ghc86/TH_lookupName.hs

file too large to diff

− tests/examples/ghc86/TH_ppr1.hs

file too large to diff

− tests/examples/ghc86/TH_raiseErr1.hs

file too large to diff

− tests/examples/ghc86/TH_recover.hs

file too large to diff

− tests/examples/ghc86/TH_reifyDecl1.hs

file too large to diff

− tests/examples/ghc86/TH_reifyDecl2.hs

file too large to diff

− tests/examples/ghc86/TH_reifyInstances.hs

file too large to diff

− tests/examples/ghc86/TH_reifyMkName.hs

file too large to diff

− tests/examples/ghc86/TH_repE1.hs

file too large to diff

− tests/examples/ghc86/TH_repE2.hs

file too large to diff

− tests/examples/ghc86/TH_repE3.hs

file too large to diff

− tests/examples/ghc86/TH_repGuard.hs

file too large to diff

− tests/examples/ghc86/TH_repGuardOutput.hs

file too large to diff

− tests/examples/ghc86/TH_repPatSig.hs

file too large to diff

− tests/examples/ghc86/TH_repPatSigTVar.hs

file too large to diff

− tests/examples/ghc86/TH_repPrim.hs

file too large to diff

− tests/examples/ghc86/TH_repPrim2.hs

file too large to diff

− tests/examples/ghc86/TH_repPrimOutput.hs

file too large to diff

− tests/examples/ghc86/TH_repPrimOutput2.hs

file too large to diff

− tests/examples/ghc86/TH_scope.hs

file too large to diff

− tests/examples/ghc86/TH_sections.hs

file too large to diff

− tests/examples/ghc86/TH_spliceD2.hs

file too large to diff

− tests/examples/ghc86/TH_spliceDecl1.hs

file too large to diff

− tests/examples/ghc86/TH_spliceDecl2.hs

file too large to diff

− tests/examples/ghc86/TH_spliceDecl3.hs

file too large to diff

− tests/examples/ghc86/TH_spliceE1.hs

file too large to diff

− tests/examples/ghc86/TH_spliceE3.hs

file too large to diff

− tests/examples/ghc86/TH_spliceE4.hs

file too large to diff

− tests/examples/ghc86/TH_spliceE5_Lib.hs

file too large to diff

− tests/examples/ghc86/TH_spliceE5_prof_Lib.hs

file too large to diff

− tests/examples/ghc86/TH_spliceE5_prof_ext_Lib.hs

file too large to diff

− tests/examples/ghc86/TH_spliceExpr1.hs

file too large to diff

− tests/examples/ghc86/TH_tf1.hs

file too large to diff

− tests/examples/ghc86/TH_tf3.hs

file too large to diff

− tests/examples/ghc86/TH_unresolvedInfix.hs

file too large to diff

− tests/examples/ghc86/TH_unresolvedInfix2.hs

file too large to diff

− tests/examples/ghc86/TensorTests.hs

file too large to diff

− tests/examples/ghc86/Test.hs

file too large to diff

− tests/examples/ghc86/Test12417.hs

file too large to diff

− tests/examples/ghc86/TupleN.hs

file too large to diff

− tests/examples/ghc86/UnicodeSyntax.hs

file too large to diff

− tests/examples/ghc86/Webhook.hs

file too large to diff

− tests/examples/ghc86/deriving-via-compile.hs

file too large to diff

− tests/examples/ghc86/determ004.hs

file too large to diff

− tests/examples/ghc86/dynamic-paper.hs

file too large to diff

− tests/examples/ghc86/dynbrk005.hs

file too large to diff

− tests/examples/ghc86/empty-foralls.hs

file too large to diff

− tests/examples/ghc86/ffi1.hs

file too large to diff

− tests/examples/ghc86/ghci006.hs

file too large to diff

− tests/examples/ghc86/haddockA026.hs

file too large to diff

− tests/examples/ghc86/haddockA027.hs

file too large to diff

− tests/examples/ghc86/haddockA031.hs

file too large to diff

− tests/examples/ghc86/haddockC026.hs

file too large to diff

− tests/examples/ghc86/haddockC027.hs

file too large to diff

− tests/examples/ghc86/haddockC031.hs

file too large to diff

− tests/examples/ghc86/mdo.hs

file too large to diff

− tests/examples/ghc86/mkGADTVars.hs

file too large to diff

− tests/examples/ghc86/overloadedrecflds_generics.hs

file too large to diff

− tests/examples/ghc88/ClassParens.hs

file too large to diff

− tests/examples/ghc88/DumpParsedAst.hs

file too large to diff

− tests/examples/ghc88/EmptyCase008.hs

file too large to diff

− tests/examples/ghc88/Exp.hs

file too large to diff

− tests/examples/ghc88/ExplicitForAllRules1.hs

file too large to diff

− tests/examples/ghc88/Internal.hs

file too large to diff

− tests/examples/ghc88/Issue91.hs

file too large to diff

− tests/examples/ghc88/StarBinder.hs

file too large to diff

− tests/examples/ghc88/T12045TH1.hs

file too large to diff

− tests/examples/ghc88/T12045TH2.hs

file too large to diff

− tests/examples/ghc88/T12045a.hs

file too large to diff

− tests/examples/ghc88/T13087.hs

file too large to diff

− tests/examples/ghc88/T15365.hs

file too large to diff

− tests/examples/ghc88/T4437.hs

file too large to diff

− tests/examples/ghc88/TH_recover_warns.hs

file too large to diff

− tests/examples/ghc88/TH_recursiveDoImport.hs

file too large to diff

− tests/examples/ghc88/TH_reifyDecl1.hs

file too large to diff

− tests/examples/ghc88/Utils.hs

file too large to diff

− tests/examples/ghc88/empty-foralls2.hs

file too large to diff

− tests/examples/ghc88/hie010.hs

file too large to diff

− tests/examples/ghc90/Arity2.hs

file too large to diff

− tests/examples/ghc90/ArrowLambdaCase.hs

file too large to diff

− tests/examples/ghc90/BaseDescriptor.hs

file too large to diff

− tests/examples/ghc90/BaseDescriptor2.hs

file too large to diff

− tests/examples/ghc90/Branches.hs

file too large to diff

− tests/examples/ghc90/CSETest.hs

file too large to diff

− tests/examples/ghc90/Dollar2.hs

file too large to diff

− tests/examples/ghc90/DollarDefault.hs

file too large to diff

− tests/examples/ghc90/DollarTest.hs

file too large to diff

− tests/examples/ghc90/ExplicitSpecificity4.hs

file too large to diff

− tests/examples/ghc90/ExplicitSpecificityA1.hs

file too large to diff

− tests/examples/ghc90/FromManual.hs

file too large to diff

− tests/examples/ghc90/Linear.hs

file too large to diff

− tests/examples/ghc90/Linear10.hs

file too large to diff

− tests/examples/ghc90/Linear12.hs

file too large to diff

− tests/examples/ghc90/Linear14.hs

file too large to diff

− tests/examples/ghc90/Linear15.hs

file too large to diff

− tests/examples/ghc90/Linear16.hs

file too large to diff

− tests/examples/ghc90/Linear1Rule.hs

file too large to diff

− tests/examples/ghc90/Linear3.hs

file too large to diff

− tests/examples/ghc90/Linear4.hs

file too large to diff

− tests/examples/ghc90/Linear6.hs

file too large to diff

− tests/examples/ghc90/Linear8.hs

file too large to diff

− tests/examples/ghc90/LinearConstructors.hs

file too large to diff

− tests/examples/ghc90/LinearEmptyCase.hs

file too large to diff

− tests/examples/ghc90/LinearGuards.hs

file too large to diff

− tests/examples/ghc90/LinearTH1.hs

file too large to diff

− tests/examples/ghc90/LinearTH2.hs

file too large to diff

− tests/examples/ghc90/LinearTypeable.hs

file too large to diff

− tests/examples/ghc90/Memoize.hs

file too large to diff

− tests/examples/ghc90/MultConstructor.hs

file too large to diff

− tests/examples/ghc90/OldList.hs

file too large to diff

− tests/examples/ghc90/Op.hs

file too large to diff

− tests/examples/ghc90/ParserArrowLambdaCase.hs

file too large to diff

− tests/examples/ghc90/Pr110.hs

file too large to diff

− tests/examples/ghc90/T18023.hs

file too large to diff

− tests/examples/ghc90/T18432.hs

file too large to diff

− tests/examples/ghc90/T18522-dbg-ppr.hs

file too large to diff

− tests/examples/ghc90/TH_reifyLinear.hs

file too large to diff

− tests/examples/ghc90/TupSection.hs

file too large to diff

− tests/examples/ghc90/anf.hs

file too large to diff

− tests/examples/ghc90/qdocompile001.hs

file too large to diff

− tests/examples/ghc90/qdocompile002.hs

file too large to diff

− tests/examples/ghc90/qdorun001.hs

file too large to diff

− tests/examples/ghc90/qdorun002.hs

file too large to diff

− tests/examples/ghc90/qdorun003.hs

file too large to diff

− tests/examples/ghc90/qdorun004.hs

file too large to diff

− tests/examples/ghc90/qdorun005.hs

file too large to diff

− tests/examples/ghc90/qdorun006.hs

file too large to diff

− tests/examples/ghc90/qdorun007.hs

file too large to diff

+ tests/examples/ghc910/AnnotationNoListTuplePuns.hs view

file too large to diff

+ tests/examples/ghc910/ByHand.hs view

file too large to diff

+ tests/examples/ghc910/Cfipu.hs view

file too large to diff

+ tests/examples/ghc910/Class.hs view

file too large to diff

+ tests/examples/ghc910/ConstructorArgs.hs view

file too large to diff

+ tests/examples/ghc910/Disambiguate.hs view

file too large to diff

+ tests/examples/ghc910/Domino.hs view

file too large to diff

+ tests/examples/ghc910/ErrorSpec.hs view

file too large to diff

+ tests/examples/ghc910/Expression.hs view

file too large to diff

+ tests/examples/ghc910/Generate.hs view

file too large to diff

+ tests/examples/ghc910/GenerateBug.hs view

file too large to diff

+ tests/examples/ghc910/Generic.hs view

file too large to diff

+ tests/examples/ghc910/Lexing.hs view

file too large to diff

+ tests/examples/ghc910/LinearLet.hs view

file too large to diff

+ tests/examples/ghc910/Manager.hs view

file too large to diff

+ tests/examples/ghc910/MonoBacktrackPrio.hs view

file too large to diff

+ tests/examples/ghc910/Normalform.hs view

file too large to diff

+ tests/examples/ghc910/P_IO_data.hs view

file too large to diff

+ tests/examples/ghc910/PostProcess.hs view

file too large to diff

+ tests/examples/ghc910/PrettyPrinter.hs view

file too large to diff

+ tests/examples/ghc910/ProjectionLike.hs view

file too large to diff

+ tests/examples/ghc910/ScriptSyntax.hs view

file too large to diff

+ tests/examples/ghc910/Sum.hs view

file too large to diff

+ tests/examples/ghc910/T14032a.hs view

file too large to diff

+ tests/examples/ghc910/T17594a.hs view

file too large to diff

+ tests/examples/ghc910/T23927.hs view

file too large to diff

+ tests/examples/ghc910/T8761.hs view

file too large to diff

+ tests/examples/ghc910/Test138.hs view

file too large to diff

+ tests/examples/ghc910/type-operators1-four-out.hs view

file too large to diff

− tests/examples/ghc92/AdhocRule.hs

file too large to diff

− tests/examples/ghc92/Async.hs

file too large to diff

− tests/examples/ghc92/BalanceComments1.hs

file too large to diff

− tests/examples/ghc92/Binary.hs

file too large to diff

− tests/examples/ghc92/BlockComment.hs

file too large to diff

− tests/examples/ghc92/Character.hs

file too large to diff

− tests/examples/ghc92/Checkpoint.hs

file too large to diff

− tests/examples/ghc92/CommentOrder.hs

file too large to diff

− tests/examples/ghc92/CommentPlacement.hs

file too large to diff

− tests/examples/ghc92/CommentPlacement2.hs

file too large to diff

− tests/examples/ghc92/CommentPlacement3.hs

file too large to diff

− tests/examples/ghc92/CommentPlacement4.hs

file too large to diff

− tests/examples/ghc92/CommentPlacement5.hs

file too large to diff

− tests/examples/ghc92/CommentPlacement6.hs

file too large to diff

− tests/examples/ghc92/CommonUI.hs

file too large to diff

− tests/examples/ghc92/ConPat.hs

file too large to diff

− tests/examples/ghc92/ConstructorComment.hs

file too large to diff

− tests/examples/ghc92/DataDecl.hs

file too large to diff

− tests/examples/ghc92/DependentStmt.hs

file too large to diff

− tests/examples/ghc92/ExperimIOP.hs

file too large to diff

− tests/examples/ghc92/FOL.hs

file too large to diff

− tests/examples/ghc92/Field.hs

file too large to diff

− tests/examples/ghc92/Group.hs

file too large to diff

− tests/examples/ghc92/Import.hs

file too large to diff

− tests/examples/ghc92/IndentedComments.hs

file too large to diff

− tests/examples/ghc92/LinePragmas.hs

file too large to diff

− tests/examples/ghc92/LinearArrow.hs

file too large to diff

− tests/examples/ghc92/ListComments.hs

file too large to diff

− tests/examples/ghc92/MatchSemis.hs

file too large to diff

− tests/examples/ghc92/Observer.hs

file too large to diff

− tests/examples/ghc92/Observer1.hs

file too large to diff

− tests/examples/ghc92/ParensGADT.hs

file too large to diff

− tests/examples/ghc92/Parse.hs

file too large to diff

− tests/examples/ghc92/PostgreSQL.hs

file too large to diff

− tests/examples/ghc92/PragmaSpans.hs

file too large to diff

− tests/examples/ghc92/RList.hs

file too large to diff

− tests/examples/ghc92/Records.hs

file too large to diff

− tests/examples/ghc92/Records2.hs

file too large to diff

− tests/examples/ghc92/Retrie.hs

file too large to diff

− tests/examples/ghc92/RmDecl4.hs

file too large to diff

− tests/examples/ghc92/ScopesBug.hs

file too large to diff

− tests/examples/ghc92/StringRef.hs

file too large to diff

− tests/examples/ghc92/T17544_kw.hs

file too large to diff

− tests/examples/ghc92/TH.hs

file too large to diff

− tests/examples/ghc92/TH2.hs

file too large to diff

− tests/examples/ghc92/TH_reifyDecl1a.hs

file too large to diff

− tests/examples/ghc92/TopLevelSemis.hs

file too large to diff

− tests/examples/ghc92/TopLevelSemis1.hs

file too large to diff

− tests/examples/ghc92/TopLevelSemis2.hs

file too large to diff

− tests/examples/ghc92/TopLevelSemis3.hs

file too large to diff

− tests/examples/ghc92/TypeFamilies.hs

file too large to diff

− tests/examples/ghc92/n-plus-k-patterns.hs

file too large to diff

− tests/examples/ghc92/proc-do-complex-four-out.hs

file too large to diff

− tests/examples/ghc92/proc-do-complex-out.hs

file too large to diff

− tests/examples/ghc92/proc-do-complex.hs

file too large to diff

− tests/examples/ghc92/proc-lets-out.hs

file too large to diff

− tests/examples/ghc92/proc-lets.hs

file too large to diff

− tests/examples/ghc94/Haddock.hs

file too large to diff

− tests/examples/ghc94/Haddock1.hs

file too large to diff

− tests/examples/ghc94/Haddock2.hs

file too large to diff

− tests/examples/ghc94/HsDocTy.hs

file too large to diff

− tests/examples/ghc94/record-dot-four-out.hs

file too large to diff

− tests/examples/ghc96/ContinuationIO.hs

file too large to diff

− tests/examples/ghc96/Lib.hs

file too large to diff

− tests/examples/ghc96/Main.hs

file too large to diff

− tests/examples/ghc96/T11671_run.hs

file too large to diff

− tests/examples/ghc96/T22315b.hs

file too large to diff

− tests/examples/ghc96/T22332a.hs

file too large to diff

− tests/examples/ghc96/T22500.hs

file too large to diff

− tests/examples/ghc96/TDDataConstructor.hs

file too large to diff

− tests/examples/ghc96/TDExistential.hs

file too large to diff

− tests/examples/ghc96/TDGADT.hs

file too large to diff

− tests/examples/ghc96/TDGoodConsConstraints.hs

file too large to diff

− tests/examples/ghc96/TDVector.hs

file too large to diff

− tests/examples/ghc96/TD_TH_splice.hs

file too large to diff

− tests/examples/ghc98/ExportWarnings_aux.hs

file too large to diff

− tests/examples/ghc98/IndentedModule2.hs

file too large to diff

− tests/examples/ghc98/LexerM2.hs

file too large to diff

− tests/examples/ghc98/ModuleComments.hs

file too large to diff

− tests/examples/ghc98/MonoidsFD.hs

file too large to diff

− tests/examples/ghc98/T13343.hs

file too large to diff

− tests/examples/ghc98/T23465.hs

file too large to diff

− tests/examples/ghc98/Token.hs

file too large to diff

− tests/examples/pre-ghc810/arrowfail003.hs

file too large to diff

− tests/examples/pre-ghc86/BadTelescope.hs

file too large to diff

− tests/examples/pre-ghc86/BadTelescope2.hs

file too large to diff

− tests/examples/pre-ghc86/BadTelescope3.hs

file too large to diff

− tests/examples/pre-ghc86/BadTelescope4.hs

file too large to diff

− tests/examples/pre-ghc86/Dep3.hs

file too large to diff

− tests/examples/pre-ghc86/KindEqualities2.hs

file too large to diff

− tests/examples/pre-ghc86/LiftedConstructors.hs

file too large to diff

− tests/examples/pre-ghc86/RAE_T32a.hs

file too large to diff

− tests/examples/pre-ghc86/RAE_T32b.hs

file too large to diff

− tests/examples/pre-ghc86/Rae31.hs

file too large to diff

− tests/examples/pre-ghc86/RaeBlogPost.hs

file too large to diff

− tests/examples/pre-ghc86/RenamingStar.hs

file too large to diff

− tests/examples/pre-ghc86/SlidingTypeSyn.hs

file too large to diff

− tests/examples/pre-ghc86/T10134a.hs

file too large to diff

− tests/examples/pre-ghc86/T10321.hs

file too large to diff

− tests/examples/pre-ghc86/T10689a.hs

file too large to diff

− tests/examples/pre-ghc86/T10934.hs

file too large to diff

− tests/examples/pre-ghc86/T11142.hs

file too large to diff

− tests/examples/pre-ghc86/T3927b.hs

file too large to diff

− tests/examples/pre-ghc86/T9632.hs

file too large to diff

− tests/examples/pre-ghc86/TensorTests.hs

file too large to diff

− tests/examples/pre-ghc86/UnicodeSyntax.hs

file too large to diff

− tests/examples/pre-ghc86/Vect.hs

file too large to diff

− tests/examples/pre-ghc86/Webhook.hs

file too large to diff

− tests/examples/pre-ghc86/determ004.hs

file too large to diff

− tests/examples/pre-ghc86/dynamic-paper.hs

file too large to diff

− tests/examples/pre-ghc86/mkGADTVars.hs

file too large to diff

− tests/examples/pre-ghc86/overloadedrecflds_generics.hs

file too large to diff

− tests/examples/pre-ghc90/GADTContext.hs

file too large to diff

− tests/examples/pre-ghc90/Test10399.hs

file too large to diff

+ tests/examples/pre-ghc910/A.32.hs view

file too large to diff

+ tests/examples/pre-ghc910/A.hs view

file too large to diff

+ tests/examples/pre-ghc910/AddAndOr3.hs view

file too large to diff

+ tests/examples/pre-ghc910/AddParams2.hs view

file too large to diff

+ tests/examples/pre-ghc910/AdhocRule.hs view

file too large to diff

+ tests/examples/pre-ghc910/AltsSemis.hs view

file too large to diff

+ tests/examples/pre-ghc910/Ann01.hs view

file too large to diff

+ tests/examples/pre-ghc910/AnnPackageName.hs view

file too large to diff

+ tests/examples/pre-ghc910/Annotations.hs view

file too large to diff

+ tests/examples/pre-ghc910/Arith.hs view

file too large to diff

+ tests/examples/pre-ghc910/Arity2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Arrow.hs view

file too large to diff

+ tests/examples/pre-ghc910/ArrowLambdaCase.hs view

file too large to diff

+ tests/examples/pre-ghc910/Arrows.hs view

file too large to diff

+ tests/examples/pre-ghc910/Associated.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Associated.hs view

file too large to diff

+ tests/examples/pre-ghc910/Associated1.hs view

file too large to diff

+ tests/examples/pre-ghc910/AssociatedInternal.hs view

file too large to diff

+ tests/examples/pre-ghc910/AssociatedType.hs view

file too large to diff

+ tests/examples/pre-ghc910/Async.hs view

file too large to diff

+ tests/examples/pre-ghc910/B.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/B.hs view

file too large to diff

+ tests/examples/pre-ghc910/BCase.hs view

file too large to diff

+ tests/examples/pre-ghc910/BIf.hs view

file too large to diff

+ tests/examples/pre-ghc910/Backquote.hs view

file too large to diff

+ tests/examples/pre-ghc910/BadTelescope.hs view

file too large to diff

+ tests/examples/pre-ghc910/BadTelescope2.hs view

file too large to diff

+ tests/examples/pre-ghc910/BadTelescope3.hs view

file too large to diff

+ tests/examples/pre-ghc910/BadTelescope4.hs view

file too large to diff

+ tests/examples/pre-ghc910/BalanceComments1.hs view

file too large to diff

+ tests/examples/pre-ghc910/BangPatterns.hs view

file too large to diff

+ tests/examples/pre-ghc910/Base.hs view

file too large to diff

+ tests/examples/pre-ghc910/BaseDescriptor.hs view

file too large to diff

+ tests/examples/pre-ghc910/BaseDescriptor2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Binary.hs view

file too large to diff

+ tests/examples/pre-ghc910/BlockComment.hs view

file too large to diff

+ tests/examples/pre-ghc910/Boot1.hs view

file too large to diff

+ tests/examples/pre-ghc910/BootImport.hs view

file too large to diff

+ tests/examples/pre-ghc910/BootImport.hs-boot view

file too large to diff

+ tests/examples/pre-ghc910/BracesSemiDataDecl.hs view

file too large to diff

+ tests/examples/pre-ghc910/Branches.hs view

file too large to diff

+ tests/examples/pre-ghc910/Bundle.hs view

file too large to diff

+ tests/examples/pre-ghc910/Bundle1.hs view

file too large to diff

+ tests/examples/pre-ghc910/BundleExport.hs view

file too large to diff

+ tests/examples/pre-ghc910/BundleInternal.hs view

file too large to diff

+ tests/examples/pre-ghc910/BundleInternal1.hs view

file too large to diff

+ tests/examples/pre-ghc910/C.hs view

file too large to diff

+ tests/examples/pre-ghc910/CExpected.hs view

file too large to diff

+ tests/examples/pre-ghc910/CExpected1.hs view

file too large to diff

+ tests/examples/pre-ghc910/CSETest.hs view

file too large to diff

+ tests/examples/pre-ghc910/Case.hs view

file too large to diff

+ tests/examples/pre-ghc910/Cg008.hs view

file too large to diff

+ tests/examples/pre-ghc910/Character.hs view

file too large to diff

+ tests/examples/pre-ghc910/CheckUtils.hs view

file too large to diff

+ tests/examples/pre-ghc910/Checkpoint.hs view

file too large to diff

+ tests/examples/pre-ghc910/Class.hs view

file too large to diff

+ tests/examples/pre-ghc910/ClassParens.hs view

file too large to diff

+ tests/examples/pre-ghc910/ClosedFam1a.hs view

file too large to diff

+ tests/examples/pre-ghc910/ClosedFam2a.hs view

file too large to diff

+ tests/examples/pre-ghc910/ClosedFam3a.hs view

file too large to diff

+ tests/examples/pre-ghc910/CmmSwitchTest.hs view

file too large to diff

+ tests/examples/pre-ghc910/CmmSwitchTestGen.hs view

file too large to diff

+ tests/examples/pre-ghc910/Collapse1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Commands.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentOrder.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentPlacement.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentPlacement2.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentPlacement3.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentPlacement4.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentPlacement5.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommentPlacement6.hs view

file too large to diff

+ tests/examples/pre-ghc910/CommonUI.hs view

file too large to diff

+ tests/examples/pre-ghc910/Compare.hs view

file too large to diff

+ tests/examples/pre-ghc910/Completesig03A.hs view

file too large to diff

+ tests/examples/pre-ghc910/ConDeclEmptyCtx.hs view

file too large to diff

+ tests/examples/pre-ghc910/ConPat.hs view

file too large to diff

+ tests/examples/pre-ghc910/ConstructorComment.hs view

file too large to diff

+ tests/examples/pre-ghc910/ContinuationIO.hs view

file too large to diff

+ tests/examples/pre-ghc910/Control.hs view

file too large to diff

+ tests/examples/pre-ghc910/CoreIr.hs view

file too large to diff

+ tests/examples/pre-ghc910/CorePragma.hs view

file too large to diff

+ tests/examples/pre-ghc910/Cpp.hs view

file too large to diff

+ tests/examples/pre-ghc910/CustomTypeErrors01.hs view

file too large to diff

+ tests/examples/pre-ghc910/CustomTypeErrors02.hs view

file too large to diff

+ tests/examples/pre-ghc910/CustomTypeErrors03.hs view

file too large to diff

+ tests/examples/pre-ghc910/D.hs view

file too large to diff

+ tests/examples/pre-ghc910/DataDecl.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/DataDecl.hs view

file too large to diff

+ tests/examples/pre-ghc910/DataFamilies.hs view

file too large to diff

+ tests/examples/pre-ghc910/DataFamilyInstanceLHS.hs view

file too large to diff

+ tests/examples/pre-ghc910/DatatypeContexts.hs view

file too large to diff

+ tests/examples/pre-ghc910/Dead1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Decision.hs view

file too large to diff

+ tests/examples/pre-ghc910/Default.hs view

file too large to diff

+ tests/examples/pre-ghc910/DefaultTypeInstance.hs view

file too large to diff

+ tests/examples/pre-ghc910/Defer03.hs view

file too large to diff

+ tests/examples/pre-ghc910/Dep1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Dep2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Dep3.hs view

file too large to diff

+ tests/examples/pre-ghc910/DepFail1.hs view

file too large to diff

+ tests/examples/pre-ghc910/DependentStmt.hs view

file too large to diff

+ tests/examples/pre-ghc910/DeprM.hs view

file too large to diff

+ tests/examples/pre-ghc910/DeprU.hs view

file too large to diff

+ tests/examples/pre-ghc910/Deprecation.hs view

file too large to diff

+ tests/examples/pre-ghc910/Deriving.hs view

file too large to diff

+ tests/examples/pre-ghc910/DerivingOC.hs view

file too large to diff

+ tests/examples/pre-ghc910/DoParens.hs view

file too large to diff

+ tests/examples/pre-ghc910/DoPatBind.hs view

file too large to diff

+ tests/examples/pre-ghc910/DocDecls.hs view

file too large to diff

+ tests/examples/pre-ghc910/Dollar2.hs view

file too large to diff

+ tests/examples/pre-ghc910/DollarDefault.hs view

file too large to diff

+ tests/examples/pre-ghc910/DollarTest.hs view

file too large to diff

+ tests/examples/pre-ghc910/DoubleForall.hs view

file too large to diff

+ tests/examples/pre-ghc910/DroppedComma.hs view

file too large to diff

+ tests/examples/pre-ghc910/DroppedDoSpace.hs view

file too large to diff

+ tests/examples/pre-ghc910/DroppedDoSpace2.hs view

file too large to diff

+ tests/examples/pre-ghc910/DsStrict.hs view

file too large to diff

+ tests/examples/pre-ghc910/DsStrictData.hs view

file too large to diff

+ tests/examples/pre-ghc910/DsStrictFail.hs view

file too large to diff

+ tests/examples/pre-ghc910/DsStrictLet.hs view

file too large to diff

+ tests/examples/pre-ghc910/DsStrictWarn.hs view

file too large to diff

+ tests/examples/pre-ghc910/DumpParsedAst.hs view

file too large to diff

+ tests/examples/pre-ghc910/EmptyCase008.hs view

file too large to diff

+ tests/examples/pre-ghc910/EmptyMostly.hs view

file too large to diff

+ tests/examples/pre-ghc910/EmptyMostly2.hs view

file too large to diff

+ tests/examples/pre-ghc910/EmptyMostlyInst.hs view

file too large to diff

+ tests/examples/pre-ghc910/EmptyMostlyNoSemis.hs view

file too large to diff

+ tests/examples/pre-ghc910/EmptyMostlyTrailing.hs view

file too large to diff

+ tests/examples/pre-ghc910/Eq.hs view

file too large to diff

+ tests/examples/pre-ghc910/Existential.hs view

file too large to diff

+ tests/examples/pre-ghc910/Exp.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExpandSynsFail1.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExpandSynsFail2.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExpandSynsFail3.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExpandSynsFail4.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExperimIOP.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExplicitForAllRules1.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExplicitNamespaces.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExplicitSpecificity4.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExplicitSpecificityA1.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExportSyntax.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExportSyntaxImport.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExportWarnings_aux.hs view

file too large to diff

+ tests/examples/pre-ghc910/Expr.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExprPragmas.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExprSigLocal.hs view

file too large to diff

+ tests/examples/pre-ghc910/Extends.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraints1.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardInExpressionSignature.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardInPatternSignature.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardInPatternSplice.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardInTypeSplice.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardInTypeSplice2.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardInTypeSpliceUsed.hs view

file too large to diff

+ tests/examples/pre-ghc910/ExtraConstraintsWildcardTwice.hs view

file too large to diff

+ tests/examples/pre-ghc910/F.hs view

file too large to diff

+ tests/examples/pre-ghc910/FDsFromGivens2.hs view

file too large to diff

+ tests/examples/pre-ghc910/FOL.hs view

file too large to diff

+ tests/examples/pre-ghc910/Families.hs view

file too large to diff

+ tests/examples/pre-ghc910/Field.hs view

file too large to diff

+ tests/examples/pre-ghc910/Field1.hs view

file too large to diff

+ tests/examples/pre-ghc910/FooBar.hs view

file too large to diff

+ tests/examples/pre-ghc910/FooExpected.hs view

file too large to diff

+ tests/examples/pre-ghc910/ForAll.hs view

file too large to diff

+ tests/examples/pre-ghc910/ForFree.hs view

file too large to diff

+ tests/examples/pre-ghc910/ForeignDecl.hs view

file too large to diff

+ tests/examples/pre-ghc910/ForeignDecl1.hs view

file too large to diff

+ tests/examples/pre-ghc910/FromGrin2.hs view

file too large to diff

+ tests/examples/pre-ghc910/FromManual.hs view

file too large to diff

+ tests/examples/pre-ghc910/FromUtils.hs view

file too large to diff

+ tests/examples/pre-ghc910/FrontendPlugin.hs view

file too large to diff

+ tests/examples/pre-ghc910/FunDeps.hs view

file too large to diff

+ tests/examples/pre-ghc910/FunctionalDeps.hs view

file too large to diff

+ tests/examples/pre-ghc910/Functors.hs view

file too large to diff

+ tests/examples/pre-ghc910/GA1r.hs view

file too large to diff

+ tests/examples/pre-ghc910/GADT.hs view

file too large to diff

+ tests/examples/pre-ghc910/GADTRecords.hs view

file too large to diff

+ tests/examples/pre-ghc910/GADTRecords2.hs view

file too large to diff

+ tests/examples/pre-ghc910/GHCOrig.hs view

file too large to diff

+ tests/examples/pre-ghc910/Generate.hs view

file too large to diff

+ tests/examples/pre-ghc910/Generic.hs view

file too large to diff

+ tests/examples/pre-ghc910/GenericDeriving.hs view

file too large to diff

+ tests/examples/pre-ghc910/Group.hs view

file too large to diff

+ tests/examples/pre-ghc910/Guards.hs view

file too large to diff

+ tests/examples/pre-ghc910/Haddock.hs view

file too large to diff

+ tests/examples/pre-ghc910/Haddock1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Haddock2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Haddock3.hs view

file too large to diff

+ tests/examples/pre-ghc910/HangingRecord.hs view

file too large to diff

+ tests/examples/pre-ghc910/HashQQ.hs view

file too large to diff

+ tests/examples/pre-ghc910/HashTab.hs view

file too large to diff

+ tests/examples/pre-ghc910/HsDo.hs view

file too large to diff

+ tests/examples/pre-ghc910/HsDocTy.hs view

file too large to diff

+ tests/examples/pre-ghc910/IPLocation.hs view

file too large to diff

+ tests/examples/pre-ghc910/IfThenElse1.hs view

file too large to diff

+ tests/examples/pre-ghc910/IfThenElse2.hs view

file too large to diff

+ tests/examples/pre-ghc910/IfThenElse3.hs view

file too large to diff

+ tests/examples/pre-ghc910/ImplicitParams.hs view

file too large to diff

+ tests/examples/pre-ghc910/ImplicitSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/ImplicitTypeSyn.hs view

file too large to diff

+ tests/examples/pre-ghc910/Import.hs view

file too large to diff

+ tests/examples/pre-ghc910/Imports.hs view

file too large to diff

+ tests/examples/pre-ghc910/ImportsSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/Improvement.hs view

file too large to diff

+ tests/examples/pre-ghc910/IndentedComments.hs view

file too large to diff

+ tests/examples/pre-ghc910/IndentedDo.hs view

file too large to diff

+ tests/examples/pre-ghc910/IndentedModule2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Infix.hs view

file too large to diff

+ tests/examples/pre-ghc910/InfixPatternSynonyms.hs view

file too large to diff

+ tests/examples/pre-ghc910/InlineSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/Internal.hs view

file too large to diff

+ tests/examples/pre-ghc910/Internals.hs view

file too large to diff

+ tests/examples/pre-ghc910/Issue91.hs view

file too large to diff

+ tests/examples/pre-ghc910/Jon.hs view

file too large to diff

+ tests/examples/pre-ghc910/KindEqualities.hs view

file too large to diff

+ tests/examples/pre-ghc910/KindEqualities2.hs view

file too large to diff

+ tests/examples/pre-ghc910/KindLevels.hs view

file too large to diff

+ tests/examples/pre-ghc910/LambdaCase.hs view

file too large to diff

+ tests/examples/pre-ghc910/LayoutLet.hs view

file too large to diff

+ tests/examples/pre-ghc910/LayoutWhere.hs view

file too large to diff

+ tests/examples/pre-ghc910/LetExpr.hs view

file too large to diff

+ tests/examples/pre-ghc910/LetExpr2.hs view

file too large to diff

+ tests/examples/pre-ghc910/LetExprSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/LetIn.hs view

file too large to diff

+ tests/examples/pre-ghc910/LetStmt.hs view

file too large to diff

+ tests/examples/pre-ghc910/LexerM2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Lib.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Lib.hs view

file too large to diff

+ tests/examples/pre-ghc910/LiftedConstructors.hs view

file too large to diff

+ tests/examples/pre-ghc910/LiftedInfixConstructor.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinePragma.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinePragmas.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear10.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear12.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear14.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear15.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear16.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear1Rule.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear3.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear4.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear6.hs view

file too large to diff

+ tests/examples/pre-ghc910/Linear8.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearArrow.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearConstructors.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearEmptyCase.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearGuards.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearTH1.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearTH2.hs view

file too large to diff

+ tests/examples/pre-ghc910/LinearTypeable.hs view

file too large to diff

+ tests/examples/pre-ghc910/List2.hs view

file too large to diff

+ tests/examples/pre-ghc910/ListComments.hs view

file too large to diff

+ tests/examples/pre-ghc910/ListComprehensions.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/ListComprehensions.hs view

file too large to diff

+ tests/examples/pre-ghc910/LiteralsTest2.hs view

file too large to diff

+ tests/examples/pre-ghc910/LocalDecls2Expected.hs view

file too large to diff

+ tests/examples/pre-ghc910/MachineTypes.hs view

file too large to diff

+ tests/examples/pre-ghc910/MagicHash.hs view

file too large to diff

+ tests/examples/pre-ghc910/Main.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Main.2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Main.hs view

file too large to diff

+ tests/examples/pre-ghc910/MangledSemiLet.hs view

file too large to diff

+ tests/examples/pre-ghc910/Manipulate.hs view

file too large to diff

+ tests/examples/pre-ghc910/Match.hs view

file too large to diff

+ tests/examples/pre-ghc910/MatchSemis.hs view

file too large to diff

+ tests/examples/pre-ghc910/Memoize.hs view

file too large to diff

+ tests/examples/pre-ghc910/Minimal.hs view

file too large to diff

+ tests/examples/pre-ghc910/Mixed.hs view

file too large to diff

+ tests/examples/pre-ghc910/ModuleComments.hs view

file too large to diff

+ tests/examples/pre-ghc910/ModuleComments1.hs view

file too large to diff

+ tests/examples/pre-ghc910/ModuleComments2.hs view

file too large to diff

+ tests/examples/pre-ghc910/ModuleComments3.hs view

file too large to diff

+ tests/examples/pre-ghc910/ModuleOnly.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonadComprehensions.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonadFailErrors.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonadFailWarnings.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonadFailWarningsDisabled.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonadFailWarningsWithRebindableSyntax.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonadT.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonoidsFD.hs view

file too large to diff

+ tests/examples/pre-ghc910/MonoidsFD1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Move1.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultConstructor.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiImplicitParams.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiLineCommentWithPragmas.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiLineWarningPragma.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiParamTypeClasses.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiQuote.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiWayIf.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/MultiWayIf.hs view

file too large to diff

+ tests/examples/pre-ghc910/NamedWildcardInDataFamilyInstanceLHS.hs view

file too large to diff

+ tests/examples/pre-ghc910/NamedWildcardInTypeFamilyInstanceLHS.hs view

file too large to diff

+ tests/examples/pre-ghc910/NamedWildcardInTypeSplice.hs view

file too large to diff

+ tests/examples/pre-ghc910/NestedDoLambda.hs view

file too large to diff

+ tests/examples/pre-ghc910/NestedLambda.hs view

file too large to diff

+ tests/examples/pre-ghc910/NullaryTypeClasses.hs view

file too large to diff

+ tests/examples/pre-ghc910/Obscure.hs view

file too large to diff

+ tests/examples/pre-ghc910/Observer.hs view

file too large to diff

+ tests/examples/pre-ghc910/Observer1.hs view

file too large to diff

+ tests/examples/pre-ghc910/OldList.hs view

file too large to diff

+ tests/examples/pre-ghc910/Op.hs view

file too large to diff

+ tests/examples/pre-ghc910/OptSig.hs view

file too large to diff

+ tests/examples/pre-ghc910/OptSig2.hs view

file too large to diff

+ tests/examples/pre-ghc910/OutOfHeap.hs view

file too large to diff

+ tests/examples/pre-ghc910/OveridingPrimitives.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail04_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail06_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail10_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail10_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail10_C.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail11_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsFail12_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedRecFldsRun02_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/OverloadedStrings.hs view

file too large to diff

+ tests/examples/pre-ghc910/P.hs view

file too large to diff

+ tests/examples/pre-ghc910/PArr.hs view

file too large to diff

+ tests/examples/pre-ghc910/PSQ.hs view

file too large to diff

+ tests/examples/pre-ghc910/ParenFunBind.hs view

file too large to diff

+ tests/examples/pre-ghc910/ParenTypeSynonym.hs view

file too large to diff

+ tests/examples/pre-ghc910/ParensAroundContext.hs view

file too large to diff

+ tests/examples/pre-ghc910/ParensGADT.hs view

file too large to diff

+ tests/examples/pre-ghc910/Parse.hs view

file too large to diff

+ tests/examples/pre-ghc910/Parser.hs view

file too large to diff

+ tests/examples/pre-ghc910/ParserArrowLambdaCase.hs view

file too large to diff

+ tests/examples/pre-ghc910/PartialClassMethodSignature2.hs view

file too large to diff

+ tests/examples/pre-ghc910/PatBind.hs view

file too large to diff

+ tests/examples/pre-ghc910/PatSigBind.hs view

file too large to diff

+ tests/examples/pre-ghc910/PatSynBind.hs view

file too large to diff

+ tests/examples/pre-ghc910/PatternGuards.hs view

file too large to diff

+ tests/examples/pre-ghc910/PluralS.hs view

file too large to diff

+ tests/examples/pre-ghc910/PolyInstances.hs view

file too large to diff

+ tests/examples/pre-ghc910/PopCnt.hs view

file too large to diff

+ tests/examples/pre-ghc910/PostgreSQL.hs view

file too large to diff

+ tests/examples/pre-ghc910/Ppr006a.hs view

file too large to diff

+ tests/examples/pre-ghc910/Ppr017.hs view

file too large to diff

+ tests/examples/pre-ghc910/Ppr048.hs view

file too large to diff

+ tests/examples/pre-ghc910/Pr110.hs view

file too large to diff

+ tests/examples/pre-ghc910/PragmaSpans.hs view

file too large to diff

+ tests/examples/pre-ghc910/Primop.hs view

file too large to diff

+ tests/examples/pre-ghc910/Printf.hs view

file too large to diff

+ tests/examples/pre-ghc910/ProcNotation.hs view

file too large to diff

+ tests/examples/pre-ghc910/Process.hs view

file too large to diff

+ tests/examples/pre-ghc910/Process1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Process2.hs view

file too large to diff

+ tests/examples/pre-ghc910/PromotedClass.hs view

file too large to diff

+ tests/examples/pre-ghc910/Pseudonym.hs view

file too large to diff

+ tests/examples/pre-ghc910/PuncFunctions.hs view

file too large to diff

+ tests/examples/pre-ghc910/Q.hs view

file too large to diff

+ tests/examples/pre-ghc910/QQ.hs view

file too large to diff

+ tests/examples/pre-ghc910/QuasiQuote.hs view

file too large to diff

+ tests/examples/pre-ghc910/QuasiQuote2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Query.hs view

file too large to diff

+ tests/examples/pre-ghc910/RAE_T32a.hs view

file too large to diff

+ tests/examples/pre-ghc910/RAE_T32b.hs view

file too large to diff

+ tests/examples/pre-ghc910/RList.hs view

file too large to diff

+ tests/examples/pre-ghc910/RSA.hs view

file too large to diff

+ tests/examples/pre-ghc910/Rae31.hs view

file too large to diff

+ tests/examples/pre-ghc910/RaeBlogPost.hs view

file too large to diff

+ tests/examples/pre-ghc910/RandomPGC.hs view

file too large to diff

+ tests/examples/pre-ghc910/RandomPGC1.hs view

file too large to diff

+ tests/examples/pre-ghc910/RankNTypes.hs view

file too large to diff

+ tests/examples/pre-ghc910/RdrNames.hs view

file too large to diff

+ tests/examples/pre-ghc910/RebindableSyntax.hs view

file too large to diff

+ tests/examples/pre-ghc910/RecordSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/RecordUpdate.hs view

file too large to diff

+ tests/examples/pre-ghc910/RecordWildcard.hs view

file too large to diff

+ tests/examples/pre-ghc910/Records.hs view

file too large to diff

+ tests/examples/pre-ghc910/Records2.hs view

file too large to diff

+ tests/examples/pre-ghc910/RecursiveDo.hs view

file too large to diff

+ tests/examples/pre-ghc910/RedundantDo.hs view

file too large to diff

+ tests/examples/pre-ghc910/Remorse.hs view

file too large to diff

+ tests/examples/pre-ghc910/RenamingStar.hs view

file too large to diff

+ tests/examples/pre-ghc910/RepArrow.hs view

file too large to diff

+ tests/examples/pre-ghc910/Retrie.hs view

file too large to diff

+ tests/examples/pre-ghc910/RmDecl4.hs view

file too large to diff

+ tests/examples/pre-ghc910/Roles.hs view

file too large to diff

+ tests/examples/pre-ghc910/Roles12a.hs view

file too large to diff

+ tests/examples/pre-ghc910/RuleDefiningPlugin.hs view

file too large to diff

+ tests/examples/pre-ghc910/RulePragma.hs view

file too large to diff

+ tests/examples/pre-ghc910/Rules.hs view

file too large to diff

+ tests/examples/pre-ghc910/RulesSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap1.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap10.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap10_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap10_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap11.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap11_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap11_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap1_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap1_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap2.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap2_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap2_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap3.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap3_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap3_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap4.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap4_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap4_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap5.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap5_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap5_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap6.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap6_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap6_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap7.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap7_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap7_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap8.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap8_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap9.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap9_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/SH_Overlap9_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/ST.hs view

file too large to diff

+ tests/examples/pre-ghc910/SayAnnNames.hs view

file too large to diff

+ tests/examples/pre-ghc910/ScopedTypeVariables.hs view

file too large to diff

+ tests/examples/pre-ghc910/ScopesBug.hs view

file too large to diff

+ tests/examples/pre-ghc910/SelfDep.hs view

file too large to diff

+ tests/examples/pre-ghc910/SemiInstance.hs view

file too large to diff

+ tests/examples/pre-ghc910/SemiWorkout.hs view

file too large to diff

+ tests/examples/pre-ghc910/SemicolonIf.hs view

file too large to diff

+ tests/examples/pre-ghc910/SemigroupWarnings.hs view

file too large to diff

+ tests/examples/pre-ghc910/Setup.hs view

file too large to diff

+ tests/examples/pre-ghc910/Shebang.hs view

file too large to diff

+ tests/examples/pre-ghc910/ShiftingLambda.hs view

file too large to diff

+ tests/examples/pre-ghc910/ShouldFail.hs view

file too large to diff

+ tests/examples/pre-ghc910/SigTvKinds.hs view

file too large to diff

+ tests/examples/pre-ghc910/SigTvKinds2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Sigs.hs view

file too large to diff

+ tests/examples/pre-ghc910/Simple.hs view

file too large to diff

+ tests/examples/pre-ghc910/SimpleComplexTuple.hs view

file too large to diff

+ tests/examples/pre-ghc910/SimpleDo.hs view

file too large to diff

+ tests/examples/pre-ghc910/SlidingDataClassDecl.hs view

file too large to diff

+ tests/examples/pre-ghc910/SlidingDoClause.hs view

file too large to diff

+ tests/examples/pre-ghc910/SlidingLambda.hs view

file too large to diff

+ tests/examples/pre-ghc910/SlidingListComp.hs view

file too large to diff

+ tests/examples/pre-ghc910/SlidingRecordSetter.hs view

file too large to diff

+ tests/examples/pre-ghc910/SlidingTypeSyn.hs view

file too large to diff

+ tests/examples/pre-ghc910/SpacesSplice.hs view

file too large to diff

+ tests/examples/pre-ghc910/SpecializePhaseControl.hs view

file too large to diff

+ tests/examples/pre-ghc910/Splice.hs view

file too large to diff

+ tests/examples/pre-ghc910/SpliceSemi.hs view

file too large to diff

+ tests/examples/pre-ghc910/Splices.hs view

file too large to diff

+ tests/examples/pre-ghc910/SplicesUsed.hs view

file too large to diff

+ tests/examples/pre-ghc910/StackOverflow.hs view

file too large to diff

+ tests/examples/pre-ghc910/StarBinder.hs view

file too large to diff

+ tests/examples/pre-ghc910/StaticPointers.hs view

file too large to diff

+ tests/examples/pre-ghc910/Stmts.hs view

file too large to diff

+ tests/examples/pre-ghc910/StrangeTypeClass.hs view

file too large to diff

+ tests/examples/pre-ghc910/Stream.hs view

file too large to diff

+ tests/examples/pre-ghc910/StrictLet.hs view

file too large to diff

+ tests/examples/pre-ghc910/StringGap.hs view

file too large to diff

+ tests/examples/pre-ghc910/StringRef.hs view

file too large to diff

+ tests/examples/pre-ghc910/Structure8.hs view

file too large to diff

+ tests/examples/pre-ghc910/Structure8a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10009.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10030.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10041.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10045.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10047.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10052-input.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10052.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10083.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10083a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10100.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10104.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10109.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10110A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10110B.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10110C.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10112.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10134.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10134a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10139.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10141.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10148.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10156.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10180.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10181.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10182.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10182a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10184.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10185.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10188.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10194.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10195.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10196.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10196.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10215.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10218.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10220B.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10226.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10233.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10233a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10245.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10246.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10251.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10263.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10267.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10267a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10279.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10279.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10283.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10284.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10285.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10285a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10294.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10294a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10306.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10318.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10321.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10322A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10322B.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10322C.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10335.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10340.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10348.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10351.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10359.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10361a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10361b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10370.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10384.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10390.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10398.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10403.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10414.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10420.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10420a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10423.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10428.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10438.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10447.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10451.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10460.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10461.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10463.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10481.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10482.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10482a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10487.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10487_M.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10489.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10493.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10494.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10495.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10503.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10507.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10508_api.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10516.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10519.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10521.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10521b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10524.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10534.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10534a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10549.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10549a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10561.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10562.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10564.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10570.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10590.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10596.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10602.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10602b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10615.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10618.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10620.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10627.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10632.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10634.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10637.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10638.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10638.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10642.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10662.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10667.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10668.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10670.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10670a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10678.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10689.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10689a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10694.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10698.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10704.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10704a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10713.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10734.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10742.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10744.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10747.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10753.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10767.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10781.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10796a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10796b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10806.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10815.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10819.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10819.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10819_Lib.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10820.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10826.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10830.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10836.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10845.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10846.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10870.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10890.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10890_1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10890_2.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10890_2A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10890_2B.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10891.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10891.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10895.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10897a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10897b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10904.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10908.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10929.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10931.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10934.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10935.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10942.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10942.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10942_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10945.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10946.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10955dyn.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10962.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10971a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10971b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10971c.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10971d.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10997.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10997_1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10997_1a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10997a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T10999.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11010.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11016.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11039.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11053.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11067.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11071.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11071a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11076.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11076A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11077.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11103.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11112.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11128.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11136.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11142.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11148.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11155.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11164.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11164a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11164b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11167.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11167_ambig.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11167_ambiguous_fixity.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11167_ambiguous_fixity_A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11167_ambiguous_fixity_B.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11173.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11173a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11182.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11187.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11192.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11193.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11208.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11216.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11224.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11232.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11237.hs view

file too large to diff

+ tests/examples/pre-ghc910/T1133Aa.hs view

file too large to diff

+ tests/examples/pre-ghc910/T1133a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11381.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11484.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11671_run.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11727.hs view

file too large to diff

+ tests/examples/pre-ghc910/T11959.hs view

file too large to diff

+ tests/examples/pre-ghc910/T12045TH1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T12045TH2.hs view

file too large to diff

+ tests/examples/pre-ghc910/T12045a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T12478_5.hs view

file too large to diff

+ tests/examples/pre-ghc910/T13050.hs view

file too large to diff

+ tests/examples/pre-ghc910/T13087.hs view

file too large to diff

+ tests/examples/pre-ghc910/T13343.hs view

file too large to diff

+ tests/examples/pre-ghc910/T13594.hs view

file too large to diff

+ tests/examples/pre-ghc910/T13747.hs view

file too large to diff

+ tests/examples/pre-ghc910/T14164.hs view

file too large to diff

+ tests/examples/pre-ghc910/T14650.hs view

file too large to diff

+ tests/examples/pre-ghc910/T15365.hs view

file too large to diff

+ tests/examples/pre-ghc910/T16326_Compile1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17296.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17544_kw.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17c.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17d.hs view

file too large to diff

+ tests/examples/pre-ghc910/T17e.hs view

file too large to diff

+ tests/examples/pre-ghc910/T18023.hs view

file too large to diff

+ tests/examples/pre-ghc910/T1830_1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T1830_2.hs view

file too large to diff

+ tests/examples/pre-ghc910/T1830_3.hs view

file too large to diff

+ tests/examples/pre-ghc910/T1830_3a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T18432.hs view

file too large to diff

+ tests/examples/pre-ghc910/T18522-dbg-ppr.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2006.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2204.hs view

file too large to diff

+ tests/examples/pre-ghc910/T22315b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T22332a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T22500.hs view

file too large to diff

+ tests/examples/pre-ghc910/T23465.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2388.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2632.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2632.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2931.hs view

file too large to diff

+ tests/examples/pre-ghc910/T2991.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3078.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3132.hs view

file too large to diff

+ tests/examples/pre-ghc910/T322.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3263-2.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3391.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3391.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3468a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3572.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3572.hs view

file too large to diff

+ tests/examples/pre-ghc910/T365.hs view

file too large to diff

+ tests/examples/pre-ghc910/T366.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3927.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3927a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T3927b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4056.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4056.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4139.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4169.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4169.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4170.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4170.hs view

file too large to diff

+ tests/examples/pre-ghc910/T4437.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5001b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5217.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5333.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5721.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5821.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5884Other.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5908.hs view

file too large to diff

+ tests/examples/pre-ghc910/T5951.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018Afail.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018Bfail.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018Cfail.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018Dfail.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018fail.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018failclosed.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018failclosed2.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018rnfail.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018th.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6018th.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6062.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6062.hs view

file too large to diff

+ tests/examples/pre-ghc910/T6124.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7411.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7669a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7672.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7672a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7765.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7788.hs view

file too large to diff

+ tests/examples/pre-ghc910/T7918A.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8030.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8034.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8101b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8131b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8274.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8455.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8455.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8550.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8555.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8633.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8743a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8759a.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8759a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8799.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8807.hs view

file too large to diff

+ tests/examples/pre-ghc910/T8970.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9015.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9017.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9177a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9204a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9204b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9204b2.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9233.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9233a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9238.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9260.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9367.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9430.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9554.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9600-1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9600.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9632.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9662.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9824.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9824.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9839_02.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9839_03.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9839_04.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9839_05.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9839_06.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9840.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9840a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9858a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9858b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9858c.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9858d.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9858e.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9867.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9878b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9938.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9938B.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9939.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9951.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9951b.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9964.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9968.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9968a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9973.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9975a.hs view

file too large to diff

+ tests/examples/pre-ghc910/T9975b.hs view

file too large to diff

+ tests/examples/pre-ghc910/TDDataConstructor.hs view

file too large to diff

+ tests/examples/pre-ghc910/TDExistential.hs view

file too large to diff

+ tests/examples/pre-ghc910/TDGADT.hs view

file too large to diff

+ tests/examples/pre-ghc910/TDGoodConsConstraints.hs view

file too large to diff

+ tests/examples/pre-ghc910/TDVector.hs view

file too large to diff

+ tests/examples/pre-ghc910/TD_TH_splice.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH2.hs view

file too large to diff

+ tests/examples/pre-ghc910/THMonadInstance.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_abstractFamily.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_abstractFamily.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_bracket1.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_bracket1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_bracket2.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_bracket2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_bracket3.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_bracket3.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_class1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_dataD1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_finalizer.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_localname.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_localname.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_lookupName.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_namePackage.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_nameSpace.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_ppr1.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_ppr1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_raiseErr1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_recover.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_recover_warns.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_recursiveDoImport.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyDecl1.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyDecl1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyDecl1a.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyDecl2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyInstances.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyLinear.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyMkName.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyType1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_reifyType2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repE1.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repE1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repE2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repE3.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repE3.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repGuard.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repGuardOutput.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repPatSig.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repPatSigTVar.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repPrim.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repPrim2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repPrimOutput.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_repPrimOutput2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_scope.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_scope.2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_scope.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_sections.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceD2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceDecl1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceDecl2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceDecl3.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE3.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE4.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE5_Lib.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE5_prof_Lib.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE5_prof_ext.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE5_prof_ext_Lib.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceE5_prof_ext_Lib.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_spliceExpr1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_tf1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_tf2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_tf3.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_unresolvedInfix.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_unresolvedInfix.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_unresolvedInfix2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TH_unresolvedInfix_Lib.hs view

file too large to diff

+ tests/examples/pre-ghc910/TcCustomSolverSuper.hs view

file too large to diff

+ tests/examples/pre-ghc910/TemplateHaskell.hs view

file too large to diff

+ tests/examples/pre-ghc910/Templates.hs view

file too large to diff

+ tests/examples/pre-ghc910/TensorTests.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test.1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test.2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10255.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10268.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10269.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10276.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10278.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10280.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10307.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10309.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10312.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10313.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10354.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10357.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10358.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test10396.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test11018.hs view

file too large to diff

+ tests/examples/pre-ghc910/Test12417.hs view

file too large to diff

+ tests/examples/pre-ghc910/TestBoolFormula.hs view

file too large to diff

+ tests/examples/pre-ghc910/TestUtils.hs view

file too large to diff

+ tests/examples/pre-ghc910/Token.hs view

file too large to diff

+ tests/examples/pre-ghc910/TopLevelSemis.hs view

file too large to diff

+ tests/examples/pre-ghc910/TopLevelSemis1.hs view

file too large to diff

+ tests/examples/pre-ghc910/TopLevelSemis2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TopLevelSemis3.hs view

file too large to diff

+ tests/examples/pre-ghc910/TopLevelSemis4.hs view

file too large to diff

+ tests/examples/pre-ghc910/Trac10045.hs view

file too large to diff

+ tests/examples/pre-ghc910/TransAssociated.hs view

file too large to diff

+ tests/examples/pre-ghc910/TransBundle.hs view

file too large to diff

+ tests/examples/pre-ghc910/TransformListComp.hs view

file too large to diff

+ tests/examples/pre-ghc910/Trit.hs view

file too large to diff

+ tests/examples/pre-ghc910/TupSection.hs view

file too large to diff

+ tests/examples/pre-ghc910/Tuple.hs view

file too large to diff

+ tests/examples/pre-ghc910/TupleN.hs view

file too large to diff

+ tests/examples/pre-ghc910/TupleSections.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeBrackets.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeBrackets2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeBrackets4.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeFamilies.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeFamilies2.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeFamilyInstanceLHS.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeInstance.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeLevelVec.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeOperators.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeSignature.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeSignatureParens.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeSkolEscape.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeSynOperator.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypeSynParens.hs view

file too large to diff

+ tests/examples/pre-ghc910/TypedSplice.hs view

file too large to diff

+ tests/examples/pre-ghc910/Types.hs view

file too large to diff

+ tests/examples/pre-ghc910/Unboxed.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined10.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined10a.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined11.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined13.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined2.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined3.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined4.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined5.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined6.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined7.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined8.hs view

file too large to diff

+ tests/examples/pre-ghc910/Undefined9.hs view

file too large to diff

+ tests/examples/pre-ghc910/Unicode.hs view

file too large to diff

+ tests/examples/pre-ghc910/UnicodeRules.hs view

file too large to diff

+ tests/examples/pre-ghc910/UnicodeSyntax.hs view

file too large to diff

+ tests/examples/pre-ghc910/Utilities.hs view

file too large to diff

+ tests/examples/pre-ghc910/Utils.hs view

file too large to diff

+ tests/examples/pre-ghc910/Utils2.hs view

file too large to diff

+ tests/examples/pre-ghc910/ViewPatterns.hs view

file too large to diff

+ tests/examples/pre-ghc910/Vta1.hs view

file too large to diff

+ tests/examples/pre-ghc910/Vta2.hs view

file too large to diff

+ tests/examples/pre-ghc910/WCompatWarningsNotOn.hs view

file too large to diff

+ tests/examples/pre-ghc910/WCompatWarningsOff.hs view

file too large to diff

+ tests/examples/pre-ghc910/WCompatWarningsOn.hs view

file too large to diff

+ tests/examples/pre-ghc910/WCompatWarningsOnOff.hs view

file too large to diff

+ tests/examples/pre-ghc910/Warning.hs view

file too large to diff

+ tests/examples/pre-ghc910/Webhook.hs view

file too large to diff

+ tests/examples/pre-ghc910/Zipper.hs view

file too large to diff

+ tests/examples/pre-ghc910/Zwaluw.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado001.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado002.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado003.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado004.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado005.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado006.hs view

file too large to diff

+ tests/examples/pre-ghc910/ado007.hs view

file too large to diff

+ tests/examples/pre-ghc910/anf.hs view

file too large to diff

+ tests/examples/pre-ghc910/boolFormula.hs view

file too large to diff

+ tests/examples/pre-ghc910/brackets.hs view

file too large to diff

+ tests/examples/pre-ghc910/completesig01.hs view

file too large to diff

+ tests/examples/pre-ghc910/deriving-via-compile.hs view

file too large to diff

+ tests/examples/pre-ghc910/determ004.hs view

file too large to diff

+ tests/examples/pre-ghc910/determinism001.hs view

file too large to diff

+ tests/examples/pre-ghc910/dynamic-paper.hs view

file too large to diff

+ tests/examples/pre-ghc910/dynbrk005.hs view

file too large to diff

+ tests/examples/pre-ghc910/empty-foralls.hs view

file too large to diff

+ tests/examples/pre-ghc910/empty-foralls2.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-class.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-ps-rec-sel.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-record-selector.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-super-class-fail.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-super-class.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-syntax.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-type-synonym.hs view

file too large to diff

+ tests/examples/pre-ghc910/export-type.hs view

file too large to diff

+ tests/examples/pre-ghc910/ffi1.hs view

file too large to diff

+ tests/examples/pre-ghc910/frontend01.hs view

file too large to diff

+ tests/examples/pre-ghc910/ghci006.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockA026.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockA027.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockA031.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockA034.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockC026.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockC027.hs view

file too large to diff

+ tests/examples/pre-ghc910/haddockC031.hs view

file too large to diff

+ tests/examples/pre-ghc910/hie010.hs view

file too large to diff

+ tests/examples/pre-ghc910/listcomps.hs view

file too large to diff

+ tests/examples/pre-ghc910/mdo.hs view

file too large to diff

+ tests/examples/pre-ghc910/mixed-pat-syn-record-sels.hs view

file too large to diff

+ tests/examples/pre-ghc910/mkGADTVars.hs view

file too large to diff

+ tests/examples/pre-ghc910/mod181.hs view

file too large to diff

+ tests/examples/pre-ghc910/multi-export.hs view

file too large to diff

+ tests/examples/pre-ghc910/n-plus-k-patterns.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedlabelsfail01.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedlabelsrun01.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedlabelsrun02.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedlabelsrun03.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecflds_generics.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail01.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail02.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail03.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail04.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail05.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail06.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail07.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail08.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail09.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail10.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail11.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail12.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail13.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsfail14.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsrun01.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsrun02.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsrun03.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsrun04.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsrun05.hs view

file too large to diff

+ tests/examples/pre-ghc910/overloadedrecfldsrun06.hs view

file too large to diff

+ tests/examples/pre-ghc910/performGC.hs view

file too large to diff

+ tests/examples/pre-ghc910/plugins07.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc001.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc002.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc003.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc004.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc005.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc006.hs view

file too large to diff

+ tests/examples/pre-ghc910/pmc007.hs view

file too large to diff

+ tests/examples/pre-ghc910/poly-export-fail2.hs view

file too large to diff

+ tests/examples/pre-ghc910/poly-export.hs view

file too large to diff

+ tests/examples/pre-ghc910/poly-export2.hs view

file too large to diff

+ tests/examples/pre-ghc910/poly-export3.hs view

file too large to diff

+ tests/examples/pre-ghc910/proc-do-complex-four-out.hs view

file too large to diff

+ tests/examples/pre-ghc910/proc-do-complex-out.hs view

file too large to diff

+ tests/examples/pre-ghc910/proc-do-complex.hs view

file too large to diff

+ tests/examples/pre-ghc910/proc-lets-out.hs view

file too large to diff

+ tests/examples/pre-ghc910/proc-lets.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdocompile001.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdocompile002.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun001.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun002.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun003.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun004.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun005.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun006.hs view

file too large to diff

+ tests/examples/pre-ghc910/qdorun007.hs view

file too large to diff

+ tests/examples/pre-ghc910/read018.hs view

file too large to diff

+ tests/examples/pre-ghc910/record-dot-four-out.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-check-sels.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-compile.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-exquant.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-mixing-fields.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-no-uni-update.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-no-uni-update2.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-poly-update.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-poly.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-prov-req.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-req-only.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-req.hs view

file too large to diff

+ tests/examples/pre-ghc910/records-run.hs view

file too large to diff

+ tests/examples/pre-ghc910/saks029.hs view

file too large to diff

+ tests/examples/pre-ghc910/saks032.hs view

file too large to diff

+ tests/examples/pre-ghc910/spec-inline-determ.hs view

file too large to diff

+ tests/examples/pre-ghc910/stringSource.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10255.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10268.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10269.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10278.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10280.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10307.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10309.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10312.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10354.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10357.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10358.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10396.hs view

file too large to diff

+ tests/examples/pre-ghc910/t10399.hs view

file too large to diff

+ tests/examples/pre-ghc910/tc265.hs view

file too large to diff

+ tests/examples/pre-ghc910/tcfail223.hs view

file too large to diff

+ tests/examples/pre-ghc910/update-existential.hs view

file too large to diff

tests/examples/transform/AddDecl.hs view

file too large to diff

tests/examples/transform/AddDecl.hs.expected view

file too large to diff

tests/examples/transform/AddLocalDecl1.hs view

file too large to diff

tests/examples/transform/AddLocalDecl1.hs.expected view

file too large to diff

+ tests/examples/transform/WhereIn3b.hs view

file too large to diff

+ tests/examples/transform/WhereIn3b.hs.expected view

file too large to diff

− tests/examples/vect/DiophantineVect.hs

file too large to diff