ghc-syb 0.1.1 → 0.1.1.1
raw patch · 5 files changed
+733/−723 lines, 5 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- LICENSE +29/−29
- Setup.hs +3/−3
- ghc-syb.cabal +30/−28
- src/GHC/SYB/Instances.hs +414/−406
- src/GHC/SYB/Utils.hs +257/−257
LICENSE view
@@ -1,29 +1,29 @@-Copyright 2008, Claus Reinke -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the author nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND THE CONTRIBUTORS "AS -IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY -COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER -IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright 2008, Claus Reinke+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the author nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND THE CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY+COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR+OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,4 +1,4 @@-#!/usr/bin/env runhaskell -import Distribution.Simple -main :: IO () +#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO () main = defaultMain
ghc-syb.cabal view
@@ -1,29 +1,31 @@-name: ghc-syb -version: 0.1.1 -license: BSD3 -license-file: LICENSE -author: Claus Reinke -copyright: (c) Claus Reinke 2008 -maintainer: Thomas Schilling <nominolo@googlemail.com> -homepage: http://github.com/nominolo/ghc-syb -description: Scrap Your Boilerplate instances and utils for the GHC API. -synopsis: SYB instances for the GHC API -category: Development -stability: provisional -build-type: Simple -cabal-version: >= 1.2 -tested-with: GHC ==6.10.1 --- extra-source-files: README - -library - build-depends: base >= 4 && < 5, - syb >= 0.1 && < 0.2, - ghc >= 6.10 && < 6.12 - hs-source-dirs: src - extensions: CPP, TypeSynonymInstances, StandaloneDeriving, - DeriveDataTypeable, ScopedTypeVariables, - RankNTypes - exposed-modules: GHC.SYB.Instances, - GHC.SYB.Utils - if impl(ghc > 6.11.20081030) +name: ghc-syb+version: 0.1.1.1+license: BSD3+license-file: LICENSE+author: Claus Reinke+copyright: (c) Claus Reinke 2008+maintainer: Thomas Schilling <nominolo@googlemail.com>+homepage: http://github.com/nominolo/ghc-syb+description: Scrap Your Boilerplate instances and utils for the GHC API.+synopsis: SYB instances for the GHC API+category: Development+stability: provisional+build-type: Simple+cabal-version: >= 1.2.3+tested-with: GHC ==6.10.1+-- extra-source-files: README++library+ build-depends: base >= 4 && < 5,+ syb >= 0.1 && < 0.2,+ ghc >= 6.10 && < 6.12+ hs-source-dirs: src+ extensions: CPP, TypeSynonymInstances, StandaloneDeriving,+ DeriveDataTypeable, ScopedTypeVariables,+ RankNTypes+ exposed-modules: GHC.SYB.Instances,+ GHC.SYB.Utils+ if impl(ghc > 6.11.20081030) cpp-options: -DHAS_ANNOTATIONS+ if impl(ghc >= 6.11.20090318)+ cpp-options: -DCONSTRUCTOR_LIKE_IDS
src/GHC/SYB/Instances.hs view
@@ -1,406 +1,414 @@-{- | "GHC.Syb.Instances" provides instances of Data\/Typeable - for Ghc Api types, using standalone deriving. - -Most instances are standard; to provide 'Data' instances -abstract types, we use one of two schemes: - -- no traversal: 'SrcSpan', 'Module', 'ModuleName', 'OccName', 'Name', - 'FastString', 'DataCon', 'Var', 'TyCon', 'Class' - -@ - abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix - abstractDataType n = mkDataType n [abstractConstr n] -@ - -@ - instance Data SrcSpan where - -- don't traverse? - toConstr _ = abstractConstr "SrcSpan" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "SrcSpan" -@ - -- abstract traversal: 'NameSet', 'Bag' - -@ - instance Data NameSet where - gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly - toConstr _ = abstractConstr "NameSet" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "NameSet" -@ - -Please report any issues, either with these abstract instances or with -these modules going out of sync with GHC head, to the package maintainer. - --} -module GHC.SYB.Instances where - -import GHC hiding(TyCon) -import SrcLoc -import RdrName -import OccName -import FastString -import Bag -import Module -import BasicTypes -import Var -import ForeignCall - -import Data.Data -import NameSet -import TypeRep -import qualified TyCon - -#include "Typeable.h" - -#ifdef __HADDOCK__ -#else - --- TODO: good for generalized show, but is this sound in general? -abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix -abstractDataType n = mkDataType n [abstractConstr n] - --- Typeable0 - -INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan") -instance Data SrcSpan where - -- don't traverse? - toConstr _ = abstractConstr "SrcSpan" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "SrcSpan" - -INSTANCE_TYPEABLE0(Module,moduleTc,"Module") -instance Data Module where - -- don't traverse? - toConstr _ = abstractConstr "Module" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Module" - -INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName") -instance Data ModuleName where - -- don't traverse? - toConstr _ = abstractConstr "ModuleName" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "ModuleName" - -deriving instance Typeable RdrName -deriving instance Data RdrName - -INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName") -instance Data OccName where - -- don't traverse? - toConstr _ = abstractConstr "OccName" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "OccName" - -INSTANCE_TYPEABLE0(Name,nameTc,"Name") -instance Data Name where - -- don't traverse? - toConstr _ = abstractConstr "Name" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Name" - -deriving instance Typeable FastString -instance Data FastString where - -- don't traverse? - toConstr _ = abstractConstr "FastString" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "FastString" - -deriving instance Typeable HsExplicitForAll -deriving instance Data HsExplicitForAll - -deriving instance Typeable HsBang -deriving instance Data HsBang - -deriving instance Typeable Boxity -deriving instance Data Boxity - -deriving instance Typeable OverLitVal -deriving instance Data OverLitVal - -deriving instance Typeable RecFlag -deriving instance Data RecFlag - -deriving instance Typeable BasicTypes.Fixity -deriving instance Data BasicTypes.Fixity - -deriving instance Typeable HsArrAppType -deriving instance Data HsArrAppType - -deriving instance Typeable FixityDirection -deriving instance Data FixityDirection - -INSTANCE_TYPEABLE0(DataCon,dataConTc,"DataCon") -instance Data DataCon where - -- don't traverse? - toConstr _ = abstractConstr "DataCon" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "DataCon" - -INSTANCE_TYPEABLE0(Var,varTc,"Var") -instance Data Var where - -- don't traverse? - toConstr _ = abstractConstr "Var" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Var" - -deriving instance Typeable InlineSpec -deriving instance Data InlineSpec - -deriving instance Typeable ForeignImport -deriving instance Data ForeignImport - -deriving instance Typeable ForeignExport -deriving instance Data ForeignExport - -deriving instance Typeable CImportSpec -deriving instance Data CImportSpec - -deriving instance Typeable CExportSpec -deriving instance Data CExportSpec - -deriving instance Typeable DNCallSpec -deriving instance Data DNCallSpec - -deriving instance Typeable Safety -deriving instance Data Safety - -deriving instance Typeable CCallConv -deriving instance Data CCallConv - -deriving instance Typeable DNKind -deriving instance Data DNKind - -deriving instance Typeable DNType -deriving instance Data DNType - -deriving instance Typeable CCallTarget -deriving instance Data CCallTarget - -deriving instance Typeable Activation -deriving instance Data Activation - -INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet") -instance Data NameSet where - gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly - toConstr _ = abstractConstr "NameSet" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "NameSet" - -deriving instance Typeable FoType -deriving instance Data FoType - -deriving instance Typeable FamilyFlavour -deriving instance Data FamilyFlavour - -deriving instance Typeable NewOrData -deriving instance Data NewOrData - -INSTANCE_TYPEABLE0(TyCon.TyCon,tyConTc,"TyCon") -instance Data TyCon.TyCon where - -- don't traverse? - toConstr _ = abstractConstr "TyCon.TyCon" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "TyCon.TyCon" - -INSTANCE_TYPEABLE0(Class,classTc,"Class") -instance Data Class where - -- don't traverse? - toConstr _ = abstractConstr "Class" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Class" - -deriving instance Typeable Prag -deriving instance Data Prag - -deriving instance Typeable HsWrapper -deriving instance Data HsWrapper - -deriving instance Typeable PredType -deriving instance Data PredType - -deriving instance Typeable Type -deriving instance Data Type - -deriving instance Typeable HsLit -deriving instance Data HsLit - --- Typeable1 - -deriving instance Typeable1 Located -deriving instance Data e => Data (Located e) - -deriving instance Typeable1 HsModule -deriving instance Data a => Data (HsModule a) - -deriving instance Typeable1 HsDoc -deriving instance Data a => Data (HsDoc a) - -deriving instance Typeable1 HaddockModInfo -deriving instance Data a => Data (HaddockModInfo a) - -deriving instance Typeable1 HsDecl -deriving instance Data a => Data (HsDecl a) - -deriving instance Typeable1 ImportDecl -deriving instance Data a => Data (ImportDecl a) - -deriving instance Typeable1 IE -deriving instance Data a => Data (IE a) - -deriving instance Typeable1 TyClDecl -deriving instance Data a => Data (TyClDecl a) - -deriving instance Typeable1 DocDecl -deriving instance Data a => Data (DocDecl a) - -deriving instance Typeable1 SpliceDecl -deriving instance Data a => Data (SpliceDecl a) - -deriving instance Typeable1 RuleDecl -deriving instance Data a => Data (RuleDecl a) - -deriving instance Typeable WarningTxt -deriving instance Data WarningTxt - -deriving instance Typeable1 WarnDecl -deriving instance Data a => Data (WarnDecl a) - -deriving instance Typeable1 ForeignDecl -deriving instance Data a => Data (ForeignDecl a) - -deriving instance Typeable1 DefaultDecl -deriving instance Data a => Data (DefaultDecl a) - -deriving instance Typeable1 Sig -deriving instance Data a => Data (Sig a) - -deriving instance Typeable1 DerivDecl -deriving instance Data a => Data (DerivDecl a) - -deriving instance Typeable1 InstDecl -deriving instance Data a => Data (InstDecl a) - -deriving instance Typeable1 HsPred -deriving instance Data a => Data (HsPred a) - -deriving instance Typeable1 HsType -deriving instance Data a => Data (HsType a) - -deriving instance Typeable1 ConDecl -deriving instance Data a => Data (ConDecl a) - -INSTANCE_TYPEABLE1(Bag,bagTc,"Bag") -instance Data a => Data (Bag a) where - gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly - toConstr _ = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Bag" - -deriving instance Typeable1 HsTyVarBndr -deriving instance Data a => Data (HsTyVarBndr a) - -deriving instance Typeable1 ResType -deriving instance Data a => Data (ResType a) - -deriving instance Typeable1 HsSplice -deriving instance Data a => Data (HsSplice a) - -deriving instance Typeable1 ConDeclField -deriving instance Data a => Data (ConDeclField a) - -deriving instance Typeable1 IPName -deriving instance Data a => Data (IPName a) - -deriving instance Typeable1 MatchGroup -deriving instance Data a => Data (MatchGroup a) - -deriving instance Typeable1 Pat -deriving instance Data a => Data (Pat a) - -deriving instance Typeable1 GRHSs -deriving instance Data a => Data (GRHSs a) - -deriving instance Typeable1 HsExpr -deriving instance Data a => Data (HsExpr a) - -deriving instance Typeable1 HsQuasiQuote -deriving instance Data a => Data (HsQuasiQuote a) - -deriving instance Typeable1 HsOverLit -deriving instance Data a => Data (HsOverLit a) - -deriving instance Typeable1 ArithSeqInfo -deriving instance Data a => Data (ArithSeqInfo a) - -deriving instance Typeable1 HsBracket -deriving instance Data a => Data (HsBracket a) - -deriving instance Typeable1 HsCmdTop -deriving instance Data a => Data (HsCmdTop a) - -deriving instance Typeable1 HsGroup -deriving instance Data a => Data (HsGroup a) - -deriving instance Typeable1 FixitySig -deriving instance Data a => Data (FixitySig a) - -deriving instance Typeable1 HsIPBinds -deriving instance Data a => Data (HsIPBinds a) - -deriving instance Typeable1 IPBind -deriving instance Data a => Data (IPBind a) - -deriving instance Typeable1 GroupByClause -deriving instance Data a => Data (GroupByClause a) - -deriving instance Typeable1 HsStmtContext -deriving instance Data a => Data (HsStmtContext a) - -deriving instance Typeable1 HsMatchContext -deriving instance Data a => Data (HsMatchContext a) - -deriving instance Typeable1 GRHS -deriving instance Data a => Data (GRHS a) - -deriving instance Typeable1 Match -deriving instance Data a => Data (Match a) - -deriving instance Typeable1 RuleBndr -deriving instance Data a => Data (RuleBndr a) - --- Typeable2 - -deriving instance Typeable2 HsBindLR -deriving instance (Data a,Data b) => Data (HsBindLR a b) - -deriving instance Typeable2 StmtLR -deriving instance (Data a,Data b) => Data (StmtLR a b) - -deriving instance Typeable2 HsLocalBindsLR -deriving instance (Data a,Data b) => Data (HsLocalBindsLR a b) - -deriving instance Typeable2 HsValBindsLR -deriving instance (Data a,Data b) => Data (HsValBindsLR a b) - -deriving instance Typeable2 HsConDetails -deriving instance (Data a,Data b) => Data (HsConDetails a b) - -deriving instance Typeable2 HsRecFields -deriving instance (Data a,Data b) => Data (HsRecFields a b) - -deriving instance Typeable2 HsRecField -deriving instance (Data a,Data b) => Data (HsRecField a b) - -#ifdef HAS_ANNOTATIONS -deriving instance Data a => Data (AnnDecl a) -deriving instance Typeable1 AnnDecl - -deriving instance Data a => Data (AnnProvenance a) -deriving instance Typeable1 AnnProvenance -#endif - -#endif - +{- | "GHC.Syb.Instances" provides instances of Data\/Typeable+ for Ghc Api types, using standalone deriving.++Most instances are standard; to provide 'Data' instances +abstract types, we use one of two schemes:++- no traversal: 'SrcSpan', 'Module', 'ModuleName', 'OccName', 'Name', + 'FastString', 'DataCon', 'Var', 'TyCon', 'Class'++@+ abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix+ abstractDataType n = mkDataType n [abstractConstr n]+@++@+ instance Data SrcSpan where+ -- don't traverse?+ toConstr _ = abstractConstr "SrcSpan"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "SrcSpan"+@++- abstract traversal: 'NameSet', 'Bag'++@+ instance Data NameSet where+ gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly+ toConstr _ = abstractConstr "NameSet"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "NameSet"+@++Please report any issues, either with these abstract instances or with+these modules going out of sync with GHC head, to the package maintainer.++-}+module GHC.SYB.Instances where++import GHC hiding(TyCon)+import SrcLoc+import RdrName+import OccName+import FastString+import Bag+import Module+import BasicTypes+import Var+import ForeignCall++import Data.Data+import NameSet+import TypeRep+import qualified TyCon++#include "Typeable.h"++#ifdef __HADDOCK__+#else++-- TODO: good for generalized show, but is this sound in general?+abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix+abstractDataType n = mkDataType n [abstractConstr n]++-- Typeable0++INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")+instance Data SrcSpan where+ -- don't traverse?+ toConstr _ = abstractConstr "SrcSpan"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "SrcSpan"++INSTANCE_TYPEABLE0(Module,moduleTc,"Module")+instance Data Module where+ -- don't traverse?+ toConstr _ = abstractConstr "Module"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "Module"++INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")+instance Data ModuleName where+ -- don't traverse?+ toConstr _ = abstractConstr "ModuleName"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "ModuleName"++deriving instance Typeable RdrName+deriving instance Data RdrName++INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")+instance Data OccName where+ -- don't traverse?+ toConstr _ = abstractConstr "OccName"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "OccName"++INSTANCE_TYPEABLE0(Name,nameTc,"Name")+instance Data Name where+ -- don't traverse?+ toConstr _ = abstractConstr "Name"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "Name"++deriving instance Typeable FastString+instance Data FastString where+ -- don't traverse?+ toConstr _ = abstractConstr "FastString"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "FastString"++deriving instance Typeable HsExplicitForAll+deriving instance Data HsExplicitForAll++deriving instance Typeable HsBang+deriving instance Data HsBang++deriving instance Typeable Boxity+deriving instance Data Boxity++deriving instance Typeable OverLitVal+deriving instance Data OverLitVal++deriving instance Typeable RecFlag+deriving instance Data RecFlag++deriving instance Typeable BasicTypes.Fixity+deriving instance Data BasicTypes.Fixity++deriving instance Typeable HsArrAppType+deriving instance Data HsArrAppType++deriving instance Typeable FixityDirection+deriving instance Data FixityDirection++INSTANCE_TYPEABLE0(DataCon,dataConTc,"DataCon")+instance Data DataCon where+ -- don't traverse?+ toConstr _ = abstractConstr "DataCon"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "DataCon"++INSTANCE_TYPEABLE0(Var,varTc,"Var")+instance Data Var where+ -- don't traverse?+ toConstr _ = abstractConstr "Var"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "Var"++deriving instance Typeable InlineSpec+deriving instance Data InlineSpec++#ifdef CONSTRUCTOR_LIKE_IDS+deriving instance Typeable InlinePragma+deriving instance Data InlinePragma++deriving instance Typeable RuleMatchInfo+deriving instance Data RuleMatchInfo+#endif++deriving instance Typeable ForeignImport+deriving instance Data ForeignImport++deriving instance Typeable ForeignExport+deriving instance Data ForeignExport++deriving instance Typeable CImportSpec+deriving instance Data CImportSpec++deriving instance Typeable CExportSpec+deriving instance Data CExportSpec++deriving instance Typeable DNCallSpec+deriving instance Data DNCallSpec++deriving instance Typeable Safety+deriving instance Data Safety++deriving instance Typeable CCallConv+deriving instance Data CCallConv++deriving instance Typeable DNKind+deriving instance Data DNKind++deriving instance Typeable DNType+deriving instance Data DNType++deriving instance Typeable CCallTarget+deriving instance Data CCallTarget++deriving instance Typeable Activation+deriving instance Data Activation++INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet")+instance Data NameSet where+ gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly+ toConstr _ = abstractConstr "NameSet"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "NameSet"++deriving instance Typeable FoType+deriving instance Data FoType++deriving instance Typeable FamilyFlavour+deriving instance Data FamilyFlavour++deriving instance Typeable NewOrData+deriving instance Data NewOrData++INSTANCE_TYPEABLE0(TyCon.TyCon,tyConTc,"TyCon")+instance Data TyCon.TyCon where+ -- don't traverse?+ toConstr _ = abstractConstr "TyCon.TyCon"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "TyCon.TyCon"++INSTANCE_TYPEABLE0(Class,classTc,"Class")+instance Data Class where+ -- don't traverse?+ toConstr _ = abstractConstr "Class"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "Class"++deriving instance Typeable Prag+deriving instance Data Prag++deriving instance Typeable HsWrapper+deriving instance Data HsWrapper++deriving instance Typeable PredType+deriving instance Data PredType++deriving instance Typeable Type+deriving instance Data Type++deriving instance Typeable HsLit+deriving instance Data HsLit++-- Typeable1++deriving instance Typeable1 Located+deriving instance Data e => Data (Located e)++deriving instance Typeable1 HsModule+deriving instance Data a => Data (HsModule a)++deriving instance Typeable1 HsDoc+deriving instance Data a => Data (HsDoc a)++deriving instance Typeable1 HaddockModInfo+deriving instance Data a => Data (HaddockModInfo a)++deriving instance Typeable1 HsDecl+deriving instance Data a => Data (HsDecl a)++deriving instance Typeable1 ImportDecl+deriving instance Data a => Data (ImportDecl a)++deriving instance Typeable1 IE+deriving instance Data a => Data (IE a)++deriving instance Typeable1 TyClDecl+deriving instance Data a => Data (TyClDecl a)++deriving instance Typeable1 DocDecl+deriving instance Data a => Data (DocDecl a)++deriving instance Typeable1 SpliceDecl+deriving instance Data a => Data (SpliceDecl a)++deriving instance Typeable1 RuleDecl+deriving instance Data a => Data (RuleDecl a)++deriving instance Typeable WarningTxt+deriving instance Data WarningTxt++deriving instance Typeable1 WarnDecl+deriving instance Data a => Data (WarnDecl a)++deriving instance Typeable1 ForeignDecl+deriving instance Data a => Data (ForeignDecl a)++deriving instance Typeable1 DefaultDecl+deriving instance Data a => Data (DefaultDecl a)++deriving instance Typeable1 Sig+deriving instance Data a => Data (Sig a)++deriving instance Typeable1 DerivDecl+deriving instance Data a => Data (DerivDecl a)++deriving instance Typeable1 InstDecl+deriving instance Data a => Data (InstDecl a)++deriving instance Typeable1 HsPred+deriving instance Data a => Data (HsPred a)++deriving instance Typeable1 HsType+deriving instance Data a => Data (HsType a)++deriving instance Typeable1 ConDecl+deriving instance Data a => Data (ConDecl a)++INSTANCE_TYPEABLE1(Bag,bagTc,"Bag")+instance Data a => Data (Bag a) where+ gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly+ toConstr _ = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"+ gunfold _ _ = error "gunfold"+ dataTypeOf _ = mkNorepType "Bag"++deriving instance Typeable1 HsTyVarBndr+deriving instance Data a => Data (HsTyVarBndr a)++deriving instance Typeable1 ResType+deriving instance Data a => Data (ResType a)++deriving instance Typeable1 HsSplice+deriving instance Data a => Data (HsSplice a)++deriving instance Typeable1 ConDeclField+deriving instance Data a => Data (ConDeclField a)++deriving instance Typeable1 IPName+deriving instance Data a => Data (IPName a)++deriving instance Typeable1 MatchGroup+deriving instance Data a => Data (MatchGroup a)++deriving instance Typeable1 Pat+deriving instance Data a => Data (Pat a)++deriving instance Typeable1 GRHSs+deriving instance Data a => Data (GRHSs a)++deriving instance Typeable1 HsExpr+deriving instance Data a => Data (HsExpr a)++deriving instance Typeable1 HsQuasiQuote+deriving instance Data a => Data (HsQuasiQuote a)++deriving instance Typeable1 HsOverLit+deriving instance Data a => Data (HsOverLit a)++deriving instance Typeable1 ArithSeqInfo+deriving instance Data a => Data (ArithSeqInfo a)++deriving instance Typeable1 HsBracket+deriving instance Data a => Data (HsBracket a)++deriving instance Typeable1 HsCmdTop+deriving instance Data a => Data (HsCmdTop a)++deriving instance Typeable1 HsGroup+deriving instance Data a => Data (HsGroup a)++deriving instance Typeable1 FixitySig+deriving instance Data a => Data (FixitySig a)++deriving instance Typeable1 HsIPBinds+deriving instance Data a => Data (HsIPBinds a)++deriving instance Typeable1 IPBind+deriving instance Data a => Data (IPBind a)++deriving instance Typeable1 GroupByClause+deriving instance Data a => Data (GroupByClause a)++deriving instance Typeable1 HsStmtContext+deriving instance Data a => Data (HsStmtContext a)++deriving instance Typeable1 HsMatchContext+deriving instance Data a => Data (HsMatchContext a)++deriving instance Typeable1 GRHS+deriving instance Data a => Data (GRHS a)++deriving instance Typeable1 Match+deriving instance Data a => Data (Match a)++deriving instance Typeable1 RuleBndr+deriving instance Data a => Data (RuleBndr a)++-- Typeable2++deriving instance Typeable2 HsBindLR+deriving instance (Data a,Data b) => Data (HsBindLR a b)++deriving instance Typeable2 StmtLR+deriving instance (Data a,Data b) => Data (StmtLR a b)++deriving instance Typeable2 HsLocalBindsLR+deriving instance (Data a,Data b) => Data (HsLocalBindsLR a b)++deriving instance Typeable2 HsValBindsLR+deriving instance (Data a,Data b) => Data (HsValBindsLR a b)++deriving instance Typeable2 HsConDetails+deriving instance (Data a,Data b) => Data (HsConDetails a b)++deriving instance Typeable2 HsRecFields+deriving instance (Data a,Data b) => Data (HsRecFields a b)++deriving instance Typeable2 HsRecField+deriving instance (Data a,Data b) => Data (HsRecField a b)++#ifdef HAS_ANNOTATIONS+deriving instance Data a => Data (AnnDecl a)+deriving instance Typeable1 AnnDecl++deriving instance Data a => Data (AnnProvenance a)+deriving instance Typeable1 AnnProvenance+#endif++#endif +
src/GHC/SYB/Utils.hs view
@@ -1,257 +1,257 @@-{- | "GHC.Syb.Utils" provides common utilities for the Ghc Api, - either based on Data\/Typeable or for use with Data.Generics - over Ghc Api types. - -example output of 'showData' on 'parsedSource', 'renamedSource', and -'typecheckedSource' for a trivial @HelloWorld@ module, compared with -'ppr' output: - -@ -------------------------- pretty-printed parsedSource -module HelloWorld where -main = putStrLn "Hello, World!" -------------------------- pretty-printed renamedSource -Just (HelloWorld.main = System.IO.putStrLn "Hello, World!", - [import Prelude], - Nothing, - Nothing, - -(HaddockModInfo - (Nothing) - (Nothing) - (Nothing) - (Nothing))) -------------------------- pretty-printed typecheckedSource -Just <AbsBinds [] [] [HelloWorld.main <= [] main] - HelloWorld.main :: GHC.IOBase.IO () - [] - { main = System.IO.putStrLn "Hello, World!" }> -------------------------- shown parsedSource - -(L {HelloWorld.hs:1:0} - (HsModule - (Just - (L {HelloWorld.hs:1:7-16} {ModuleName: HelloWorld})) - (Nothing) - [] - [ - (L {HelloWorld.hs:2:0-30} - (ValD - (FunBind - (L {HelloWorld.hs:2:0-3} - (Unqual {OccName: main})) - (False) - (MatchGroup - [ - (L {HelloWorld.hs:2:0-30} - (Match - [] - (Nothing) - (GRHSs - [ - (L {HelloWorld.hs:2:7-30} - (GRHS - [] - (L {HelloWorld.hs:2:7-30} - (HsApp - (L {HelloWorld.hs:2:7-14} - (HsVar - (Unqual {OccName: putStrLn}))) - (L {HelloWorld.hs:2:16-30} - (HsLit - (HsString {FastString: "Hello, World!"})))))))] - (EmptyLocalBinds))))] {!type placeholder here?!}) - (WpHole) {!NameSet placeholder here!} - (Nothing))))] - (Nothing) - (HaddockModInfo - (Nothing) - (Nothing) - (Nothing) - (Nothing)) - (Nothing))) -------------------------- shown renamedSource - -((,,,,) - (HsGroup - (ValBindsOut - [ - ((,) - (NonRecursive) {Bag(Located (HsBind Name)): - [ - (L {HelloWorld.hs:2:0-30} - (FunBind - (L {HelloWorld.hs:2:0-3} {Name: HelloWorld.main}) - (False) - (MatchGroup - [ - (L {HelloWorld.hs:2:0-30} - (Match - [] - (Nothing) - (GRHSs - [ - (L {HelloWorld.hs:2:7-30} - (GRHS - [] - (L {HelloWorld.hs:2:7-30} - (HsApp - (L {HelloWorld.hs:2:7-14} - (HsVar {Name: System.IO.putStrLn})) - (L {HelloWorld.hs:2:16-30} - (HsLit - (HsString {FastString: "Hello, World!"})))))))] - (EmptyLocalBinds))))] {!type placeholder here?!}) - (WpHole) {NameSet: - [{Name: System.IO.putStrLn}]} - (Nothing)))]})] - []) - [] - [] - [] - [] - [] - [] - [] - [] - []) - [ - (L {Implicit import declaration} - (ImportDecl - (L {Implicit import declaration} {ModuleName: Prelude}) - (False) - (False) - (Nothing) - (Nothing)))] - (Nothing) - (Nothing) - (HaddockModInfo - (Nothing) - (Nothing) - (Nothing) - (Nothing))) -------------------------- shown typecheckedSource -{Bag(Located (HsBind Var)): -[ - (L {HelloWorld.hs:2:0-30} - (AbsBinds - [] - [] - [ - ((,,,) - [] {Var: HelloWorld.main} {Var: main} - [])] {Bag(Located (HsBind Var)): - [ - (L {HelloWorld.hs:2:0-30} - (FunBind - (L {HelloWorld.hs:2:0-3} {Var: main}) - (False) - (MatchGroup - [ - (L {HelloWorld.hs:2:0-30} - (Match - [] - (Nothing) - (GRHSs - [ - (L {HelloWorld.hs:2:7-30} - (GRHS - [] - (L {HelloWorld.hs:2:7-30} - (HsApp - (L {HelloWorld.hs:2:7-14} - (HsVar {Var: System.IO.putStrLn})) - (L {HelloWorld.hs:2:16-30} - (HsLit - (HsString {FastString: "Hello, World!"})))))))] - (EmptyLocalBinds))))] GHC.IOBase.IO ()) - (WpHole) {!NameSet placeholder here!} - (Nothing)))]}))]} -@ --} -module GHC.SYB.Utils where - -import Data.Generics - --- import qualified GHC.Paths -import PprTyThing -import DynFlags -import GHC -import Outputable -import SrcLoc -import qualified OccName(occNameString) -import Bag(Bag,bagToList) -import Var(Var) -import FastString(FastString) -import NameSet(NameSet,nameSetToList) - -import GHC.SYB.Instances -import Data.List - --- | Ghc Ast types tend to have undefined holes, to be filled --- by later compiler phases. We tag Asts with their source, --- so that we can avoid such holes based on who generated the Asts. -data Stage = Parser | Renamer | TypeChecker deriving (Eq,Ord,Show) - --- | Generic Data-based show, with special cases for GHC Ast types, --- and simplistic indentation-based layout (the 'Int' parameter); --- showing abstract types abstractly and avoiding known potholes --- (based on the 'Stage' that generated the Ast) -showData :: Data a => Stage -> Int -> a -> String -showData stage n = - generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan - `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon - `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet - `extQ` postTcType `extQ` fixity - where generic :: Data a => a -> String - generic t = indent n ++ "(" ++ showConstr (toConstr t) - ++ space (concat (intersperse " " (gmapQ (showData stage (n+1)) t))) ++ ")" - space "" = "" - space s = ' ':s - indent n = "\n" ++ replicate n ' ' - string = show :: String -> String - fastString = ("{FastString: "++) . (++"}") . show :: FastString -> String - list l = indent n ++ "[" - ++ concat (intersperse "," (map (showData stage (n+1)) l)) ++ "]" - - name = ("{Name: "++) . (++"}") . showSDoc . ppr :: Name -> String - occName = ("{OccName: "++) . (++"}") . OccName.occNameString - moduleName = ("{ModuleName: "++) . (++"}") . showSDoc . ppr :: ModuleName -> String - srcSpan = ("{"++) . (++"}") . showSDoc . ppr :: SrcSpan -> String - var = ("{Var: "++) . (++"}") . showSDoc . ppr :: Var -> String - dataCon = ("{DataCon: "++) . (++"}") . showSDoc . ppr :: DataCon -> String - - bagRdrName:: Bag (Located (HsBind RdrName)) -> String - bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . bagToList - bagName :: Bag (Located (HsBind Name)) -> String - bagName = ("{Bag(Located (HsBind Name)): "++) . (++"}") . list . bagToList - bagVar :: Bag (Located (HsBind Var)) -> String - bagVar = ("{Bag(Located (HsBind Var)): "++) . (++"}") . list . bagToList - - nameSet | stage `elem` [Parser,TypeChecker] - = const ("{!NameSet placeholder here!}") :: NameSet -> String - | otherwise - = ("{NameSet: "++) . (++"}") . list . nameSetToList - - postTcType | stage<TypeChecker = const "{!type placeholder here?!}" :: PostTcType -> String - | otherwise = showSDoc . ppr :: Type -> String - - fixity | stage<Renamer = const "{!fixity placeholder here?!}" :: GHC.Fixity -> String - | otherwise = ("{Fixity: "++) . (++"}") . showSDoc . ppr :: GHC.Fixity -> String - --- | Like 'everything', but avoid known potholes, based on the 'Stage' that --- generated the Ast. -everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r -everythingStaged stage k z f x - | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z - | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x) - where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool - postTcType = const (stage<TypeChecker) :: PostTcType -> Bool - fixity = const (stage<Renamer) :: GHC.Fixity -> Bool - --- | A variation of 'everything', using a 'GenericQ Bool' to skip --- parts of the input 'Data'. -everythingBut :: GenericQ Bool -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r -everythingBut q k z f x - | q x = z - | otherwise = foldl k (f x) (gmapQ (everythingBut q k z f) x) +{- | "GHC.Syb.Utils" provides common utilities for the Ghc Api,+ either based on Data\/Typeable or for use with Data.Generics+ over Ghc Api types.++example output of 'showData' on 'parsedSource', 'renamedSource', and+'typecheckedSource' for a trivial @HelloWorld@ module, compared with+'ppr' output:++@+------------------------- pretty-printed parsedSource+module HelloWorld where+main = putStrLn "Hello, World!"+------------------------- pretty-printed renamedSource+Just (HelloWorld.main = System.IO.putStrLn "Hello, World!",+ [import Prelude],+ Nothing,+ Nothing,++(HaddockModInfo+ (Nothing)+ (Nothing)+ (Nothing)+ (Nothing)))+------------------------- pretty-printed typecheckedSource+Just <AbsBinds [] [] [HelloWorld.main <= [] main]+ HelloWorld.main :: GHC.IOBase.IO ()+ []+ { main = System.IO.putStrLn "Hello, World!" }>+------------------------- shown parsedSource++(L {HelloWorld.hs:1:0}+ (HsModule+ (Just+ (L {HelloWorld.hs:1:7-16} {ModuleName: HelloWorld}))+ (Nothing)+ []+ [+ (L {HelloWorld.hs:2:0-30}+ (ValD+ (FunBind+ (L {HelloWorld.hs:2:0-3}+ (Unqual {OccName: main}))+ (False)+ (MatchGroup+ [+ (L {HelloWorld.hs:2:0-30}+ (Match+ []+ (Nothing)+ (GRHSs+ [+ (L {HelloWorld.hs:2:7-30}+ (GRHS+ []+ (L {HelloWorld.hs:2:7-30}+ (HsApp+ (L {HelloWorld.hs:2:7-14}+ (HsVar+ (Unqual {OccName: putStrLn})))+ (L {HelloWorld.hs:2:16-30}+ (HsLit+ (HsString {FastString: "Hello, World!"})))))))]+ (EmptyLocalBinds))))] {!type placeholder here?!})+ (WpHole) {!NameSet placeholder here!}+ (Nothing))))]+ (Nothing)+ (HaddockModInfo+ (Nothing)+ (Nothing)+ (Nothing)+ (Nothing))+ (Nothing)))+------------------------- shown renamedSource++((,,,,)+ (HsGroup+ (ValBindsOut+ [+ ((,)+ (NonRecursive) {Bag(Located (HsBind Name)):+ [+ (L {HelloWorld.hs:2:0-30}+ (FunBind+ (L {HelloWorld.hs:2:0-3} {Name: HelloWorld.main})+ (False)+ (MatchGroup+ [+ (L {HelloWorld.hs:2:0-30}+ (Match+ []+ (Nothing)+ (GRHSs+ [+ (L {HelloWorld.hs:2:7-30}+ (GRHS+ []+ (L {HelloWorld.hs:2:7-30}+ (HsApp+ (L {HelloWorld.hs:2:7-14}+ (HsVar {Name: System.IO.putStrLn}))+ (L {HelloWorld.hs:2:16-30}+ (HsLit+ (HsString {FastString: "Hello, World!"})))))))]+ (EmptyLocalBinds))))] {!type placeholder here?!})+ (WpHole) {NameSet:+ [{Name: System.IO.putStrLn}]}+ (Nothing)))]})]+ [])+ []+ []+ []+ []+ []+ []+ []+ []+ [])+ [+ (L {Implicit import declaration}+ (ImportDecl+ (L {Implicit import declaration} {ModuleName: Prelude})+ (False)+ (False)+ (Nothing)+ (Nothing)))]+ (Nothing)+ (Nothing)+ (HaddockModInfo+ (Nothing)+ (Nothing)+ (Nothing)+ (Nothing)))+------------------------- shown typecheckedSource+{Bag(Located (HsBind Var)):+[+ (L {HelloWorld.hs:2:0-30}+ (AbsBinds+ []+ []+ [+ ((,,,)+ [] {Var: HelloWorld.main} {Var: main}+ [])] {Bag(Located (HsBind Var)):+ [+ (L {HelloWorld.hs:2:0-30}+ (FunBind+ (L {HelloWorld.hs:2:0-3} {Var: main})+ (False)+ (MatchGroup+ [+ (L {HelloWorld.hs:2:0-30}+ (Match+ []+ (Nothing)+ (GRHSs+ [+ (L {HelloWorld.hs:2:7-30}+ (GRHS+ []+ (L {HelloWorld.hs:2:7-30}+ (HsApp+ (L {HelloWorld.hs:2:7-14}+ (HsVar {Var: System.IO.putStrLn}))+ (L {HelloWorld.hs:2:16-30}+ (HsLit+ (HsString {FastString: "Hello, World!"})))))))]+ (EmptyLocalBinds))))] GHC.IOBase.IO ())+ (WpHole) {!NameSet placeholder here!}+ (Nothing)))]}))]}+@+-}+module GHC.SYB.Utils where++import Data.Generics++-- import qualified GHC.Paths+import PprTyThing+import DynFlags+import GHC+import Outputable+import SrcLoc+import qualified OccName(occNameString)+import Bag(Bag,bagToList)+import Var(Var)+import FastString(FastString)+import NameSet(NameSet,nameSetToList)++import GHC.SYB.Instances+import Data.List++-- | Ghc Ast types tend to have undefined holes, to be filled+-- by later compiler phases. We tag Asts with their source,+-- so that we can avoid such holes based on who generated the Asts.+data Stage = Parser | Renamer | TypeChecker deriving (Eq,Ord,Show)++-- | Generic Data-based show, with special cases for GHC Ast types,+-- and simplistic indentation-based layout (the 'Int' parameter); +-- showing abstract types abstractly and avoiding known potholes +-- (based on the 'Stage' that generated the Ast)+showData :: Data a => Stage -> Int -> a -> String+showData stage n = + generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan + `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon+ `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet+ `extQ` postTcType `extQ` fixity+ where generic :: Data a => a -> String+ generic t = indent n ++ "(" ++ showConstr (toConstr t)+ ++ space (concat (intersperse " " (gmapQ (showData stage (n+1)) t))) ++ ")"+ space "" = ""+ space s = ' ':s+ indent n = "\n" ++ replicate n ' ' + string = show :: String -> String+ fastString = ("{FastString: "++) . (++"}") . show :: FastString -> String+ list l = indent n ++ "[" + ++ concat (intersperse "," (map (showData stage (n+1)) l)) ++ "]"++ name = ("{Name: "++) . (++"}") . showSDoc . ppr :: Name -> String+ occName = ("{OccName: "++) . (++"}") . OccName.occNameString + moduleName = ("{ModuleName: "++) . (++"}") . showSDoc . ppr :: ModuleName -> String+ srcSpan = ("{"++) . (++"}") . showSDoc . ppr :: SrcSpan -> String+ var = ("{Var: "++) . (++"}") . showSDoc . ppr :: Var -> String+ dataCon = ("{DataCon: "++) . (++"}") . showSDoc . ppr :: DataCon -> String++ bagRdrName:: Bag (Located (HsBind RdrName)) -> String+ bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . bagToList + bagName :: Bag (Located (HsBind Name)) -> String+ bagName = ("{Bag(Located (HsBind Name)): "++) . (++"}") . list . bagToList + bagVar :: Bag (Located (HsBind Var)) -> String+ bagVar = ("{Bag(Located (HsBind Var)): "++) . (++"}") . list . bagToList ++ nameSet | stage `elem` [Parser,TypeChecker] + = const ("{!NameSet placeholder here!}") :: NameSet -> String+ | otherwise + = ("{NameSet: "++) . (++"}") . list . nameSetToList ++ postTcType | stage<TypeChecker = const "{!type placeholder here?!}" :: PostTcType -> String+ | otherwise = showSDoc . ppr :: Type -> String++ fixity | stage<Renamer = const "{!fixity placeholder here?!}" :: GHC.Fixity -> String+ | otherwise = ("{Fixity: "++) . (++"}") . showSDoc . ppr :: GHC.Fixity -> String++-- | Like 'everything', but avoid known potholes, based on the 'Stage' that+-- generated the Ast.+everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r+everythingStaged stage k z f x + | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z+ | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x)+ where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool+ postTcType = const (stage<TypeChecker) :: PostTcType -> Bool+ fixity = const (stage<Renamer) :: GHC.Fixity -> Bool++-- | A variation of 'everything', using a 'GenericQ Bool' to skip+-- parts of the input 'Data'.+everythingBut :: GenericQ Bool -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r+everythingBut q k z f x + | q x = z+ | otherwise = foldl k (f x) (gmapQ (everythingBut q k z f) x)