projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add a HsExplicitFlag to SpliceDecl, to improve Trac #4042
[ghc-hetmet.git]
/
compiler
/
hsSyn
/
HsDecls.lhs
diff --git
a/compiler/hsSyn/HsDecls.lhs
b/compiler/hsSyn/HsDecls.lhs
index
c770386
..
baf6eca
100644
(file)
--- a/
compiler/hsSyn/HsDecls.lhs
+++ b/
compiler/hsSyn/HsDecls.lhs
@@
-12,6
+12,7
@@
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
-- 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.
--
-- | Abstract syntax of global declarations.
--
@@
-39,7
+40,7
@@
module HsDecls (
SpliceDecl(..),
-- ** Foreign function interface declarations
ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
SpliceDecl(..),
-- ** Foreign function interface declarations
ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
- CImportSpec(..), FoType(..),
+ CImportSpec(..),
-- ** Data-constructor declarations
ConDecl(..), LConDecl, ResType(..),
HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
-- ** Data-constructor declarations
ConDecl(..), LConDecl, ResType(..),
HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
@@
-76,6
+77,7
@@
import SrcLoc
import FastString
import Control.Monad ( liftM )
import FastString
import Control.Monad ( liftM )
+import Data.Data
import Data.Maybe ( isJust )
\end{code}
import Data.Maybe ( isJust )
\end{code}
@@
-101,7
+103,9
@@
data HsDecl id
| AnnD (AnnDecl id)
| RuleD (RuleDecl id)
| SpliceD (SpliceDecl id)
| AnnD (AnnDecl id)
| RuleD (RuleDecl id)
| SpliceD (SpliceDecl id)
- | DocD (DocDecl id)
+ | DocD (DocDecl)
+ | QuasiQuoteD (HsQuasiQuote id)
+ deriving (Data, Typeable)
-- NB: all top-level fixity decls are contained EITHER
-- NB: all top-level fixity decls are contained EITHER
@@
-136,8
+140,8
@@
data HsGroup id
hs_annds :: [LAnnDecl id],
hs_ruleds :: [LRuleDecl id],
hs_annds :: [LAnnDecl id],
hs_ruleds :: [LRuleDecl id],
- hs_docs :: [LDocDecl id]
- }
+ hs_docs :: [LDocDecl]
+ } deriving (Data, Typeable)
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
@@
-204,6
+208,7
@@
instance OutputableBndr name => Outputable (HsDecl name) where
ppr (AnnD ad) = ppr ad
ppr (SpliceD dd) = ppr dd
ppr (DocD doc) = ppr doc
ppr (AnnD ad) = ppr ad
ppr (SpliceD dd) = ppr dd
ppr (DocD doc) = ppr doc
+ ppr (QuasiQuoteD qq) = ppr qq
instance OutputableBndr name => Outputable (HsGroup name) where
ppr (HsGroup { hs_valds = val_decls,
instance OutputableBndr name => Outputable (HsGroup name) where
ppr (HsGroup { hs_valds = val_decls,
@@
-225,12
+230,17
@@
instance OutputableBndr name => Outputable (HsGroup name) where
ppr_ds foreign_decls]
where
ppr_ds [] = empty
ppr_ds foreign_decls]
where
ppr_ds [] = empty
- ppr_ds ds = text "" $$ vcat (map ppr ds)
+ ppr_ds ds = blankLine $$ vcat (map ppr ds)
-data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
+data SpliceDecl id
+ = SpliceDecl -- Top level splice
+ (Located (HsExpr id))
+ HsExplicitFlag -- Explicit <=> $(f x y)
+ -- Implicit <=> f x y, i.e. a naked top level expression
+ deriving (Data, Typeable)
instance OutputableBndr name => Outputable (SpliceDecl name) where
instance OutputableBndr name => Outputable (SpliceDecl name) where
- ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
+ ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
\end{code}
\end{code}
@@
-401,8
+411,7
@@
type LTyClDecl name = Located (TyClDecl name)
data TyClDecl name
= ForeignType {
tcdLName :: Located name,
data TyClDecl name
= ForeignType {
tcdLName :: Located name,
- tcdExtName :: Maybe FastString,
- tcdFoType :: FoType
+ tcdExtName :: Maybe FastString
}
}
@@
-477,17
+486,19
@@
data TyClDecl name
-- only 'TyFamily' and
-- 'TySynonym'; the
-- latter for defaults
-- only 'TyFamily' and
-- 'TySynonym'; the
-- latter for defaults
- tcdDocs :: [LDocDecl name] -- ^ Haddock docs
+ tcdDocs :: [LDocDecl] -- ^ Haddock docs
}
}
+ deriving (Data, Typeable)
data NewOrData
= NewType -- ^ @newtype Blah ...@
| DataType -- ^ @data Blah ...@
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 ...@
data FamilyFlavour
= TypeFamily -- ^ @type family ...@
| DataFamily -- ^ @data family ...@
+ deriving (Data, Typeable)
\end{code}
Simple classifiers
\end{code}
Simple classifiers
@@
-697,7
+708,7
@@
data ConDecl name
-- ^ Constructor name. This is used for the DataCon itself, and for
-- the user-callable wrapper Id.
-- ^ Constructor name. This is used for the DataCon itself, and for
-- the user-callable wrapper Id.
- , con_explicit :: HsExplicitForAll
+ , con_explicit :: HsExplicitFlag
-- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
, con_qvars :: [LHsTyVarBndr name]
-- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
, con_qvars :: [LHsTyVarBndr name]
@@
-717,7
+728,7
@@
data ConDecl name
, con_res :: ResType name
-- ^ Result type of the constructor
, con_res :: ResType name
-- ^ Result type of the constructor
- , con_doc :: Maybe (LHsDoc name)
+ , con_doc :: Maybe LHsDocString
-- ^ A possible Haddock comment.
, con_old_rec :: Bool
-- ^ A possible Haddock comment.
, con_old_rec :: Bool
@@
-725,7
+736,7
@@
data ConDecl name
-- 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
-- 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]
type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
@@
-738,6
+749,7
@@
data ResType 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
= 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
instance OutputableBndr name => Outputable (ResType name) where
-- Debugging only
@@
-813,6
+825,7
@@
data InstDecl name
[LSig name] -- User-supplied pragmatic info
[LTyClDecl name]-- Associated types (ie, 'TyData' and
-- 'TySynonym' 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
instance (OutputableBndr name) => Outputable (InstDecl name) where
@@
-838,10
+851,11
@@
instDeclATs (InstDecl _ _ _ ats) = ats
type LDerivDecl name = Located (DerivDecl name)
data DerivDecl name = DerivDecl (LHsType name)
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)
instance (OutputableBndr name) => Outputable (DerivDecl name) where
ppr (DerivDecl ty)
- = hsep [ptext (sLit "derived instance"), ppr ty]
+ = hsep [ptext (sLit "deriving instance"), ppr ty]
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-859,6
+873,7
@@
type LDefaultDecl name = Located (DefaultDecl name)
data DefaultDecl name
= DefaultDecl [LHsType name]
data DefaultDecl name
= DefaultDecl [LHsType name]
+ deriving (Data, Typeable)
instance (OutputableBndr name)
=> Outputable (DefaultDecl name) where
instance (OutputableBndr name)
=> Outputable (DefaultDecl name) where
@@
-886,6
+901,7
@@
type LForeignDecl name = Located (ForeignDecl name)
data ForeignDecl name
= ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
| ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
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
-- Specification Of an imported external entity in dependence on the calling
-- convention
@@
-908,10
+924,7
@@
data ForeignImport = -- import of a C entity
Safety -- safe or unsafe
FastString -- name of C header
CImportSpec -- details of the C entity
Safety -- safe or unsafe
FastString -- name of C header
CImportSpec -- details of the C entity
-
- -- import of a .NET function
- --
- | DNImport DNCallSpec
+ deriving (Data, Typeable)
-- details of an external C entity
--
-- details of an external C entity
--
@@
-919,18
+932,13
@@
data CImportSpec = CLabel CLabelString -- import address of a C label
| CFunction CCallTarget -- static or dynamic function
| CWrapper -- wrapper to expose closures
-- (former f.e.d.)
| 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
-- specification of an externally exported entity in dependence on the calling
-- convention
--
data ForeignExport = CExport CExportSpec -- contains the calling convention
- | DNExport -- presently unused
-
--- abstract type imported from .NET
---
-data FoType = DNType -- In due course we'll add subtype stuff
- deriving (Eq) -- Used for equality instance for TyClDecl
-
+ deriving (Data, Typeable)
-- pretty printing of foreign declarations
--
-- pretty printing of foreign declarations
--
@@
-944,8
+952,6
@@
instance OutputableBndr name => Outputable (ForeignDecl name) where
2 (dcolon <+> ppr ty)
instance Outputable ForeignImport where
2 (dcolon <+> ppr ty)
instance Outputable ForeignImport where
- ppr (DNImport spec) =
- ptext (sLit "dotnet") <+> ppr spec
ppr (CImport cconv safety header spec) =
ppr cconv <+> ppr safety <+>
char '"' <> pprCEntity spec <> char '"'
ppr (CImport cconv safety header spec) =
ppr cconv <+> ppr safety <+>
char '"' <> pprCEntity spec <> char '"'
@@
-954,7
+960,7
@@
instance Outputable ForeignImport where
pprCEntity (CLabel lbl) =
ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
pprCEntity (CLabel lbl) =
ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
- pprCEntity (CFunction (StaticTarget lbl)) =
+ pprCEntity (CFunction (StaticTarget lbl _)) =
ptext (sLit "static") <+> pp_hdr <+> ppr lbl
pprCEntity (CFunction (DynamicTarget)) =
ptext (sLit "dynamic")
ptext (sLit "static") <+> pp_hdr <+> ppr lbl
pprCEntity (CFunction (DynamicTarget)) =
ptext (sLit "dynamic")
@@
-963,11
+969,6
@@
instance Outputable ForeignImport where
instance Outputable ForeignExport where
ppr (CExport (CExportStatic lbl cconv)) =
ppr cconv <+> char '"' <> ppr lbl <> char '"'
instance Outputable ForeignExport where
ppr (CExport (CExportStatic lbl cconv)) =
ppr cconv <+> char '"' <> ppr lbl <> char '"'
- ppr (DNExport ) =
- ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
-
-instance Outputable FoType where
- ppr DNType = ptext (sLit "type dotnet")
\end{code}
\end{code}
@@
-989,10
+990,12
@@
data RuleDecl name
NameSet -- Free-vars from the LHS
(Located (HsExpr name)) -- RHS
NameSet -- Free-vars from the RHS
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)
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]
collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
@@
-1019,19
+1022,20
@@
instance OutputableBndr name => Outputable (RuleBndr name) where
\begin{code}
\begin{code}
-type LDocDecl name = Located (DocDecl name)
+type LDocDecl = Located (DocDecl)
-data DocDecl name
- = DocCommentNext (HsDoc name)
- | DocCommentPrev (HsDoc name)
- | DocCommentNamed String (HsDoc name)
- | DocGroup Int (HsDoc name)
+data DocDecl
+ = DocCommentNext HsDocString
+ | DocCommentPrev HsDocString
+ | DocCommentNamed String HsDocString
+ | DocGroup Int HsDocString
+ deriving (Data, Typeable)
-- Okay, I need to reconstruct the document comments, but for now:
-- Okay, I need to reconstruct the document comments, but for now:
-instance Outputable (DocDecl name) where
+instance Outputable DocDecl where
ppr _ = text "<document comment>"
ppr _ = text "<document comment>"
-docDeclDoc :: DocDecl name -> HsDoc name
+docDeclDoc :: DocDecl -> HsDocString
docDeclDoc (DocCommentNext d) = d
docDeclDoc (DocCommentPrev d) = d
docDeclDoc (DocCommentNamed _ d) = d
docDeclDoc (DocCommentNext d) = d
docDeclDoc (DocCommentPrev d) = d
docDeclDoc (DocCommentNamed _ d) = d
@@
-1051,6
+1055,7
@@
We use exported entities for things to deprecate.
type LWarnDecl name = Located (WarnDecl name)
data WarnDecl name = Warning name WarningTxt
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)
instance OutputableBndr name => Outputable (WarnDecl name) where
ppr (Warning thing txt)
@@
-1067,6
+1072,7
@@
instance OutputableBndr name => Outputable (WarnDecl name) where
type LAnnDecl name = Located (AnnDecl name)
data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
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)
instance (OutputableBndr name) => Outputable (AnnDecl name) where
ppr (HsAnnotation provenance expr)
@@
-1076,6
+1082,7
@@
instance (OutputableBndr name) => Outputable (AnnDecl name) where
data AnnProvenance name = ValueAnnProvenance name
| TypeAnnProvenance name
| ModuleAnnProvenance
data AnnProvenance name = ValueAnnProvenance name
| TypeAnnProvenance name
| ModuleAnnProvenance
+ deriving (Data, Typeable)
annProvenanceName_maybe :: AnnProvenance name -> Maybe name
annProvenanceName_maybe (ValueAnnProvenance name) = Just name
annProvenanceName_maybe :: AnnProvenance name -> Maybe name
annProvenanceName_maybe (ValueAnnProvenance name) = Just name