\end{itemize}
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module BasicTypes(
Version, bumpVersion, initialVersion,
import FastString
import Outputable
+
+import Data.Data hiding (Fixity)
\end{code}
%************************************************************************
\begin{code}
data FunctionOrData = IsFunction | IsData
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Data, Typeable)
instance Outputable FunctionOrData where
ppr IsFunction = text "(function)"
-- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt = WarningTxt [FastString]
| DeprecatedTxt [FastString]
- deriving Eq
+ deriving (Eq, Data, Typeable)
instance Outputable WarningTxt where
ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
\begin{code}
newtype IPName name = IPName name -- ?x
- deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map
- -- (used in HscTypes.OrigIParamCache)
+ deriving( Eq, Ord, Data, Typeable )
+ -- Ord is used in the IP name cache finite map
+ -- (used in HscTypes.OrigIParamCache)
ipNameName :: IPName name -> name
ipNameName (IPName n) = n
\begin{code}
------------------------
data Fixity = Fixity Int FixityDirection
+ deriving (Data, Typeable)
instance Outputable Fixity where
ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
------------------------
data FixityDirection = InfixL | InfixR | InfixN
- deriving(Eq)
+ deriving (Eq, Data, Typeable)
instance Outputable FixityDirection where
ppr InfixL = ptext (sLit "infixl")
data Boxity
= Boxed
| Unboxed
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
isBoxed :: Boxity -> Bool
isBoxed Boxed = True
\begin{code}
data RecFlag = Recursive
| NonRecursive
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
isRec :: RecFlag -> Bool
isRec Recursive = True
| AlwaysActive
| ActiveBefore CompilerPhase -- Active only *before* this phase
| ActiveAfter CompilerPhase -- Active in this phase and later
- deriving( Eq ) -- Eq used in comparing rules in HsDecls
+ deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
| FunLike
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
data InlinePragma -- Note [InlinePragma]
= InlinePragma
-- explicit (non-type, non-dictionary) args
, inl_act :: Activation -- Says during which phases inlining is allowed
, inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
- } deriving( Eq )
+ } deriving( Eq, Data, Typeable )
\end{code}
Note [InlinePragma]
import FastString
import Module
+import qualified Data.Data as Data
import Data.Char
import Data.Word
import Data.List ( partition )
instance Show DataCon where
showsPrec p con = showsPrecSDoc p (ppr con)
+
+instance Data.Typeable DataCon where
+ typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
+
+instance Data.Data DataCon where
+ -- don't traverse?
+ toConstr _ = abstractConstr "DataCon"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "DataCon"
\end{code}
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module Literal
(
import Data.Ratio
import Data.Word
import Data.Char
+import Data.Data
\end{code}
-- the label expects. Only applicable with
-- @stdcall@ labels. @Just x@ => @\<x\>@ will
-- be appended to label name when emitting assembly.
+ deriving (Data, Typeable)
\end{code}
Binary instance
emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
) where
+#include "Typeable.h"
+
import Config
import Outputable
import qualified Pretty
import Binary
import Util
+import Data.Data
import System.FilePath
\end{code}
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
+INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
+
+instance Data ModuleName where
+ -- don't traverse?
+ toConstr _ = abstractConstr "ModuleName"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "ModuleName"
+
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
-- ^ Compares module names lexically, rather than by their 'Unique's
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
put_ bh (Module p n) = put_ bh p >> put_ bh n
get bh = do p <- get bh; n <- get bh; return (Module p n)
+INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
+
+instance Data Module where
+ -- don't traverse?
+ toConstr _ = abstractConstr "Module"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "Module"
+
-- | This gives a stable ordering, as opposed to the Ord instance which
-- gives an ordering based on the 'Unique's of the components, which may
-- not be stable from run to run of the compiler.
instance Ord PackageId where
nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
+INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
+
+instance Data PackageId where
+ -- don't traverse?
+ toConstr _ = abstractConstr "PackageId"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "PackageId"
+
stablePackageIdCmp :: PackageId -> PackageId -> Ordering
-- ^ Compares package ids lexically, rather than by their 'Unique's
stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
module OccName
) where
+#include "Typeable.h"
+
import {-# SOURCE #-} TypeRep( TyThing )
import OccName
import Module
import SrcLoc
import Unique
+import Util
import Maybes
import Binary
import StaticFlags
import Outputable
import Data.Array
+import Data.Data
import Data.Word ( Word32 )
\end{code}
instance NamedThing Name where
getName n = n
+
+INSTANCE_TYPEABLE0(Name,nameTc,"Name")
+
+instance Data Name where
+ -- don't traverse?
+ toConstr _ = abstractConstr "Name"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "Name"
\end{code}
%************************************************************************
) where
#include "HsVersions.h"
+#include "Typeable.h"
import Name
import UniqSet
+import Util
+
+import Data.Data
\end{code}
%************************************************************************
\begin{code}
type NameSet = UniqSet Name
+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"
+
emptyNameSet :: NameSet
unitNameSet :: Name -> NameSet
addListToNameSet :: NameSet -> [Name] -> NameSet
startsVarSym, startsVarId, startsConSym, startsConId
) where
+#include "Typeable.h"
+
import Util
import Unique
import BasicTypes
import Binary
import StaticFlags( opt_SuppressUniques )
import Data.Char
+import Data.Data
\end{code}
\begin{code}
-- Compares lexicographically, *not* by Unique of the string
compare (OccName sp1 s1) (OccName sp2 s2)
= (s1 `compare` s2) `thenCmp` (sp1 `compare` sp2)
+
+INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")
+
+instance Data OccName where
+ -- don't traverse?
+ toConstr _ = abstractConstr "OccName"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "OccName"
\end{code}
%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- #name_types#
import FastString
import Outputable
import Util
+
+import Data.Data
\end{code}
%************************************************************************
-- (2) By Template Haskell, when TH has generated a unique name
--
-- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
+ deriving (Data, Typeable)
\end{code}
spans, isSubspanOf
) where
+#include "Typeable.h"
+
import Util
import Outputable
import FastString
import Data.Bits
+import Data.Data
\end{code}
%************************************************************************
char '\"', pprFastFilePath src_path, text " #-}"]
ppr (UnhelpfulLoc s) = ftext s
+
+INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")
+
+instance Data SrcSpan where
+ -- don't traverse?
+ toConstr _ = abstractConstr "SrcSpan"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "SrcSpan"
\end{code}
%************************************************************************
\begin{code}
-- | We attach SrcSpans to lots of things, so let's have a datatype for it.
data Located e = L SrcSpan e
+ deriving (Typeable, Data)
unLoc :: Located e -> e
unLoc (L _ e) = e
) where
#include "HsVersions.h"
+#include "Typeable.h"
import {-# SOURCE #-} TypeRep( Type, Kind )
import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails )
import Name hiding (varName)
import Unique
+import Util
import FastTypes
import FastString
import Outputable
+
+import Data.Data
\end{code}
a >= b = realUnique a >=# realUnique b
a > b = realUnique a ># realUnique b
a `compare` b = varUnique a `compare` varUnique b
+
+INSTANCE_TYPEABLE0(Var,varTc,"Var")
+
+instance Data Var where
+ -- don't traverse?
+ toConstr _ = abstractConstr "Var"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "Var"
\end{code}
%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
module CoreSyn (
import Outputable
import Util
+import Data.Data
import Data.Word
infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
-- added to expressions in the syntax tree
| Type Type -- ^ A type: this should only show up at the top
-- level of an Arg
+ deriving (Data, Typeable)
-- | Type synonym for expressions that occur in function argument positions.
-- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
-- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
| LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
| DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Data, Typeable)
-- | Binding, used for top level bindings in a module and local bindings in a @let@.
data Bind b = NonRec b (Expr b)
| Rec [(b, (Expr b))]
+ deriving (Data, Typeable)
\end{code}
-------------------------- CoreSyn INVARIANTS ---------------------------
data Note
= SCC CostCentre -- ^ A cost centre annotation for profiling
| CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
+ deriving (Data, Typeable)
\end{code}
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module HsBinds where
import Var
import Bag
import FastString
+
+import Data.Data hiding ( Fixity )
\end{code}
%************************************************************************
= HsValBinds (HsValBindsLR idL idR)
| HsIPBinds (HsIPBinds idR)
| EmptyLocalBinds
+ deriving (Data, Typeable)
type HsValBinds id = HsValBindsLR id id
-- in the list may depend on earlier
-- ones.
[LSig Name]
+ deriving (Data, Typeable)
type LHsBinds id = Bag (LHsBind id)
type DictBinds id = LHsBinds id -- Used for dictionary or method bindings
-- mixed up together; you can tell the dict bindings because
-- they are all VarBinds
}
+ deriving (Data, Typeable)
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
--
-- Creates bindings for (polymorphic, overloaded) poly_f
[LIPBind id]
(DictBinds id) -- Only in typechecker output; binds
-- uses of the implicit parameters
+ deriving (Data, Typeable)
isEmptyIPBinds :: HsIPBinds id -> Bool
isEmptyIPBinds (IPBinds is ds) = null is && isEmptyBag ds
= IPBind
(IPName id)
(LHsExpr id)
+ deriving (Data, Typeable)
instance (OutputableBndr id) => Outputable (HsIPBinds id) where
ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
-- is always exactly WpHole
| WpLet (LHsBinds Id) -- let binds in []
-- (would be nicer to be core bindings)
+ deriving (Data, Typeable)
instance Outputable HsWrapper where
ppr co_fn = pprHsWrapper (ptext (sLit "<>")) co_fn
-- {-# SPECIALISE instance Eq [Int] #-}
| SpecInstSig (LHsType name) -- (Class tys); should be a specialisation of the
-- current instance decl
+ deriving (Data, Typeable)
type LFixitySig name = Located (FixitySig name)
data FixitySig name = FixitySig (Located name) Fixity
+ deriving (Data, Typeable)
-- TsSpecPrags conveys pragmas from the type checker to the desugarer
data TcSpecPrags
= IsDefaultMethod -- Super-specialised: a default method should
-- be macro-expanded at every call site
| SpecPrags [Located TcSpecPrag]
+ deriving (Data, Typeable)
data TcSpecPrag
= SpecPrag
HsWrapper -- An wrapper, that specialises the polymorphic function
InlinePragma -- Inlining spec for the specialised function
+ deriving (Data, Typeable)
noSpecPrags :: TcSpecPrags
noSpecPrags = SpecPrags []
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
-- | Abstract syntax of global declarations.
--
import FastString
import Control.Monad ( liftM )
+import Data.Data
import Data.Maybe ( isJust )
\end{code}
| SpliceD (SpliceDecl id)
| DocD (DocDecl)
| QuasiQuoteD (HsQuasiQuote id)
+ deriving (Data, Typeable)
-- NB: all top-level fixity decls are contained EITHER
hs_ruleds :: [LRuleDecl id],
hs_docs :: [LDocDecl]
- }
+ } deriving (Data, Typeable)
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
ppr_ds ds = blankLine $$ vcat (map ppr ds)
data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
+ deriving (Data, Typeable)
instance OutputableBndr name => Outputable (SpliceDecl name) where
ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
-- latter for defaults
tcdDocs :: [LDocDecl] -- ^ Haddock docs
}
+ deriving (Data, Typeable)
data NewOrData
= NewType -- ^ @newtype Blah ...@
| DataType -- ^ @data Blah ...@
- deriving( Eq ) -- Needed because Demand derives Eq
+ deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
data FamilyFlavour
= TypeFamily -- ^ @type family ...@
| DataFamily -- ^ @data family ...@
+ deriving (Data, Typeable)
\end{code}
Simple classifiers
-- GADT-style record decl C { blah } :: T a b
-- Remove this when we no longer parse this stuff, and hence do not
-- need to report decprecated use
- }
+ } deriving (Data, Typeable)
type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
= ResTyH98 -- Constructor was declared using Haskell 98 syntax
| ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
-- and here is its result type
+ deriving (Data, Typeable)
instance OutputableBndr name => Outputable (ResType name) where
-- Debugging only
[LSig name] -- User-supplied pragmatic info
[LTyClDecl name]-- Associated types (ie, 'TyData' and
-- 'TySynonym' only)
+ deriving (Data, Typeable)
instance (OutputableBndr name) => Outputable (InstDecl name) where
type LDerivDecl name = Located (DerivDecl name)
data DerivDecl name = DerivDecl (LHsType name)
+ deriving (Data, Typeable)
instance (OutputableBndr name) => Outputable (DerivDecl name) where
ppr (DerivDecl ty)
data DefaultDecl name
= DefaultDecl [LHsType name]
+ deriving (Data, Typeable)
instance (OutputableBndr name)
=> Outputable (DefaultDecl name) where
data ForeignDecl name
= ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
| ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
+ deriving (Data, Typeable)
-- Specification Of an imported external entity in dependence on the calling
-- convention
Safety -- safe or unsafe
FastString -- name of C header
CImportSpec -- details of the C entity
+ deriving (Data, Typeable)
-- details of an external C entity
--
| CFunction CCallTarget -- static or dynamic function
| CWrapper -- wrapper to expose closures
-- (former f.e.d.)
+ deriving (Data, Typeable)
-- specification of an externally exported entity in dependence on the calling
-- convention
--
data ForeignExport = CExport CExportSpec -- contains the calling convention
+ deriving (Data, Typeable)
-- pretty printing of foreign declarations
--
NameSet -- Free-vars from the LHS
(Located (HsExpr name)) -- RHS
NameSet -- Free-vars from the RHS
+ deriving (Data, Typeable)
data RuleBndr name
= RuleBndr (Located name)
| RuleBndrSig (Located name) (LHsType name)
+ deriving (Data, Typeable)
collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
| DocCommentPrev HsDocString
| DocCommentNamed String HsDocString
| DocGroup Int HsDocString
+ deriving (Data, Typeable)
-- Okay, I need to reconstruct the document comments, but for now:
instance Outputable DocDecl where
type LWarnDecl name = Located (WarnDecl name)
data WarnDecl name = Warning name WarningTxt
+ deriving (Data, Typeable)
instance OutputableBndr name => Outputable (WarnDecl name) where
ppr (Warning thing txt)
type LAnnDecl name = Located (AnnDecl name)
data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
+ deriving (Data, Typeable)
instance (OutputableBndr name) => Outputable (AnnDecl name) where
ppr (HsAnnotation provenance expr)
data AnnProvenance name = ValueAnnProvenance name
| TypeAnnProvenance name
| ModuleAnnProvenance
+ deriving (Data, Typeable)
annProvenanceName_maybe :: AnnProvenance name -> Maybe name
annProvenanceName_maybe (ValueAnnProvenance name) = Just name
+{-# LANGUAGE DeriveDataTypeable #-}
+
module HsDoc (
HsDocString(..),
LHsDocString,
import SrcLoc
import FastString
+import Data.Data
+
newtype HsDocString = HsDocString FastString
- deriving (Eq, Show)
+ deriving (Eq, Show, Data, Typeable)
type LHsDocString = Located HsDocString
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- | Abstract Haskell syntax for expressions.
module HsExpr where
import SrcLoc
import Outputable
import FastString
+
+-- libraries:
+import Data.Data hiding (Fixity)
\end{code}
| HsWrap HsWrapper -- TRANSLATION
(HsExpr id)
+ deriving (Data, Typeable)
-- HsTupArg is used for tuple sections
-- (,a,) is represented by ExplicitTuple [Mising ty1, Present a, Missing ty3]
data HsTupArg id
= Present (LHsExpr id) -- The argument
| Missing PostTcType -- The argument is missing, but this is its type
+ deriving (Data, Typeable)
tupArgPresent :: HsTupArg id -> Bool
tupArgPresent (Present {}) = True
type LHsCmd id = LHsExpr id
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
+ deriving (Data, Typeable)
\end{code}
The legal constructors for commands are:
PostTcType -- return type of the command
(SyntaxTable id) -- after type checking:
-- names used in the command's desugaring
+ deriving (Data, Typeable)
\end{code}
%************************************************************************
PostTcType -- The type is the type of the entire group
-- t1 -> ... -> tn -> tr
-- where there are n patterns
+ deriving (Data, Typeable)
type LMatch id = Located (Match id)
(Maybe (LHsType id)) -- A type signature for the result of the match
-- Nothing after typechecking
(GRHSs id)
+ deriving (Data, Typeable)
isEmptyMatchGroup :: MatchGroup id -> Bool
isEmptyMatchGroup (MatchGroup ms _) = null ms
= GRHSs {
grhssGRHSs :: [LGRHS id], -- ^ Guarded RHSs
grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
- }
+ } deriving (Data, Typeable)
type LGRHS id = Located (GRHS id)
-- | Guarded Right Hand Side.
data GRHS id = GRHS [LStmt id] -- Guards
(LHsExpr id) -- Right hand side
+ deriving (Data, Typeable)
\end{code}
We know the list must have at least one @Match@ in it.
, recS_dicts :: DictBinds idR -- Method bindings of Ids bound by the
-- RecStmt, and used afterwards
}
+ deriving (Data, Typeable)
\end{code}
Note [GroupStmt binder map]
data HsSplice id = HsSplice -- $z or $(f 4)
id -- The id is just a unique name to
(LHsExpr id) -- identify this splice point
+ deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsSplice id) where
ppr = pprSplice
| DecBrG (HsGroup id) -- [d| decls |]; result of renamer
| TypBr (LHsType id) -- [t| type |]
| VarBr id -- 'x, ''T
+ deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsBracket id) where
ppr = pprHsBracket
| FromThenTo (LHsExpr id)
(LHsExpr id)
(LHsExpr id)
+ deriving (Data, Typeable)
\end{code}
\begin{code}
-- runtime error message to generate]
| StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
| ThPatQuote -- A Template Haskell pattern quotation [p| (a,b) |]
- deriving ()
+ deriving (Data, Typeable)
data HsStmtContext id
= ListComp
| PatGuard (HsMatchContext id) -- Pattern guard for specified thing
| ParStmtCtxt (HsStmtContext id) -- A branch of a parallel stmt
| TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
+ deriving (Data, Typeable)
\end{code}
\begin{code}
import SrcLoc ( Located )
import Outputable ( SDoc, OutputableBndr )
import {-# SOURCE #-} HsPat ( LPat )
+
+import Data.Data
data HsExpr i
data HsSplice i
data MatchGroup a
data GRHSs a
+instance Data i => Data (HsSplice i)
+instance Data i => Data (HsExpr i)
+instance Data i => Data (MatchGroup i)
+instance Data i => Data (GRHSs i)
+
type LHsExpr a = Located (HsExpr a)
type SyntaxExpr a = HsExpr a
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module HsImpExp where
import Outputable
import FastString
import SrcLoc ( Located(..) )
+
+import Data.Data
\end{code}
%************************************************************************
ideclQualified :: Bool, -- ^ True => qualified
ideclAs :: Maybe ModuleName, -- ^ as Module
ideclHiding :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names)
- }
+ } deriving (Data, Typeable)
\end{code}
\begin{code}
| IEGroup Int HsDocString -- ^ Doc section heading
| IEDoc HsDocString -- ^ Some documentation
| IEDocNamed String -- ^ Reference to named doc
+ deriving (Data, Typeable)
\end{code}
\begin{code}
\section[HsLit]{Abstract syntax: source-language literals}
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module HsLit where
#include "HsVersions.h"
import Type ( Type )
import Outputable
import FastString
+
+import Data.Data
\end{code}
-- (overloaded literals are done with HsOverLit)
| HsFloatPrim Rational -- Unboxed Float
| HsDoublePrim Rational -- Unboxed Double
+ deriving (Data, Typeable)
instance Eq HsLit where
(HsChar x1) == (HsChar x2) = x1==x2
-- False <=> standard syntax
ol_witness :: SyntaxExpr id, -- Note [Overloaded literal witnesses]
ol_type :: PostTcType }
+ deriving (Data, Typeable)
data OverLitVal
= HsIntegral !Integer -- Integer-looking literals;
| HsFractional !Rational -- Frac-looking literals
| HsIsString !FastString -- String-looking literals
+ deriving (Data, Typeable)
overLitType :: HsOverLit a -> Type
overLitType = ol_type
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module HsPat (
Pat(..), InPat, OutPat, LPat,
import Type
import SrcLoc
import FastString
+-- libraries:
+import Data.Data hiding (TyCon)
\end{code}
Type -- Type of whole pattern, t1
-- During desugaring a (CoPat co pat) turns into a cast with 'co' on
-- the scrutinee, followed by a match on 'pat'
+ deriving (Data, Typeable)
\end{code}
HsConDetails is use for patterns/expressions *and* for data type declarations
= PrefixCon [arg] -- C p1 p2 p3
| RecCon rec -- C { x = p1, y = p2 }
| InfixCon arg arg -- p1 `C` p2
+ deriving (Data, Typeable)
type HsConPatDetails id = HsConDetails (LPat id) (HsRecFields id (LPat id))
-- Used for both expressions and patterns
= HsRecFields { rec_flds :: [HsRecField id arg],
rec_dotdot :: Maybe Int } -- Note [DotDot fields]
+ deriving (Data, Typeable)
-- Note [DotDot fields]
-- ~~~~~~~~~~~~~~~~~~~~
hsRecFieldId :: Located id,
hsRecFieldArg :: arg, -- Filled in by renamer
hsRecPun :: Bool -- Note [Punning]
- }
+ } deriving (Data, Typeable)
-- Note [Punning]
-- ~~~~~~~~~~~~~~
module HsPat where
import SrcLoc( Located )
+import Data.Data
+
data Pat i
type LPat i = Located (Pat i)
+
+instance Data i => Data (Pat i)
\end{code}
therefore, is almost nothing but re-exporting.
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module HsSyn (
module HsBinds,
module HsDecls,
import SrcLoc ( Located(..) )
import Module ( Module, ModuleName )
import FastString
+
+-- libraries:
+import Data.Data hiding ( Fixity )
\end{code}
\begin{code}
-- ^ reason\/explanation for warning/deprecation of this module
hsmodHaddockModHeader :: Maybe LHsDocString
-- ^ Haddock module info and description, unparsed
- }
-
+ } deriving (Data, Typeable)
data HsExtCore name -- Read from Foo.hcr
= HsExtCore
HsTypes: Abstract syntax: user-defined types
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module HsTypes (
HsType(..), LHsType,
HsTyVarBndr(..), LHsTyVarBndr,
import StaticFlags
import Outputable
import FastString
+
+import Data.Data
\end{code}
id -- The quasi-quoter
SrcSpan -- The span of the enclosed string
FastString -- The enclosed string
+ deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsQuasiQuote id) where
ppr = ppr_qq
-- never appears on a HsBangTy
| HsStrict -- !
| HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
+ deriving (Data, Typeable)
instance Outputable HsBang where
ppr (HsNoBang) = empty
data HsPred name = HsClassP name [LHsType name] -- class constraint
| HsEqualP (LHsType name) (LHsType name)-- equality constraint
| HsIParam (IPName name) (LHsType name)
+ deriving (Data, Typeable)
type LHsType name = Located (HsType name)
| HsBangTy HsBang (LHsType name) -- Bang-style type annotations
| HsRecTy [ConDeclField name] -- Only in data type declarations
+ deriving (Data, Typeable)
-data HsExplicitFlag = Explicit | Implicit
+data HsExplicitFlag = Explicit | Implicit deriving (Data, Typeable)
data ConDeclField name -- Record fields have Haddoc docs on them
= ConDeclField { cd_fld_name :: Located name,
cd_fld_type :: LBangType name,
cd_fld_doc :: Maybe LHsDocString }
-
+ deriving (Data, Typeable)
-----------------------
-- Combine adjacent for-alls.
-- *** NOTA BENE *** A "monotype" in a pragma can have
-- for-alls in it, (mostly to do with dictionaries). These
-- must be explicitly Kinded.
+ deriving (Data, Typeable)
hsTyVarName :: HsTyVarBndr name -> name
hsTyVarName (UserTyVar n _) = n
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module ForeignCall (
ForeignCall(..),
import Module
import Data.Char
+import Data.Data
\end{code}
| PlayRisky -- None of the above can happen; the call will return
-- without interacting with the runtime system at all
- deriving ( Eq, Show )
+ deriving ( Eq, Show, Data, Typeable )
-- Show used just for Show Lex.Token, I think
{-! derive: Binary !-}
= CExportStatic -- foreign export ccall foo :: ty
CLabelString -- C Name of exported function
CCallConv
+ deriving (Data, Typeable)
{-! derive: Binary !-}
data CCallSpec
-- Used when importing a label as "foreign import ccall "dynamic" ..."
| DynamicTarget
- deriving( Eq )
+ deriving( Eq, Data, Typeable )
{-! derive: Binary !-}
isDynamicTarget :: CCallTarget -> Bool
\begin{code}
data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
- deriving (Eq)
+ deriving (Eq, Data, Typeable)
{-! derive: Binary !-}
instance Outputable CCallConv where
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module CostCentre (
CostCentre(..), CcName, IsDupdCC(..), IsCafCC(..),
import FastTypes
import FastString
import Util ( thenCmp )
+
+import Data.Data
\end{code}
A Cost Centre Stack is something that can be attached to a closure.
| AllCafsCC {
cc_mod :: Module -- Name of module defining this CC.
}
+ deriving (Data, Typeable)
type CcName = FastString
-- but we are trying to avoid confusion between
-- "subd" and "subsumed". So we call the former
-- "dupd".
+ deriving (Data, Typeable)
data IsCafCC = CafCC | NotCafCC
+ deriving (Data, Typeable)
-- synonym for triple which describes the cost centre info in the generated
-- code for a module.
classBigSig, classExtraBigSig, classTvsFds, classSCTheta
) where
+#include "Typeable.h"
+
import {-# SOURCE #-} TyCon ( TyCon )
import {-# SOURCE #-} TypeRep ( PredType )
import Name
import BasicTypes
import Unique
+import Util
import Outputable
import FastString
+
+import qualified Data.Data as Data
\end{code}
%************************************************************************
pprFunDep :: Outputable a => FunDep a -> SDoc
pprFunDep (us, vs) = hsep [interppSP us, ptext (sLit "->"), interppSP vs]
+
+instance Data.Typeable Class where
+ typeOf _ = Data.mkTyConApp (Data.mkTyCon "Class") []
+
+instance Data.Data Class where
+ -- don't traverse?
+ toConstr _ = abstractConstr "Class"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "Class"
\end{code}
import Outputable
import FastString
import Constants
+import Util
+import qualified Data.Data as Data
import Data.List( elemIndex )
\end{code}
instance NamedThing TyCon where
getName = tyConName
+
+instance Data.Typeable TyCon where
+ typeOf _ = Data.mkTyConApp (Data.mkTyCon "TyCon") []
+
+instance Data.Data TyCon where
+ -- don't traverse?
+ toConstr _ = abstractConstr "TyCon"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "TyCon"
\end{code}
\begin{code}
-- We expose the relevant stuff from this module via the Type module
{-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE DeriveDataTypeable #-}
module TypeRep (
TyThing(..),
import PrelNames
import Outputable
import FastString
+
+-- libraries
+import Data.Data hiding ( TyCon )
\end{code}
----------------------
-- of a 'FunTy' (unlike the 'PredType' constructors 'ClassP' or 'IParam')
-- See Note [PredTy], and Note [Equality predicates]
+ deriving (Data, Typeable)
-- | The key type representing kinds in the compiler.
-- Invariant: a kind is always in one of these forms:
= ClassP Class [Type] -- ^ Class predicate e.g. @Eq a@
| IParam (IPName Name) Type -- ^ Implicit parameter e.g. @?x :: Int@
| EqPred Type Type -- ^ Equality predicate e.g @ty1 ~ ty2@
+ deriving (Data, Typeable)
-- | A collection of 'PredType's
type ThetaType = [PredType]
mapBagM, mapAndUnzipBagM
) where
+#include "Typeable.h"
+
import Outputable
-import Util ( isSingleton )
+import Util
+import Data.Data
import Data.List ( partition )
infixr 3 `consBag`
\begin{code}
instance (Outputable a) => Outputable (Bag a) where
ppr bag = braces (pprWithCommas ppr (bagToList bag))
+
+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"
\end{code}
import FastTypes
import FastFunctions
import Panic
+import Util
import Foreign
import Foreign.C
import GHC.Exts
import System.IO
import System.IO.Unsafe ( unsafePerformIO )
+import Data.Data
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import Data.Maybe ( isJust )
import Data.Char ( ord )
n_chars :: {-# UNPACK #-} !Int, -- number of chars
buf :: {-# UNPACK #-} !(ForeignPtr Word8),
enc :: FSEncoding
- }
+ } deriving Typeable
data FSEncoding
-- including strings that don't need any encoding
instance Show FastString where
show fs = show (unpackFS fs)
+instance Data FastString where
+ -- don't traverse?
+ toConstr _ = abstractConstr "FastString"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "FastString"
+
cmpFS :: FastString -> FastString -> Ordering
cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
if u1 == u2 then EQ else
escapeSpaces,
parseSearchPath,
Direction(..), reslash,
+
+ -- * Utils for defining Data instances
+ abstractConstr, abstractDataType, mkNoRepType
) where
#include "HsVersions.h"
import Panic
+import Data.Data
import Data.IORef ( IORef, newIORef, atomicModifyIORef )
import System.IO.Unsafe ( unsafePerformIO )
import Data.List hiding (group)
Backwards -> '\\'
\end{code}
+%************************************************************************
+%* *
+\subsection[Utils-Data]{Utils for defining Data instances}
+%* *
+%************************************************************************
+
+These functions helps us to define Data instances for abstract types.
+
+\begin{code}
+abstractConstr :: String -> Constr
+abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix
+\end{code}
+
+\begin{code}
+abstractDataType :: String -> DataType
+abstractDataType n = mkDataType n [abstractConstr n]
+\end{code}
+
+\begin{code}
+-- Old GHC versions come with a base library with this function misspelled.
+#if __GLASGOW_HASKELL__ < 612
+mkNoRepType :: String -> DataType
+mkNoRepType = mkNorepType
+#endif
+\end{code}
+
projects / ghc-hetmet.git / commitdiff