summaryrefslogtreecommitdiff
path: root/compiler/parser
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2017-05-19 14:56:09 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2017-06-04 21:54:14 +0200
commit46af88c257d4aab8912690a0b1d3ab038f160e1d (patch)
treea098b338c0c9afefe271519330dc8c0b217e62ed /compiler/parser
parentff363bd74c8b2505b92b39d5fedcf95b8ab7365a (diff)
downloadhaskell-wip/new-tree-one-param-2.tar.gz
Udate hsSyn AST to use Trees that Growwip/new-tree-one-param-2
Summary: See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow This commit prepares the ground for a full extensible AST, by replacing the type parameter for the hsSyn data types with a set of indices into type families, data GhcPs -- ^ Index for GHC parser output data GhcRn -- ^ Index for GHC renamer output data GhcTc -- ^ Index for GHC typechecker output These are now used instead of `RdrName`, `Name` and `Id`/`TcId`/`Var` Where the original name type is required in a polymorphic context, this is accessible via the IdP type family, defined as type family IdP p type instance IdP GhcPs = RdrName type instance IdP GhcRn = Name type instance IdP GhcTc = Id These types are declared in the new 'hsSyn/HsExtension.hs' module. To gain a better understanding of the extension mechanism, it has been applied to `HsLit` only, also replacing the `SourceText` fields in them with extension types. To preserve extension generality, a type class is introduced to capture the `SourceText` interface, which must be honoured by all of the extension points which originally had a `SourceText`. The class is defined as class HasSourceText a where -- Provide setters to mimic existing constructors noSourceText :: a sourceText :: String -> a setSourceText :: SourceText -> a getSourceText :: a -> SourceText And the constraint is captured in `SourceTextX`, which is a constraint type listing all the extension points that make use of the class. Updating Haddock submodule to match. Test Plan: ./validate Reviewers: simonpj, shayan-najd, goldfire, austin, bgamari Subscribers: rwbarton, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D3609
Diffstat (limited to 'compiler/parser')
-rw-r--r--compiler/parser/Parser.y373
-rw-r--r--compiler/parser/RdrHsSyn.hs245
2 files changed, 312 insertions, 306 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 7af02053fd..02aeb86180 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -661,7 +661,7 @@ unitdecl :: { LHsUnitDecl PackageName }
-- either, and DEPRECATED is only expected to be used by people who really
-- know what they are doing. :-)
-signature :: { Located (HsModule RdrName) }
+signature :: { Located (HsModule GhcPs) }
: maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
{% fileSrcSpan >>= \ loc ->
ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
@@ -669,7 +669,7 @@ signature :: { Located (HsModule RdrName) }
)
([mj AnnSignature $2, mj AnnWhere $6] ++ fst $7) }
-module :: { Located (HsModule RdrName) }
+module :: { Located (HsModule GhcPs) }
: maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
{% fileSrcSpan >>= \ loc ->
ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
@@ -702,23 +702,23 @@ maybemodwarning :: { Maybe (Located WarningTxt) }
| {- empty -} { Nothing }
body :: { ([AddAnn]
- ,([LImportDecl RdrName], [LHsDecl RdrName])) }
+ ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }
: '{' top '}' { (moc $1:mcc $3:(fst $2)
, snd $2) }
| vocurly top close { (fst $2, snd $2) }
body2 :: { ([AddAnn]
- ,([LImportDecl RdrName], [LHsDecl RdrName])) }
+ ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }
: '{' top '}' { (moc $1:mcc $3
:(fst $2), snd $2) }
| missing_module_keyword top close { ([],snd $2) }
top :: { ([AddAnn]
- ,([LImportDecl RdrName], [LHsDecl RdrName])) }
+ ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }
: semis top1 { ($1, $2) }
-top1 :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
+top1 :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }
: importdecls_semi topdecls_semi { (reverse $1, cvTopDecls $2) }
| importdecls_semi topdecls { (reverse $1, cvTopDecls $2) }
| importdecls { (reverse $1, []) }
@@ -726,7 +726,7 @@ top1 :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
-----------------------------------------------------------------------------
-- Module declaration & imports only
-header :: { Located (HsModule RdrName) }
+header :: { Located (HsModule GhcPs) }
: maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
@@ -740,35 +740,35 @@ header :: { Located (HsModule RdrName) }
return (L loc (HsModule Nothing Nothing $1 [] Nothing
Nothing)) }
-header_body :: { [LImportDecl RdrName] }
+header_body :: { [LImportDecl GhcPs] }
: '{' header_top { $2 }
| vocurly header_top { $2 }
-header_body2 :: { [LImportDecl RdrName] }
+header_body2 :: { [LImportDecl GhcPs] }
: '{' header_top { $2 }
| missing_module_keyword header_top { $2 }
-header_top :: { [LImportDecl RdrName] }
+header_top :: { [LImportDecl GhcPs] }
: semis header_top_importdecls { $2 }
-header_top_importdecls :: { [LImportDecl RdrName] }
+header_top_importdecls :: { [LImportDecl GhcPs] }
: importdecls_semi { $1 }
| importdecls { $1 }
-----------------------------------------------------------------------------
-- The Export List
-maybeexports :: { (Maybe (Located [LIE RdrName])) }
+maybeexports :: { (Maybe (Located [LIE GhcPs])) }
: '(' exportlist ')' {% ams (sLL $1 $> ()) [mop $1,mcp $3] >>
return (Just (sLL $1 $> (fromOL $2))) }
| {- empty -} { Nothing }
-exportlist :: { OrdList (LIE RdrName) }
+exportlist :: { OrdList (LIE GhcPs) }
: expdoclist ',' expdoclist {% addAnnotation (oll $1) AnnComma (gl $2)
>> return ($1 `appOL` $3) }
| exportlist1 { $1 }
-exportlist1 :: { OrdList (LIE RdrName) }
+exportlist1 :: { OrdList (LIE GhcPs) }
: expdoclist export expdoclist ',' exportlist1
{% (addAnnotation (oll ($1 `appOL` $2 `appOL` $3))
AnnComma (gl $4) ) >>
@@ -776,11 +776,11 @@ exportlist1 :: { OrdList (LIE RdrName) }
| expdoclist export expdoclist { $1 `appOL` $2 `appOL` $3 }
| expdoclist { $1 }
-expdoclist :: { OrdList (LIE RdrName) }
+expdoclist :: { OrdList (LIE GhcPs) }
: exp_doc expdoclist { $1 `appOL` $2 }
| {- empty -} { nilOL }
-exp_doc :: { OrdList (LIE RdrName) }
+exp_doc :: { OrdList (LIE GhcPs) }
: docsection { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
| docnamed { unitOL (sL1 $1 (IEDocNamed ((fst . unLoc) $1))) }
| docnext { unitOL (sL1 $1 (IEDoc (unLoc $1))) }
@@ -788,7 +788,7 @@ exp_doc :: { OrdList (LIE RdrName) }
-- No longer allow things like [] and (,,,) to be exported
-- They are built in syntax, always available
-export :: { OrdList (LIE RdrName) }
+export :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% mkModuleImpExp $1 (snd $ unLoc $2)
>>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
| 'module' modid {% amsu (sLL $1 $> (IEModuleContents $2))
@@ -855,19 +855,19 @@ semis : semis ';' { mj AnnSemi $2 : $1 }
| {- empty -} { [] }
-- No trailing semicolons, non-empty
-importdecls :: { [LImportDecl RdrName] }
+importdecls :: { [LImportDecl GhcPs] }
importdecls
: importdecls_semi importdecl
{ $2 : $1 }
-- May have trailing semicolons, can be empty
-importdecls_semi :: { [LImportDecl RdrName] }
+importdecls_semi :: { [LImportDecl GhcPs] }
importdecls_semi
: importdecls_semi importdecl semis1
{% ams $2 $3 >> return ($2 : $1) }
| {- empty -} { [] }
-importdecl :: { LImportDecl RdrName }
+importdecl :: { LImportDecl GhcPs }
: 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
{% ams (L (comb4 $1 $6 (snd $7) $8) $
ImportDecl { ideclSourceSrc = snd $ fst $2
@@ -907,14 +907,14 @@ maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
,sLL $1 $> (Just $2)) }
| {- empty -} { ([],noLoc Nothing) }
-maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
+maybeimpspec :: { Located (Maybe (Bool, Located [LIE GhcPs])) }
: impspec {% let (b, ie) = unLoc $1 in
checkImportSpec ie
>>= \checkedIe ->
return (L (gl $1) (Just (b, checkedIe))) }
| {- empty -} { noLoc Nothing }
-impspec :: { Located (Bool, Located [LIE RdrName]) }
+impspec :: { Located (Bool, Located [LIE GhcPs]) }
: '(' exportlist ')' {% ams (sLL $1 $> (False,
sLL $1 $> $ fromOL $2))
[mop $1,mcp $3] }
@@ -944,15 +944,15 @@ ops :: { Located (OrdList (Located RdrName)) }
-- Top-Level Declarations
-- No trailing semicolons, non-empty
-topdecls :: { OrdList (LHsDecl RdrName) }
+topdecls :: { OrdList (LHsDecl GhcPs) }
: topdecls_semi topdecl { $1 `snocOL` $2 }
-- May have trailing semicolons, can be empty
-topdecls_semi :: { OrdList (LHsDecl RdrName) }
+topdecls_semi :: { OrdList (LHsDecl GhcPs) }
: topdecls_semi topdecl semis1 {% ams $2 $3 >> return ($1 `snocOL` $2) }
| {- empty -} { nilOL }
-topdecl :: { LHsDecl RdrName }
+topdecl :: { LHsDecl GhcPs }
: cl_decl { sL1 $1 (TyClD (unLoc $1)) }
| ty_decl { sL1 $1 (TyClD (unLoc $1)) }
| inst_decl { sL1 $1 (InstD (unLoc $1)) }
@@ -1007,14 +1007,14 @@ topdecl :: { LHsDecl RdrName }
-- Type classes
--
-cl_decl :: { LTyClDecl RdrName }
+cl_decl :: { LTyClDecl GhcPs }
: 'class' tycl_hdr fds where_cls
{% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
(mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }
-- Type declarations (toplevel)
--
-ty_decl :: { LTyClDecl RdrName }
+ty_decl :: { LTyClDecl GhcPs }
-- ordinary type synonyms
: 'type' type '=' ctypedoc
-- Note ctype, not sigtype, on the right of '='
@@ -1063,7 +1063,7 @@ ty_decl :: { LTyClDecl RdrName }
(snd $ unLoc $4) Nothing)
(mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
-inst_decl :: { LInstDecl RdrName }
+inst_decl :: { LInstDecl GhcPs }
: 'instance' overlap_pragma inst_type where_inst
{% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
@@ -1120,12 +1120,12 @@ deriv_strategy :: { Maybe (Located DerivStrategy) }
-- Injective type families
-opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn RdrName)) }
+opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn GhcPs)) }
: {- empty -} { noLoc ([], Nothing) }
| '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1]
, Just ($2)) }
-injectivity_cond :: { LInjectivityAnn RdrName }
+injectivity_cond :: { LInjectivityAnn GhcPs }
: tyvarid '->' inj_varids
{% ams (sLL $1 $> (InjectivityAnn $1 (reverse (unLoc $3))))
[mu AnnRarrow $2] }
@@ -1136,13 +1136,13 @@ inj_varids :: { Located [Located RdrName] }
-- Closed type families
-where_type_family :: { Located ([AddAnn],FamilyInfo RdrName) }
+where_type_family :: { Located ([AddAnn],FamilyInfo GhcPs) }
: {- empty -} { noLoc ([],OpenTypeFamily) }
| 'where' ty_fam_inst_eqn_list
{ sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
-ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) }
+ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn GhcPs]) }
: '{' ty_fam_inst_eqns '}' { sLL $1 $> ([moc $1,mcc $3]
,Just (unLoc $2)) }
| vocurly ty_fam_inst_eqns close { let L loc _ = $2 in
@@ -1152,7 +1152,7 @@ ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) }
| vocurly '..' close { let L loc _ = $2 in
L loc ([mj AnnDotdot $2],Nothing) }
-ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
+ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }
: ty_fam_inst_eqns ';' ty_fam_inst_eqn
{% asl (unLoc $1) $2 (snd $ unLoc $3)
>> ams $3 (fst $ unLoc $3)
@@ -1163,7 +1163,7 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
>> return (sLL $1 $> [snd $ unLoc $1]) }
| {- empty -} { noLoc [] }
-ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) }
+ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn GhcPs) }
: type '=' ctype
-- Note the use of type for the head; this allows
-- infix type constructors and type patterns
@@ -1179,7 +1179,7 @@ ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) }
-- declarations without a kind signature cause parsing conflicts with empty
-- data declarations.
--
-at_decl_cls :: { LHsDecl RdrName }
+at_decl_cls :: { LHsDecl GhcPs }
: -- data family declarations, with optional 'family' keyword
'data' opt_family type opt_datafam_kind_sig
{% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
@@ -1217,7 +1217,7 @@ opt_family :: { [AddAnn] }
-- Associated type instances
--
-at_decl_inst :: { LInstDecl RdrName }
+at_decl_inst :: { LInstDecl GhcPs }
-- type instance declarations
: 'type' ty_fam_inst_eqn
-- Note the use of type for the head; this allows
@@ -1248,21 +1248,21 @@ data_or_newtype :: { Located (AddAnn, NewOrData) }
-- Family result/return kind signatures
-opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind RdrName)) }
+opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind GhcPs)) }
: { noLoc ([] , Nothing) }
| '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
-opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
+opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
: { noLoc ([] , noLoc NoSig )}
| '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig $2))}
-opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
+opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
: { noLoc ([] , noLoc NoSig )}
| '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig $2))}
| '=' tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig $2))}
-opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig RdrName
- , Maybe (LInjectivityAnn RdrName)))}
+opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig GhcPs
+ , Maybe (LInjectivityAnn GhcPs)))}
: { noLoc ([], (noLoc NoSig, Nothing)) }
| '::' kind { sLL $1 $> ( [mu AnnDcolon $1]
, (sLL $2 $> (KindSig $2), Nothing)) }
@@ -1277,7 +1277,7 @@ opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig RdrName
-- (Eq a, Ord b) => T a b
-- T Int [a] -- for associated types
-- Rather a lot of inlining here, else we get reduce/reduce errors
-tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
+tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }
: context '=>' type {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> (return (sLL $1 $> (Just $1, $3)))
}
@@ -1299,7 +1299,7 @@ capi_ctype : '{-# CTYPE' STRING STRING '#-}'
-- Stand-alone deriving
-- Glasgow extension: stand-alone deriving declarations
-stand_alone_deriving :: { LDerivDecl RdrName }
+stand_alone_deriving :: { LDerivDecl GhcPs }
: 'deriving' deriv_strategy 'instance' overlap_pragma inst_type
{% do { let { err = text "in the stand-alone deriving instance"
<> colon <+> quotes (ppr $5) }
@@ -1309,7 +1309,7 @@ stand_alone_deriving :: { LDerivDecl RdrName }
-----------------------------------------------------------------------------
-- Role annotations
-role_annot :: { LRoleAnnotDecl RdrName }
+role_annot :: { LRoleAnnotDecl GhcPs }
role_annot : 'type' 'role' oqtycon maybe_roles
{% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
[mj AnnType $1,mj AnnRole $2] }
@@ -1331,7 +1331,7 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 }
-- Pattern synonyms
-- Glasgow extension: pattern synonyms
-pattern_synonym_decl :: { LHsDecl RdrName }
+pattern_synonym_decl :: { LHsDecl GhcPs }
: 'pattern' pattern_synonym_lhs '=' pat
{% let (name, args,as ) = $2 in
ams (sLL $1 $> . ValD $ mkPatSynBind name args $4
@@ -1367,13 +1367,13 @@ cvars1 :: { [RecordPatSynField (Located RdrName)] }
return ((RecordPatSynField $1 $1) : $3 )}
where_decls :: { Located ([AddAnn]
- , Located (OrdList (LHsDecl RdrName))) }
+ , Located (OrdList (LHsDecl GhcPs))) }
: 'where' '{' decls '}' { sLL $1 $> ((mj AnnWhere $1:moc $2
:mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
| 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
,sL1 $3 (snd $ unLoc $3)) }
-pattern_synonym_sig :: { LSig RdrName }
+pattern_synonym_sig :: { LSig GhcPs }
: 'pattern' con_list '::' sigtype
{% ams (sLL $1 $> $ PatSynSig (unLoc $2) (mkLHsSigType $4))
[mj AnnPattern $1, mu AnnDcolon $3] }
@@ -1383,7 +1383,7 @@ pattern_synonym_sig :: { LSig RdrName }
-- Declaration in class bodies
--
-decl_cls :: { LHsDecl RdrName }
+decl_cls :: { LHsDecl GhcPs }
decl_cls : at_decl_cls { $1 }
| decl { $1 }
@@ -1395,7 +1395,7 @@ decl_cls : at_decl_cls { $1 }
; ams (sLL $1 $> $ SigD $ ClassOpSig True [v] $ mkLHsSigType $4)
[mj AnnDefault $1,mu AnnDcolon $3] } }
-decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } -- Reversed
+decls_cls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
: decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1)
then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
, unitOL $3))
@@ -1412,7 +1412,7 @@ decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } -- Reversed
decllist_cls
:: { Located ([AddAnn]
- , OrdList (LHsDecl RdrName)) } -- Reversed
+ , OrdList (LHsDecl GhcPs)) } -- Reversed
: '{' decls_cls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
,snd $ unLoc $2) }
| vocurly decls_cls close { $2 }
@@ -1420,7 +1420,7 @@ decllist_cls
-- Class body
--
where_cls :: { Located ([AddAnn]
- ,(OrdList (LHsDecl RdrName))) } -- Reversed
+ ,(OrdList (LHsDecl GhcPs))) } -- Reversed
-- No implicit parameters
-- May have type declarations
: 'where' decllist_cls { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
@@ -1429,11 +1429,11 @@ where_cls :: { Located ([AddAnn]
-- Declarations in instance bodies
--
-decl_inst :: { Located (OrdList (LHsDecl RdrName)) }
+decl_inst :: { Located (OrdList (LHsDecl GhcPs)) }
decl_inst : at_decl_inst { sLL $1 $> (unitOL (sL1 $1 (InstD (unLoc $1)))) }
| decl { sLL $1 $> (unitOL $1) }
-decls_inst :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } -- Reversed
+decls_inst :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
: decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1)
then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
, unLoc $3))
@@ -1451,14 +1451,14 @@ decls_inst :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } -- Reversed
decllist_inst
:: { Located ([AddAnn]
- , OrdList (LHsDecl RdrName)) } -- Reversed
+ , OrdList (LHsDecl GhcPs)) } -- Reversed
: '{' decls_inst '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
| vocurly decls_inst close { L (gl $2) (unLoc $2) }
-- Instance body
--
where_inst :: { Located ([AddAnn]
- , OrdList (LHsDecl RdrName)) } -- Reversed
+ , OrdList (LHsDecl GhcPs)) } -- Reversed
-- No implicit parameters
-- May have type declarations
: 'where' decllist_inst { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
@@ -1467,7 +1467,7 @@ where_inst :: { Located ([AddAnn]
-- Declarations in binding groups other than classes and instances
--
-decls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
+decls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }
: decls ';' decl {% if isNilOL (snd $ unLoc $1)
then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
, unitOL $3))
@@ -1486,14 +1486,14 @@ decls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
| decl { sL1 $1 ([], unitOL $1) }
| {- empty -} { noLoc ([],nilOL) }
-decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl RdrName))) }
+decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl GhcPs))) }
: '{' decls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
,sL1 $2 $ snd $ unLoc $2) }
| vocurly decls close { L (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) }
-- Binding groups other than those of class and instance declarations
--
-binds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
+binds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
-- May have implicit parameters
-- No type declarations
: decllist {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
@@ -1509,7 +1509,7 @@ binds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
emptyTcEvBinds)) }
-wherebinds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
+wherebinds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
-- May have implicit parameters
-- No type declarations
: 'where' binds { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
@@ -1520,7 +1520,7 @@ wherebinds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
-----------------------------------------------------------------------------
-- Transformation Rules
-rules :: { OrdList (LRuleDecl RdrName) }
+rules :: { OrdList (LRuleDecl GhcPs) }
: rules ';' rule {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `snocOL` $3) }
| rules ';' {% addAnnotation (oll $1) AnnSemi (gl $2)
@@ -1528,7 +1528,7 @@ rules :: { OrdList (LRuleDecl RdrName) }
| rule { unitOL $1 }
| {- empty -} { nilOL }
-rule :: { LRuleDecl RdrName }
+rule :: { LRuleDecl GhcPs }
: STRING rule_activation rule_forall infixexp '=' exp
{%ams (sLL $1 $> $ (HsRule (L (gl $1) (getSTRINGs $1,getSTRING $1))
((snd $2) `orElse` AlwaysActive)
@@ -1550,15 +1550,15 @@ rule_explicit_activation :: { ([AddAnn]
| '[' '~' ']' { ([mos $1,mj AnnTilde $2,mcs $3]
,NeverActive) }
-rule_forall :: { ([AddAnn],[LRuleBndr RdrName]) }
+rule_forall :: { ([AddAnn],[LRuleBndr GhcPs]) }
: 'forall' rule_var_list '.' { ([mu AnnForall $1,mj AnnDot $3],$2) }
| {- empty -} { ([],[]) }
-rule_var_list :: { [LRuleBndr RdrName] }
+rule_var_list :: { [LRuleBndr GhcPs] }
: rule_var { [$1] }
| rule_var rule_var_list { $1 : $2 }
-rule_var :: { LRuleBndr RdrName }
+rule_var :: { LRuleBndr GhcPs }
: varid { sLL $1 $> (RuleBndr $1) }
| '(' varid '::' ctype ')' {% ams (sLL $1 $> (RuleBndrSig $2
(mkLHsSigWcType $4)))
@@ -1567,7 +1567,7 @@ rule_var :: { LRuleBndr RdrName }
-----------------------------------------------------------------------------
-- Warnings and deprecations (c.f. rules)
-warnings :: { OrdList (LWarnDecl RdrName) }
+warnings :: { OrdList (LWarnDecl GhcPs) }
: warnings ';' warning {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `appOL` $3) }
| warnings ';' {% addAnnotation (oll $1) AnnSemi (gl $2)
@@ -1576,12 +1576,12 @@ warnings :: { OrdList (LWarnDecl RdrName) }
| {- empty -} { nilOL }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
-warning :: { OrdList (LWarnDecl RdrName) }
+warning :: { OrdList (LWarnDecl GhcPs) }
: namelist strings
{% amsu (sLL $1 $> (Warning (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
(fst $ unLoc $2) }
-deprecations :: { OrdList (LWarnDecl RdrName) }
+deprecations :: { OrdList (LWarnDecl GhcPs) }
: deprecations ';' deprecation
{% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `appOL` $3) }
@@ -1591,7 +1591,7 @@ deprecations :: { OrdList (LWarnDecl RdrName) }
| {- empty -} { nilOL }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
-deprecation :: { OrdList (LWarnDecl RdrName) }
+deprecation :: { OrdList (LWarnDecl GhcPs) }
: namelist strings
{% amsu (sLL $1 $> $ (Warning (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
(fst $ unLoc $2) }
@@ -1609,7 +1609,7 @@ stringlist :: { Located (OrdList (Located StringLiteral)) }
-----------------------------------------------------------------------------
-- Annotations
-annotation :: { LHsDecl RdrName }
+annotation :: { LHsDecl GhcPs }
: '{-# ANN' name_var aexp '#-}' {% ams (sLL $1 $> (AnnD $ HsAnnotation
(getANN_PRAGs $1)
(ValueAnnProvenance $2) $3))
@@ -1629,7 +1629,7 @@ annotation :: { LHsDecl RdrName }
-----------------------------------------------------------------------------
-- Foreign import and export declarations
-fdecl :: { Located ([AddAnn],HsDecl RdrName) }
+fdecl :: { Located ([AddAnn],HsDecl GhcPs) }
fdecl : 'import' callconv safety fspec
{% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i)) }
@@ -1653,7 +1653,7 @@ safety :: { Located Safety }
| 'interruptible' { sLL $1 $> PlayInterruptible }
fspec :: { Located ([AddAnn]
- ,(Located StringLiteral, Located RdrName, LHsSigType RdrName)) }
+ ,(Located StringLiteral, Located RdrName, LHsSigType GhcPs)) }
: STRING var '::' sigtypedoc { sLL $1 $> ([mu AnnDcolon $3]
,(L (getLoc $1)
(getStringLiteral $1), $2, mkLHsSigType $4)) }
@@ -1666,11 +1666,11 @@ fspec :: { Located ([AddAnn]
-----------------------------------------------------------------------------
-- Type signatures
-opt_sig :: { ([AddAnn], Maybe (LHsType RdrName)) }
+opt_sig :: { ([AddAnn], Maybe (LHsType GhcPs)) }
: {- empty -} { ([],Nothing) }
| '::' sigtype { ([mu AnnDcolon $1],Just $2) }
-opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
+opt_asig :: { ([AddAnn],Maybe (LHsType GhcPs)) }
: {- empty -} { ([],Nothing) }
| '::' atype { ([mu AnnDcolon $1],Just $2) }
@@ -1678,10 +1678,10 @@ opt_tyconsig :: { ([AddAnn], Maybe (Located RdrName)) }
: {- empty -} { ([], Nothing) }
| '::' gtycon { ([mu AnnDcolon $1], Just $2) }
-sigtype :: { LHsType RdrName }
+sigtype :: { LHsType GhcPs }
: ctype { $1 }
-sigtypedoc :: { LHsType RdrName }
+sigtypedoc :: { LHsType GhcPs }
: ctypedoc { $1 }
@@ -1691,7 +1691,7 @@ sig_vars :: { Located [Located RdrName] } -- Returned in reversed order
>> return (sLL $1 $> ($3 : unLoc $1)) }
| var { sL1 $1 [$1] }
-sigtypes1 :: { (OrdList (LHsSigType RdrName)) }
+sigtypes1 :: { (OrdList (LHsSigType GhcPs)) }
: sigtype { unitOL (mkLHsSigType $1) }
| sigtype ',' sigtypes1 {% addAnnotation (gl $1) AnnComma (gl $2)
>> return (unitOL (mkLHsSigType $1) `appOL` $3) }
@@ -1717,7 +1717,7 @@ unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) }
| '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getNOUNPACK_PRAGs $1, SrcNoUnpack) }
-- A ctype is a for-all type
-ctype :: { LHsType RdrName }
+ctype :: { LHsType GhcPs }
: 'forall' tv_bndrs '.' ctype {% hintExplicitForall (getLoc $1) >>
ams (sLL $1 $> $
HsForAllTy { hst_bndrs = $2
@@ -1742,7 +1742,7 @@ ctype :: { LHsType RdrName }
-- If we allow comments on types here, it's not clear if the comment applies
-- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
-ctypedoc :: { LHsType RdrName }
+ctypedoc :: { LHsType GhcPs }
: 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
ams (sLL $1 $> $
HsForAllTy { hst_bndrs = $2
@@ -1768,7 +1768,7 @@ ctypedoc :: { LHsType RdrName }
-- Thus for some reason we allow f :: a~b => blah
-- but not f :: ?x::Int => blah
-- See Note [Parsing ~]
-context :: { LHsContext RdrName }
+context :: { LHsContext GhcPs }
: btype {% do { (anns,ctx) <- checkContext $1
; if null (unLoc ctx)
then addAnnotation (gl $1) AnnUnit (gl $1)
@@ -1776,7 +1776,7 @@ context :: { LHsContext RdrName }
; ams ctx anns
} }
-context_no_ops :: { LHsContext RdrName }
+context_no_ops :: { LHsContext GhcPs }
: btype_no_ops {% do { ty <- splitTilde $1
; (anns,ctx) <- checkContext ty
; if null (unLoc ctx)
@@ -1801,14 +1801,14 @@ the top-level annotation will be disconnected. Hence for this specific case it
is connected to the first type too.
-}
-type :: { LHsType RdrName }
+type :: { LHsType GhcPs }
: btype { $1 }
| btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
>> ams (sLL $1 $> $ HsFunTy $1 $3)
[mu AnnRarrow $2] }
-typedoc :: { LHsType RdrName }
+typedoc :: { LHsType GhcPs }
: btype { $1 }
| btype docprev { sLL $1 $> $ HsDocTy $1 $2 }
| btype '->' ctypedoc {% ams (sLL $1 $> $ HsFunTy $1 $3)
@@ -1819,7 +1819,7 @@ typedoc :: { LHsType RdrName }
[mu AnnRarrow $3] }
-- See Note [Parsing ~]
-btype :: { LHsType RdrName }
+btype :: { LHsType GhcPs }
: tyapps {% splitTildeApps (reverse (unLoc $1)) >>=
\ts -> return $ sL1 $1 $ HsAppsTy ts }
@@ -1827,16 +1827,16 @@ btype :: { LHsType RdrName }
-- in order to forbid the blasphemous
-- > data Foo = Int :+ Char :* Bool
-- See also Note [Parsing data constructors is hard] in RdrHsSyn
-btype_no_ops :: { LHsType RdrName }
+btype_no_ops :: { LHsType GhcPs }
: btype_no_ops atype { sLL $1 $> $ HsAppTy $1 $2 }
| atype { $1 }
-tyapps :: { Located [LHsAppType RdrName] } -- NB: This list is reversed
+tyapps :: { Located [LHsAppType GhcPs] } -- NB: This list is reversed
: tyapp { sL1 $1 [$1] }
| tyapps tyapp { sLL $1 $> $ $2 : (unLoc $1) }
-- See Note [HsAppsTy] in HsTypes
-tyapp :: { LHsAppType RdrName }
+tyapp :: { LHsAppType GhcPs }
: atype { sL1 $1 $ HsAppPrefix $1 }
| qtyconop { sL1 $1 $ HsAppInfix $1 }
| tyvarop { sL1 $1 $ HsAppInfix $1 }
@@ -1845,7 +1845,7 @@ tyapp :: { LHsAppType RdrName }
| SIMPLEQUOTE varop {% ams (sLL $1 $> $ HsAppInfix $2)
[mj AnnSimpleQuote $1] }
-atype :: { LHsType RdrName }
+atype :: { LHsType GhcPs }
: ntgtycon { sL1 $1 (HsTyVar NotPromoted $1) } -- Not including unit tuples
| tyvar { sL1 $1 (HsTyVar NotPromoted $1) } -- (See Note [Unit tuples])
| strict_mark atype {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
@@ -1909,35 +1909,35 @@ atype :: { LHsType RdrName }
-- An inst_type is what occurs in the head of an instance decl
-- e.g. (Foo a, Gaz b) => Wibble a b
-- It's kept as a single type for convenience.
-inst_type :: { LHsSigType RdrName }
+inst_type :: { LHsSigType GhcPs }
: sigtype { mkLHsSigType $1 }
-deriv_types :: { [LHsSigType RdrName] }
+deriv_types :: { [LHsSigType GhcPs] }
: typedoc { [mkLHsSigType $1] }
| typedoc ',' deriv_types {% addAnnotation (gl $1) AnnComma (gl $2)
>> return (mkLHsSigType $1 : $3) }
-comma_types0 :: { [LHsType RdrName] } -- Zero or more: ty,ty,ty
+comma_types0 :: { [LHsType GhcPs] } -- Zero or more: ty,ty,ty
: comma_types1 { $1 }
| {- empty -} { [] }
-comma_types1 :: { [LHsType RdrName] } -- One or more: ty,ty,ty
+comma_types1 :: { [LHsType GhcPs] } -- One or more: ty,ty,ty
: ctype { [$1] }
| ctype ',' comma_types1 {% addAnnotation (gl $1) AnnComma (gl $2)
>> return ($1 : $3) }
-bar_types2 :: { [LHsType RdrName] } -- Two or more: ty|ty|ty
+bar_types2 :: { [LHsType GhcPs] } -- Two or more: ty|ty|ty
: ctype '|' ctype {% addAnnotation (gl $1) AnnVbar (gl $2)
>> return [$1,$3] }
| ctype '|' bar_types2 {% addAnnotation (gl $1) AnnVbar (gl $2)
>> return ($1 : $3) }
-tv_bndrs :: { [LHsTyVarBndr RdrName] }
+tv_bndrs :: { [LHsTyVarBndr GhcPs] }
: tv_bndr tv_bndrs { $1 : $2 }
| {- empty -} { [] }
-tv_bndr :: { LHsTyVarBndr RdrName }
+tv_bndr :: { LHsTyVarBndr GhcPs }
: tyvar { sL1 $1 (UserTyVar $1) }
| '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar $2 $4))
[mop $1,mu AnnDcolon $3
@@ -1982,7 +1982,7 @@ turn them into HsEqTy's.
-----------------------------------------------------------------------------
-- Kinds
-kind :: { LHsKind RdrName }
+kind :: { LHsKind GhcPs }
: ctype { $1 }
{- Note [Promotion]
@@ -2011,7 +2011,7 @@ both become a HsTyVar ("Zero", DataName) after the renamer.
-- Datatype declarations
gadt_constrlist :: { Located ([AddAnn]
- ,[LConDecl RdrName]) } -- Returned in order
+ ,[LConDecl GhcPs]) } -- Returned in order
: 'where' '{' gadt_constrs '}' { L (comb2 $1 $3)
([mj AnnWhere $1
,moc $2
@@ -2022,7 +2022,7 @@ gadt_constrlist :: { Located ([AddAnn]
, unLoc $3) }
| {- empty -} { noLoc ([],[]) }
-gadt_constrs :: { Located [LConDecl RdrName] }
+gadt_constrs :: { Located [LConDecl GhcPs] }
: gadt_constr_with_doc ';' gadt_constrs
{% addAnnotation (gl $1) AnnSemi (gl $2)
>> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
@@ -2035,14 +2035,14 @@ gadt_constrs :: { Located [LConDecl RdrName] }
-- D { x,y :: a } :: T a
-- forall a. Eq a => D { x,y :: a } :: T a
-gadt_constr_with_doc :: { LConDecl RdrName }
+gadt_constr_with_doc :: { LConDecl GhcPs }
gadt_constr_with_doc
: maybe_docnext ';' gadt_constr
{% return $ addConDoc $3 $1 }
| gadt_constr
{% return $1 }
-gadt_constr :: { LConDecl RdrName }
+gadt_constr :: { LConDecl GhcPs }
-- see Note [Difference in parsing GADT and data constructors]
-- Returns a list because of: C,D :: ty
: con_list '::' sigtype
@@ -2061,17 +2061,17 @@ consequence, GADT constructor names are resticted (names like '(*)' are
allowed in usual data constructors, but not in GADTs).
-}
-constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
+constrs :: { Located ([AddAnn],[LConDecl GhcPs]) }
: maybe_docnext '=' constrs1 { L (comb2 $2 $3) ([mj AnnEqual $2]
,addConDocs (unLoc $3) $1)}
-constrs1 :: { Located [LConDecl RdrName] }
+constrs1 :: { Located [LConDecl GhcPs] }
: constrs1 maybe_docnext '|' maybe_docprev constr
{% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
>> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
| constr { sL1 $1 [$1] }
-constr :: { LConDecl RdrName }
+constr :: { LConDecl GhcPs }
: maybe_docnext forall context_no_ops '=>' constr_stuff maybe_docprev
{% ams (let (con,details) = unLoc $5 in
addConDoc (L (comb4 $2 $3 $4 $5) (mkConDeclH98 con
@@ -2085,28 +2085,28 @@ constr :: { LConDecl RdrName }
($1 `mplus` $4))
(fst $ unLoc $2) }
-forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr RdrName]) }
+forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr GhcPs]) }
: 'forall' tv_bndrs '.' { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
| {- empty -} { noLoc ([], Nothing) }
-constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
+constr_stuff :: { Located (Located RdrName, HsConDeclDetails GhcPs) }
-- See Note [Parsing data constructors is hard] in RdrHsSyn
: btype_no_ops {% do { c <- splitCon $1
; return $ sLL $1 $> c } }
| btype_no_ops conop btype_no_ops {% do { ty <- splitTilde $1
; return $ sLL $1 $> ($2, InfixCon ty $3) } }
-fielddecls :: { [LConDeclField RdrName] }
+fielddecls :: { [LConDeclField GhcPs] }
: {- empty -} { [] }
| fielddecls1 { $1 }
-fielddecls1 :: { [LConDeclField RdrName] }
+fielddecls1 :: { [LConDeclField GhcPs] }
: fielddecl maybe_docnext ',' maybe_docprev fielddecls1
{% addAnnotation (gl $1) AnnComma (gl $3) >>
return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
| fielddecl { [$1] }
-fielddecl :: { LConDeclField RdrName }
+fielddecl :: { LConDeclField GhcPs }
-- A list because of f,g :: Int
: maybe_docnext sig_vars '::' ctype maybe_docprev
{% ams (L (comb2 $2 $4)
@@ -2114,18 +2114,18 @@ fielddecl :: { LConDeclField RdrName }
[mu AnnDcolon $3] }
-- Reversed!
-maybe_derivings :: { HsDeriving RdrName }
+maybe_derivings :: { HsDeriving GhcPs }
: {- empty -} { noLoc [] }
| derivings { $1 }
-- A list of one or more deriving clauses at the end of a datatype
-derivings :: { HsDeriving RdrName }
+derivings :: { HsDeriving GhcPs }
: derivings deriving { sLL $1 $> $ $2 : unLoc $1 }
| deriving { sLL $1 $> [$1] }
-- The outer Located is just to allow the caller to
-- know the rightmost extremity of the 'deriving' clause
-deriving :: { LHsDerivingClause RdrName }
+deriving :: { LHsDerivingClause GhcPs }
: 'deriving' deriv_strategy qtycondoc
{% let { full_loc = comb2 $1 $> }
in ams (L full_loc $ HsDerivingClause $2 $ L full_loc
@@ -2169,7 +2169,7 @@ There's an awkward overlap with a type signature. Consider
We can't tell whether to reduce var to qvar until after we've read the signatures.
-}
-docdecl :: { LHsDecl RdrName }
+docdecl :: { LHsDecl GhcPs }
: docdecld { sL1 $1 (DocD (unLoc $1)) }
docdecld :: { LDocDecl }
@@ -2178,7 +2178,7 @@ docdecld :: { LDocDecl }
| docnamed { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
| docsection { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
-decl_no_th :: { LHsDecl RdrName }
+decl_no_th :: { LHsDecl GhcPs }
: sigdecl { $1 }
| '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2) };
@@ -2205,7 +2205,7 @@ decl_no_th :: { LHsDecl RdrName }
| pattern_synonym_decl { $1 }
| docdecl { $1 }
-decl :: { LHsDecl RdrName }
+decl :: { LHsDecl GhcPs }
: decl_no_th { $1 }
-- Why do we only allow naked declaration splices in top-level
@@ -2213,7 +2213,7 @@ decl :: { LHsDecl RdrName }
-- fails terribly with a panic in cvBindsAndSigs otherwise.
| splice_exp { sLL $1 $> $ mkSpliceDecl $1 }
-rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
+rhs :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
: '=' exp wherebinds { sL (comb3 $1 $2 $3)
((mj AnnEqual $1 : (fst $ unLoc $3))
,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2)
@@ -2222,15 +2222,15 @@ rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
,GRHSs (reverse (unLoc $1))
(snd $ unLoc $2)) }
-gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
+gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
: gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) }
| gdrh { sL1 $1 [$1] }
-gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
+gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
: '|' guardquals '=' exp {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
[mj AnnVbar $1,mj AnnEqual $3] }
-sigdecl :: { LHsDecl RdrName }
+sigdecl :: { LHsDecl GhcPs }
:
-- See Note [Declaration/signature overlap] for why we need infixexp here
infixexp_top '::' sigtypedoc
@@ -2315,7 +2315,7 @@ explicit_activation :: { ([AddAnn],Activation) } -- In brackets
-----------------------------------------------------------------------------
-- Expressions
-quasiquote :: { Located (HsSplice RdrName) }
+quasiquote :: { Located (HsSplice GhcPs) }
: TH_QUASIQUOTE { let { loc = getLoc $1
; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
; quoterId = mkUnqual varName quoter }
@@ -2325,7 +2325,7 @@ quasiquote :: { Located (HsSplice RdrName) }
; quoterId = mkQual varName (qual, quoter) }
in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
-exp :: { LHsExpr RdrName }
+exp :: { LHsExpr GhcPs }
: infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
[mu AnnDcolon $2] }
| infixexp '-<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
@@ -2342,19 +2342,19 @@ exp :: { LHsExpr RdrName }
[mu AnnRarrowtail $2] }
| infixexp { $1 }
-infixexp :: { LHsExpr RdrName }
+infixexp :: { LHsExpr GhcPs }
: exp10 { $1 }
| infixexp qop exp10 {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
[mj AnnVal $2] }
-- AnnVal annotation for NPlusKPat, which discards the operator
-infixexp_top :: { LHsExpr RdrName }
+infixexp_top :: { LHsExpr GhcPs }
: exp10_top { $1 }
| infixexp_top qop exp10_top
{% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
[mj AnnVal $2] }
-exp10_top :: { LHsExpr RdrName }
+exp10_top :: { LHsExpr GhcPs }
: '\\' apat apats opt_asig '->' exp
{% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
[sLL $1 $> $ Match { m_ctxt = LambdaExpr
@@ -2414,7 +2414,7 @@ exp10_top :: { LHsExpr RdrName }
-- hdaume: core annotation
| fexp { $1 }
-exp10 :: { LHsExpr RdrName }
+exp10 :: { LHsExpr GhcPs }
: exp10_top { $1 }
| scc_annot exp {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ unLoc $1) }
@@ -2458,7 +2458,7 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In
)))
}
-fexp :: { LHsExpr RdrName }
+fexp :: { LHsExpr GhcPs }
: fexp aexp { sLL $1 $> $ HsApp $1 $2 }
| fexp TYPEAPP atype {% ams (sLL $1 $> $ HsAppType $1 (mkHsWildCardBndrs $3))
[mj AnnAt $2] }
@@ -2466,7 +2466,7 @@ fexp :: { LHsExpr RdrName }
[mj AnnStatic $1] }
| aexp { $1 }
-aexp :: { LHsExpr RdrName }
+aexp :: { LHsExpr GhcPs }
: qvar '@' aexp {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
-- If you change the parsing, make sure to understand
-- Note [Lexing type applications] in Lexer.x
@@ -2474,14 +2474,14 @@ aexp :: { LHsExpr RdrName }
| '~' aexp {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
| aexp1 { $1 }
-aexp1 :: { LHsExpr RdrName }
+aexp1 :: { LHsExpr GhcPs }
: aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
(snd $3)
; _ <- ams (sLL $1 $> ()) (moc $2:mcc $4:(fst $3))
; checkRecordSyntax (sLL $1 $> r) }}
| aexp2 { $1 }
-aexp2 :: { LHsExpr RdrName }
+aexp2 :: { LHsExpr GhcPs }
: qvar { sL1 $1 (HsVar $! $1) }
| qcon { sL1 $1 (HsVar $! $1) }
| ipvar { sL1 $1 (HsIPVar $! unLoc $1) }
@@ -2539,7 +2539,7 @@ aexp2 :: { LHsExpr RdrName }
Nothing (reverse $3))
[mu AnnOpenB $1,mu AnnCloseB $4] }
-splice_exp :: { LHsExpr RdrName }
+splice_exp :: { LHsExpr GhcPs }
: TH_ID_SPLICE {% ams (sL1 $1 $ mkHsSpliceE HasDollar
(sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
(getTH_ID_SPLICE $1)))))
@@ -2553,21 +2553,21 @@ splice_exp :: { LHsExpr RdrName }
| '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE HasParens $2)
[mj AnnOpenPTE $1,mj AnnCloseP $3] }
-cmdargs :: { [LHsCmdTop RdrName] }
+cmdargs :: { [LHsCmdTop GhcPs] }
: cmdargs acmd { $2 : $1 }
| {- empty -} { [] }
-acmd :: { LHsCmdTop RdrName }
+acmd :: { LHsCmdTop GhcPs }
: aexp2 {% checkCommand $1 >>= \ cmd ->
return (sL1 $1 $ HsCmdTop cmd
placeHolderType placeHolderType []) }
-cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
+cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
: '{' cvtopdecls0 '}' { ([mj AnnOpenC $1
,mj AnnCloseC $3],$2) }
| vocurly cvtopdecls0 close { ([],$2) }
-cvtopdecls0 :: { [LHsDecl RdrName] }
+cvtopdecls0 :: { [LHsDecl GhcPs] }
: topdecls_semi { cvTopDecls $1 }
| topdecls { cvTopDecls $1 }
@@ -2577,7 +2577,7 @@ cvtopdecls0 :: { [LHsDecl RdrName] }
-- "texp" is short for tuple expressions:
-- things that can appear unparenthesized as long as they're
-- inside parens or delimitted by commas
-texp :: { LHsExpr RdrName }
+texp :: { LHsExpr GhcPs }
: exp { $1 }
-- Note [Parsing sections]
@@ -2614,7 +2614,7 @@ tup_exprs :: { ([AddAnn],SumOrTuple) }
{ (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
-- Always starts with commas; always follows an expr
-commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
+commas_tup_tail :: { (SrcSpan,[LHsTupArg GhcPs]) }
commas_tup_tail : commas tup_tail
{% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
; return (
@@ -2622,7 +2622,7 @@ commas_tup_tail : commas tup_tail
,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
-- Always follows a comma
-tup_tail :: { [LHsTupArg RdrName] }
+tup_tail :: { [LHsTupArg GhcPs] }
: texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
return ((L (gl $1) (Present $1)) : snd $2) }
| texp { [L (gl $1) (Present $1)] }
@@ -2633,7 +2633,7 @@ tup_tail :: { [LHsTupArg RdrName] }
-- The rules below are little bit contorted to keep lexps left-recursive while
-- avoiding another shift/reduce-conflict.
-list :: { ([AddAnn],HsExpr RdrName) }
+list :: { ([AddAnn],HsExpr GhcPs) }
: texp { ([],ExplicitList placeHolderType Nothing [$1]) }
| lexps { ([],ExplicitList placeHolderType Nothing
(reverse (unLoc $1))) }
@@ -2653,7 +2653,7 @@ list :: { ([AddAnn],HsExpr RdrName) }
return ([mj AnnVbar $2],
mkHsComp ctxt (unLoc $3) $1) }
-lexps :: { Located [LHsExpr RdrName] }
+lexps :: { Located [LHsExpr GhcPs] }
: lexps ',' texp {% addAnnotation (gl $ head $ unLoc $1)
AnnComma (gl $2) >>
return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
@@ -2663,7 +2663,7 @@ lexps :: { Located [LHsExpr RdrName] }
-----------------------------------------------------------------------------
-- List Comprehensions
-flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
+flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
: pquals { case (unLoc $1) of
[qs] -> sL1 $1 qs
-- We just had one thing in our "parallel" list so
@@ -2676,13 +2676,13 @@ flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
-- we wrap them into as a ParStmt
}
-pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
+pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }
: squals '|' pquals
{% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
| squals { L (getLoc $1) [reverse (unLoc $1)] }
-squals :: { Located [LStmt RdrName (LHsExpr RdrName)] } -- In reverse order, because the last
+squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, because the last
-- one can "grab" the earlier ones
: squals ',' transformqual
{% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
@@ -2702,7 +2702,7 @@ squals :: { Located [LStmt RdrName (LHsExpr RdrName)] } -- In reverse order, b
-- consensus on the syntax, this feature is not being used until we
-- get user demand.
-transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
+transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
-- Function is applied to a list of stmts *in order*
: 'then' exp { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
| 'then' exp 'by' exp { sLL $1 $> ([mj AnnThen $1,mj AnnBy $3],\ss -> (mkTransformByStmt ss $2 $4)) }
@@ -2725,7 +2725,7 @@ transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt R
-- Moreover, we allow explicit arrays with no element (represented by the nil
-- constructor in the list case).
-parr :: { ([AddAnn],HsExpr RdrName) }
+parr :: { ([AddAnn],HsExpr GhcPs) }
: { ([],ExplicitPArr placeHolderType []) }
| texp { ([],ExplicitPArr placeHolderType [$1]) }
| lexps { ([],ExplicitPArr placeHolderType
@@ -2743,10 +2743,10 @@ parr :: { ([AddAnn],HsExpr RdrName) }
-----------------------------------------------------------------------------
-- Guards
-guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
+guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
: guardquals1 { L (getLoc $1) (reverse (unLoc $1)) }
-guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
+guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
: guardquals1 ',' qual {% addAnnotation (gl $ head $ unLoc $1) AnnComma
(gl $2) >>
return (sLL $1 $> ($3 : unLoc $1)) }
@@ -2755,7 +2755,7 @@ guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
-----------------------------------------------------------------------------
-- Case alternatives
-altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
+altslist :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
: '{' alts '}' { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
,(reverse (snd $ unLoc $2))) }
| vocurly alts close { L (getLoc $2) (fst $ unLoc $2
@@ -2763,12 +2763,12 @@ altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
| '{' '}' { noLoc ([moc $1,mcc $2],[]) }
| vocurly close { noLoc ([],[]) }
-alts :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
+alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
: alts1 { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
| ';' alts { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
,snd $ unLoc $2) }
-alts1 :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
+alts1 :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
: alts1 ';' alt {% if null (snd $ unLoc $1)
then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
,[$3]))
@@ -2783,34 +2783,34 @@ alts1 :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
>> return (sLL $1 $> ([],snd $ unLoc $1))) }
| alt { sL1 $1 ([],[$1]) }
-alt :: { LMatch RdrName (LHsExpr RdrName) }
+alt :: { LMatch GhcPs (LHsExpr GhcPs) }
: pat opt_asig alt_rhs {%ams (sLL $1 $> (Match { m_ctxt = CaseAlt
, m_pats = [$1]
, m_type = snd $2
, m_grhss = snd $ unLoc $3 }))
(fst $2 ++ (fst $ unLoc $3))}
-alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
+alt_rhs :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
: ralt wherebinds { sLL $1 $> (fst $ unLoc $2,
GRHSs (unLoc $1) (snd $ unLoc $2)) }
-ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
+ralt :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
: '->' exp {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
[mu AnnRarrow $1] }
| gdpats { sL1 $1 (reverse (unLoc $1)) }
-gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
+gdpats :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
: gdpats gdpat { sLL $1 $> ($2 : unLoc $1) }
| gdpat { sL1 $1 [$1] }
-- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
-- generate the open brace in addition to the vertical bar in the lexer, and
-- we don't need it.
-ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
+ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
: '{' gdpats '}' { sLL $1 $> ([moc $1,mcc $3],unLoc $2) }
| gdpats close { sL1 $1 ([],unLoc $1) }
-gdpat :: { LGRHS RdrName (LHsExpr RdrName) }
+gdpat :: { LGRHS GhcPs (LHsExpr GhcPs) }
: '|' guardquals '->' exp
{% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
[mj AnnVbar $1,mu AnnRarrow $3] }
@@ -2819,13 +2819,13 @@ gdpat :: { LGRHS RdrName (LHsExpr RdrName) }
-- e.g. "!x" or "!(x,y)" or "C a b" etc
-- Bangs inside are parsed as infix operator applications, so that
-- we parse them right when bang-patterns are off
-pat :: { LPat RdrName }
+pat :: { LPat GhcPs }
pat : exp {% checkPattern empty $1 }
| '!' aexp {% amms (checkPattern empty (sLL $1 $> (SectionR
(sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
-bindpat :: { LPat RdrName }
+bindpat :: { LPat GhcPs }
bindpat : exp {% checkPattern
(text "Possibly caused by a missing 'do'?") $1 }
| '!' aexp {% amms (checkPattern
@@ -2833,21 +2833,21 @@ bindpat : exp {% checkPattern
(sLL $1 $> (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
-apat :: { LPat RdrName }
+apat :: { LPat GhcPs }
apat : aexp {% checkPattern empty $1 }
| '!' aexp {% amms (checkPattern empty
(sLL $1 $> (SectionR
(sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
-apats :: { [LPat RdrName] }
+apats :: { [LPat GhcPs] }
: apat apats { $1 : $2 }
| {- empty -} { [] }
-----------------------------------------------------------------------------
-- Statement sequences
-stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
+stmtlist :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)]) }
: '{' stmts '}' { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
| vocurly stmts close { L (gl $2) (fst $ unLoc $2
@@ -2859,7 +2859,7 @@ stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
-- So we use BodyStmts throughout, and switch the last one over
-- in ParseUtils.checkDo instead
-stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
+stmts :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)]) }
: stmts ';' stmt {% if null (snd $ unLoc $1)
then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
,$3 : (snd $ unLoc $1)))
@@ -2879,16 +2879,16 @@ stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
-- For typing stmts at the GHCi prompt, where
-- the input may consist of just comments.
-maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
+maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }
: stmt { Just $1 }
| {- nothing -} { Nothing }
-stmt :: { LStmt RdrName (LHsExpr RdrName) }
+stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
: qual { $1 }
| 'rec' stmtlist {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
(mj AnnRec $1:(fst $ unLoc $2)) }
-qual :: { LStmt RdrName (LHsExpr RdrName) }
+qual :: { LStmt GhcPs (LHsExpr GhcPs) }
: bindpat '<-' exp {% ams (sLL $1 $> $ mkBindStmt $1 $3)
[mu AnnLarrow $2] }
| exp { sL1 $1 $ mkBodyStmt $1 }
@@ -2898,18 +2898,18 @@ qual :: { LStmt RdrName (LHsExpr RdrName) }
-----------------------------------------------------------------------------
-- Record Field Update/Construction
-fbinds :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
+fbinds :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)) }
: fbinds1 { $1 }
| {- empty -} { ([],([], False)) }
-fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
+fbinds1 :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)) }
: fbind ',' fbinds1
{% addAnnotation (gl $1) AnnComma (gl $2) >>
return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
| fbind { ([],([$1], False)) }
| '..' { ([mj AnnDotdot $1],([], True)) }
-fbind :: { LHsRecField RdrName (LHsExpr RdrName) }
+fbind :: { LHsRecField GhcPs (LHsExpr GhcPs) }
: qvar '=' texp {% ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
[mj AnnEqual $2] }
-- RHS is a 'texp', allowing view patterns (Trac #6038)
@@ -2923,7 +2923,7 @@ fbind :: { LHsRecField RdrName (LHsExpr RdrName) }
-----------------------------------------------------------------------------
-- Implicit Parameter Bindings
-dbinds :: { Located [LIPBind RdrName] }
+dbinds :: { Located [LIPBind GhcPs] }
: dbinds ';' dbind
{% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
return (let { this = $3; rest = unLoc $1 }
@@ -2933,7 +2933,7 @@ dbinds :: { Located [LIPBind RdrName] }
| dbind { let this = $1 in this `seq` sL1 $1 [this] }
-- | {- empty -} { [] }
-dbind :: { LIPBind RdrName }
+dbind :: { LIPBind GhcPs }
dbind : ipvar '=' exp {% ams (sLL $1 $> (IPBind (Left $1) $3))
[mj AnnEqual $2] }
@@ -3114,7 +3114,7 @@ qtycon :: { Located RdrName } -- Qualified or unqualified
: QCONID { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
| tycon { $1 }
-qtycondoc :: { LHsType RdrName } -- Qualified or unqualified
+qtycondoc :: { LHsType GhcPs } -- Qualified or unqualified
: qtycon { sL1 $1 (HsTyVar NotPromoted $1) }
| qtycon docprev { sLL $1 $> (HsDocTy (sL1 $1 (HsTyVar NotPromoted $1)) $2) }
@@ -3148,14 +3148,14 @@ varop :: { Located RdrName }
[mj AnnBackquote $1,mj AnnVal $2
,mj AnnBackquote $3] }
-qop :: { LHsExpr RdrName } -- used in sections
+qop :: { LHsExpr GhcPs } -- used in sections
: qvarop { sL1 $1 $ HsVar $1 }
| qconop { sL1 $1 $ HsVar $1 }
| '`' '_' '`' {% ams (sLL $1 $> EWildPat)
[mj AnnBackquote $1,mj AnnVal $2
,mj AnnBackquote $3] }
-qopm :: { LHsExpr RdrName } -- used in sections
+qopm :: { LHsExpr GhcPs } -- used in sections
: qvaropm { sL1 $1 $ HsVar $1 }
| qconop { sL1 $1 $ HsVar $1 }
@@ -3302,20 +3302,20 @@ consym :: { Located RdrName }
-----------------------------------------------------------------------------
-- Literals
-literal :: { Located HsLit }
- : CHAR { sL1 $1 $ HsChar (getCHARs $1) $ getCHAR $1 }
- | STRING { sL1 $1 $ HsString (getSTRINGs $1)
- $ getSTRING $1 }
- | PRIMINTEGER { sL1 $1 $ HsIntPrim (getPRIMINTEGERs $1)
- $ getPRIMINTEGER $1 }
- | PRIMWORD { sL1 $1 $ HsWordPrim (getPRIMWORDs $1)
- $ getPRIMWORD $1 }
- | PRIMCHAR { sL1 $1 $ HsCharPrim (getPRIMCHARs $1)
- $ getPRIMCHAR $1 }
- | PRIMSTRING { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
- $ getPRIMSTRING $1 }
- | PRIMFLOAT { sL1 $1 $ HsFloatPrim $ getPRIMFLOAT $1 }
- | PRIMDOUBLE { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
+literal :: { Located (HsLit GhcPs) }
+ : CHAR { sL1 $1 $ HsChar (sst $ getCHARs $1) $ getCHAR $1 }
+ | STRING { sL1 $1 $ HsString (sst $ getSTRINGs $1)
+ $ getSTRING $1 }
+ | PRIMINTEGER { sL1 $1 $ HsIntPrim (sst $ getPRIMINTEGERs $1)
+ $ getPRIMINTEGER $1 }
+ | PRIMWORD { sL1 $1 $ HsWordPrim (sst $ getPRIMWORDs $1)
+ $ getPRIMWORD $1 }
+ | PRIMCHAR { sL1 $1 $ HsCharPrim (sst $ getPRIMCHARs $1)
+ $ getPRIMCHAR $1 }
+ | PRIMSTRING { sL1 $1 $ HsStringPrim (sst $ getPRIMSTRINGs $1)
+ $ getPRIMSTRING $1 }
+ | PRIMFLOAT { sL1 $1 $ HsFloatPrim def $ getPRIMFLOAT $1 }
+ | PRIMDOUBLE { sL1 $1 $ HsDoublePrim def $ getPRIMDOUBLE $1 }
-----------------------------------------------------------------------------
-- Layout
@@ -3563,7 +3563,7 @@ hintMultiWayIf span = do
text "Multi-way if-expressions need MultiWayIf turned on"
-- Hint about if usage for beginners
-hintIf :: SrcSpan -> String -> P (LHsExpr RdrName)
+hintIf :: SrcSpan -> String -> P (LHsExpr GhcPs)
hintIf span msg = do
mwiEnabled <- liftM ((LangExt.MultiWayIf `extopt`) . options) getPState
if mwiEnabled
@@ -3712,4 +3712,7 @@ oll l =
asl :: [Located a] -> Located b -> Located a -> P()
asl [] (L ls _) (L l _) = addAnnotation l AnnSemi ls
asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
+
+sst ::HasSourceText a => SourceText -> a
+sst = setSourceText
}
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index d6fc6fb642..eb78073b66 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
module RdrHsSyn (
mkHsOpApp,
@@ -130,10 +131,10 @@ mkInstD :: LInstDecl n -> LHsDecl n
mkInstD (L loc d) = L loc (InstD d)
mkClassDecl :: SrcSpan
- -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
+ -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a,[Located (FunDep (Located RdrName))])
- -> OrdList (LHsDecl RdrName)
- -> P (LTyClDecl RdrName)
+ -> OrdList (LHsDecl GhcPs)
+ -> P (LTyClDecl GhcPs)
mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
= do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls
@@ -150,8 +151,8 @@ mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
, tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs
, tcdFVs = placeHolderNames })) }
-mkATDefault :: LTyFamInstDecl RdrName
- -> Either (SrcSpan, SDoc) (LTyFamDefltEqn RdrName)
+mkATDefault :: LTyFamInstDecl GhcPs
+ -> Either (SrcSpan, SDoc) (LTyFamDefltEqn GhcPs)
-- Take a type-family instance declaration and turn it into
-- a type-family default equation for a class declaration
-- We parse things as the former and use this function to convert to the latter
@@ -170,11 +171,11 @@ mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e }))
mkTyData :: SrcSpan
-> NewOrData
-> Maybe (Located CType)
- -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
- -> Maybe (LHsKind RdrName)
- -> [LConDecl RdrName]
- -> HsDeriving RdrName
- -> P (LTyClDecl RdrName)
+ -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
+ -> Maybe (LHsKind GhcPs)
+ -> [LConDecl GhcPs]
+ -> HsDeriving GhcPs
+ -> P (LTyClDecl GhcPs)
mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
@@ -188,11 +189,11 @@ mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
mkDataDefn :: NewOrData
-> Maybe (Located CType)
- -> Maybe (LHsContext RdrName)
- -> Maybe (LHsKind RdrName)
- -> [LConDecl RdrName]
- -> HsDeriving RdrName
- -> P (HsDataDefn RdrName)
+ -> Maybe (LHsContext GhcPs)
+ -> Maybe (LHsKind GhcPs)
+ -> [LConDecl GhcPs]
+ -> HsDeriving GhcPs
+ -> P (HsDataDefn GhcPs)
mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
= do { checkDatatypeContext mcxt
; let cxt = fromMaybe (noLoc []) mcxt
@@ -204,9 +205,9 @@ mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
mkTySynonym :: SrcSpan
- -> LHsType RdrName -- LHS
- -> LHsType RdrName -- RHS
- -> P (LTyClDecl RdrName)
+ -> LHsType GhcPs -- LHS
+ -> LHsType GhcPs -- RHS
+ -> P (LTyClDecl GhcPs)
mkTySynonym loc lhs rhs
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
@@ -215,9 +216,9 @@ mkTySynonym loc lhs rhs
, tcdFixity = fixity
, tcdRhs = rhs, tcdFVs = placeHolderNames })) }
-mkTyFamInstEqn :: LHsType RdrName
- -> LHsType RdrName
- -> P (TyFamInstEqn RdrName,[AddAnn])
+mkTyFamInstEqn :: LHsType GhcPs
+ -> LHsType GhcPs
+ -> P (TyFamInstEqn GhcPs,[AddAnn])
mkTyFamInstEqn lhs rhs
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
; return (TyFamEqn { tfe_tycon = tc
@@ -229,11 +230,11 @@ mkTyFamInstEqn lhs rhs
mkDataFamInst :: SrcSpan
-> NewOrData
-> Maybe (Located CType)
- -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
- -> Maybe (LHsKind RdrName)
- -> [LConDecl RdrName]
- -> HsDeriving RdrName
- -> P (LInstDecl RdrName)
+ -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
+ -> Maybe (LHsKind GhcPs)
+ -> [LConDecl GhcPs]
+ -> HsDeriving GhcPs
+ -> P (LInstDecl GhcPs)
mkDataFamInst loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
@@ -245,18 +246,18 @@ mkDataFamInst loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_
, dfid_defn = defn, dfid_fvs = placeHolderNames }))) }
mkTyFamInst :: SrcSpan
- -> LTyFamInstEqn RdrName
- -> P (LInstDecl RdrName)
+ -> LTyFamInstEqn GhcPs
+ -> P (LInstDecl GhcPs)
mkTyFamInst loc eqn
= return (L loc (TyFamInstD (TyFamInstDecl { tfid_eqn = eqn
, tfid_fvs = placeHolderNames })))
mkFamDecl :: SrcSpan
- -> FamilyInfo RdrName
- -> LHsType RdrName -- LHS
- -> Located (FamilyResultSig RdrName) -- Optional result signature
- -> Maybe (LInjectivityAnn RdrName) -- Injectivity annotation
- -> P (LTyClDecl RdrName)
+ -> FamilyInfo GhcPs
+ -> LHsType GhcPs -- LHS
+ -> Located (FamilyResultSig GhcPs) -- Optional result signature
+ -> Maybe (LInjectivityAnn GhcPs) -- Injectivity annotation
+ -> P (LTyClDecl GhcPs)
mkFamDecl loc info lhs ksig injAnn
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
@@ -272,7 +273,7 @@ mkFamDecl loc info lhs ksig injAnn
OpenTypeFamily -> empty
ClosedTypeFamily {} -> whereDots
-mkSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
+mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs
-- If the user wrote
-- [pads| ... ] then return a QuasiQuoteD
-- $(e) then return a SpliceD
@@ -293,9 +294,9 @@ mkSpliceDecl lexpr@(L loc expr)
= SpliceD (SpliceDecl (L loc (mkUntypedSplice NoParens lexpr)) ImplicitSplice)
mkRoleAnnotDecl :: SrcSpan
- -> Located RdrName -- type being annotated
+ -> Located RdrName -- type being annotated
-> [Located (Maybe FastString)] -- roles
- -> P (LRoleAnnotDecl RdrName)
+ -> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl loc tycon roles
= do { roles' <- mapM parse_role roles
; return $ L loc $ RoleAnnotDecl tycon roles' }
@@ -332,25 +333,25 @@ mkRoleAnnotDecl loc tycon roles
-- | Groups together bindings for a single function
-cvTopDecls :: OrdList (LHsDecl RdrName) -> [LHsDecl RdrName]
+cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
cvTopDecls decls = go (fromOL decls)
where
- go :: [LHsDecl RdrName] -> [LHsDecl RdrName]
+ go :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
go [] = []
go (L l (ValD b) : ds) = L l' (ValD b') : go ds'
where (L l' b', ds') = getMonoBind (L l b) ds
go (d : ds) = d : go ds
-- Declaration list may only contain value bindings and signatures.
-cvBindGroup :: OrdList (LHsDecl RdrName) -> P (HsValBinds RdrName)
+cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)
cvBindGroup binding
= do { (mbs, sigs, fam_ds, tfam_insts, dfam_insts, _) <- cvBindsAndSigs binding
; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)
return $ ValBindsIn mbs sigs }
-cvBindsAndSigs :: OrdList (LHsDecl RdrName)
- -> P (LHsBinds RdrName, [LSig RdrName], [LFamilyDecl RdrName]
- , [LTyFamInstDecl RdrName], [LDataFamInstDecl RdrName], [LDocDecl])
+cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
+ -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
+ , [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl])
-- Input decls contain just value bindings and signatures
-- and in case of class or instance declarations also
-- associated type declarations. They might also contain Haddock comments.
@@ -385,8 +386,8 @@ cvBindsAndSigs fb = go (fromOL fb)
-----------------------------------------------------------------------------
-- Group function bindings into equation groups
-getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
- -> (LHsBind RdrName, [LHsDecl RdrName])
+getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
+ -> (LHsBind GhcPs, [LHsDecl GhcPs])
-- Suppose (b',ds') = getMonoBind b ds
-- ds is a list of parsed bindings
-- b is a MonoBinds that has just been read off the front
@@ -423,7 +424,7 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1),
getMonoBind bind binds = (bind, binds)
-has_args :: [LMatch RdrName (LHsExpr RdrName)] -> Bool
+has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
has_args [] = panic "RdrHsSyn:has_args"
has_args ((L _ (Match _ args _ _)) : _) = not (null args)
-- Don't group together FunBinds if they have
@@ -462,8 +463,8 @@ So the plan is:
it (Trac #12051).
-}
-splitCon :: LHsType RdrName
- -> P (Located RdrName, HsConDeclDetails RdrName)
+splitCon :: LHsType GhcPs
+ -> P (Located RdrName, HsConDeclDetails GhcPs)
-- See Note [Parsing data constructors is hard]
-- This gets given a "type" that should look like
-- C Int Bool
@@ -502,8 +503,8 @@ tyConToDataCon loc tc
| otherwise = empty
mkPatSynMatchGroup :: Located RdrName
- -> Located (OrdList (LHsDecl RdrName))
- -> P (MatchGroup RdrName (LHsExpr RdrName))
+ -> Located (OrdList (LHsDecl GhcPs))
+ -> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
do { matches <- mapM fromDecl (fromOL decls)
; when (null matches) (wrongNumberErr loc)
@@ -536,15 +537,15 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
text "pattern synonym 'where' clause cannot be empty" $$
text "In the pattern synonym declaration for: " <+> ppr (patsyn_name)
-recordPatSynErr :: SrcSpan -> LPat RdrName -> P a
+recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
recordPatSynErr loc pat =
parseErrorSDoc loc $
text "record syntax not supported for pattern synonym declarations:" $$
ppr pat
-mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr RdrName]
- -> LHsContext RdrName -> HsConDeclDetails RdrName
- -> ConDecl RdrName
+mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs]
+ -> LHsContext GhcPs -> HsConDeclDetails GhcPs
+ -> ConDecl GhcPs
mkConDeclH98 name mb_forall cxt details
= ConDeclH98 { con_name = name
@@ -556,8 +557,8 @@ mkConDeclH98 name mb_forall cxt details
, con_doc = Nothing }
mkGadtDecl :: [Located RdrName]
- -> LHsSigType RdrName -- Always a HsForAllTy
- -> ConDecl RdrName
+ -> LHsSigType GhcPs -- Always a HsForAllTy
+ -> ConDecl GhcPs
mkGadtDecl names ty = ConDeclGADT { con_names = names
, con_type = ty
, con_doc = Nothing }
@@ -664,7 +665,8 @@ really doesn't matter!
-- * For PrefixCon we keep all the args in the res_ty
-- * For RecCon we do not
-checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName] -> P (LHsQTyVars RdrName)
+checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsType GhcPs]
+ -> P (LHsQTyVars GhcPs)
-- Same as checkTyVars, but in the P monad
checkTyVarsP pp_what equals_or_where tc tparms
= eitherToP $ checkTyVars pp_what equals_or_where tc tparms
@@ -674,8 +676,8 @@ eitherToP :: Either (SrcSpan, SDoc) a -> P a
eitherToP (Left (loc, doc)) = parseErrorSDoc loc doc
eitherToP (Right thing) = return thing
-checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName]
- -> Either (SrcSpan, SDoc) (LHsQTyVars RdrName)
+checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsType GhcPs]
+ -> Either (SrcSpan, SDoc) (LHsQTyVars GhcPs)
-- Check whether the given list of type parameters are all type variables
-- (possibly with a kind signature)
-- We use the Either monad because it's also called (via mkATDefault) from
@@ -708,7 +710,7 @@ whereDots, equalsDots :: SDoc
whereDots = text "where ..."
equalsDots = text "= ..."
-checkDatatypeContext :: Maybe (LHsContext RdrName) -> P ()
+checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Nothing = return ()
checkDatatypeContext (Just (L loc c))
= do allowed <- extension datatypeContextsEnabled
@@ -728,10 +730,10 @@ checkRecordSyntax lr@(L loc r)
checkTyClHdr :: Bool -- True <=> class header
-- False <=> type header
- -> LHsType RdrName
- -> P (Located RdrName, -- the head symbol (type or class name)
- [LHsType RdrName], -- parameters of head symbol
- LexicalFixity, -- the declaration is in infix format
+ -> LHsType GhcPs
+ -> P (Located RdrName, -- the head symbol (type or class name)
+ [LHsType GhcPs], -- parameters of head symbol
+ LexicalFixity, -- the declaration is in infix format
[AddAnn]) -- API Annotation for HsParTy when stripping parens
-- Well-formedness check and decomposition of type and class heads.
-- Decomposes T ty1 .. tyn into (T, [ty1, ..., tyn])
@@ -769,7 +771,7 @@ checkTyClHdr is_cls ty
= parseErrorSDoc l (text "Malformed head of type or class declaration:"
<+> ppr ty)
-checkContext :: LHsType RdrName -> P ([AddAnn],LHsContext RdrName)
+checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)
checkContext (L l orig_t)
= check [] (L l orig_t)
where
@@ -794,17 +796,17 @@ checkContext (L l orig_t)
-- We parse patterns as expressions and check for valid patterns below,
-- converting the expression into a pattern at the same time.
-checkPattern :: SDoc -> LHsExpr RdrName -> P (LPat RdrName)
+checkPattern :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)
checkPattern msg e = checkLPat msg e
-checkPatterns :: SDoc -> [LHsExpr RdrName] -> P [LPat RdrName]
+checkPatterns :: SDoc -> [LHsExpr GhcPs] -> P [LPat GhcPs]
checkPatterns msg es = mapM (checkPattern msg) es
-checkLPat :: SDoc -> LHsExpr RdrName -> P (LPat RdrName)
+checkLPat :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)
checkLPat msg e@(L l _) = checkPat msg l e []
-checkPat :: SDoc -> SrcSpan -> LHsExpr RdrName -> [LPat RdrName]
- -> P (LPat RdrName)
+checkPat :: SDoc -> SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]
+ -> P (LPat GhcPs)
checkPat _ loc (L l e@(HsVar (L _ c))) args
| isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
| not (null args) && patIsRec c =
@@ -824,7 +826,7 @@ checkPat msg loc (L _ e) []
checkPat msg loc e _
= patFail msg loc (unLoc e)
-checkAPat :: SDoc -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
+checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs)
checkAPat msg loc e0 = do
pState <- getPState
let opts = options pState
@@ -895,7 +897,7 @@ checkAPat msg loc e0 = do
-> return (SplicePat s)
_ -> patFail msg loc e0
-placeHolderPunRhs :: LHsExpr RdrName
+placeHolderPunRhs :: LHsExpr GhcPs
-- The RHS of a punned record field will be filled in by the renamer
-- It's better not to make it an error, in case we want to print it when debugging
placeHolderPunRhs = noLoc (HsVar (noLoc pun_RDR))
@@ -905,12 +907,12 @@ plus_RDR = mkUnqual varName (fsLit "+") -- Hack
bang_RDR = mkUnqual varName (fsLit "!") -- Hack
pun_RDR = mkUnqual varName (fsLit "pun-right-hand-side")
-checkPatField :: SDoc -> LHsRecField RdrName (LHsExpr RdrName)
- -> P (LHsRecField RdrName (LPat RdrName))
+checkPatField :: SDoc -> LHsRecField GhcPs (LHsExpr GhcPs)
+ -> P (LHsRecField GhcPs (LPat GhcPs))
checkPatField msg (L l fld) = do p <- checkLPat msg (hsRecFieldArg fld)
return (L l (fld { hsRecFieldArg = p }))
-patFail :: SDoc -> SrcSpan -> HsExpr RdrName -> P a
+patFail :: SDoc -> SrcSpan -> HsExpr GhcPs -> P a
patFail msg loc e = parseErrorSDoc loc err
where err = text "Parse error in pattern:" <+> ppr e
$$ msg
@@ -923,10 +925,10 @@ patIsRec e = e == mkUnqual varName (fsLit "rec")
-- Check Equation Syntax
checkValDef :: SDoc
- -> LHsExpr RdrName
- -> Maybe (LHsType RdrName)
- -> Located (a,GRHSs RdrName (LHsExpr RdrName))
- -> P ([AddAnn],HsBind RdrName)
+ -> LHsExpr GhcPs
+ -> Maybe (LHsType GhcPs)
+ -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
+ -> P ([AddAnn],HsBind GhcPs)
checkValDef msg lhs (Just sig) grhss
-- x :: ty = rhs parses as a *pattern* binding
@@ -946,10 +948,10 @@ checkFunBind :: SDoc
-> SrcSpan
-> Located RdrName
-> LexicalFixity
- -> [LHsExpr RdrName]
- -> Maybe (LHsType RdrName)
- -> Located (GRHSs RdrName (LHsExpr RdrName))
- -> P ([AddAnn],HsBind RdrName)
+ -> [LHsExpr GhcPs]
+ -> Maybe (LHsType GhcPs)
+ -> Located (GRHSs GhcPs (LHsExpr GhcPs))
+ -> P ([AddAnn],HsBind GhcPs)
checkFunBind msg ann lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
= do ps <- checkPatterns msg pats
let match_span = combineSrcSpans lhs_loc rhs_span
@@ -963,8 +965,8 @@ checkFunBind msg ann lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
-- The span of the match covers the entire equation.
-- That isn't quite right, but it'll do for now.
-makeFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)]
- -> HsBind RdrName
+makeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
+ -> HsBind GhcPs
-- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
makeFunBind fn ms
= FunBind { fun_id = fn,
@@ -974,15 +976,15 @@ makeFunBind fn ms
fun_tick = [] }
checkPatBind :: SDoc
- -> LHsExpr RdrName
- -> Located (a,GRHSs RdrName (LHsExpr RdrName))
- -> P ([AddAnn],HsBind RdrName)
+ -> LHsExpr GhcPs
+ -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
+ -> P ([AddAnn],HsBind GhcPs)
checkPatBind msg lhs (L _ (_,grhss))
= do { lhs <- checkPattern msg lhs
; return ([],PatBind lhs grhss placeHolderType placeHolderNames
([],[])) }
-checkValSigLhs :: LHsExpr RdrName -> P (Located RdrName)
+checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
checkValSigLhs (L _ (HsVar lrdr@(L _ v)))
| isUnqual v
, not (isDataOcc (rdrNameOcc v))
@@ -1014,11 +1016,11 @@ checkValSigLhs lhs@(L l _)
pattern_RDR = mkUnqual varName (fsLit "pattern")
-checkDoAndIfThenElse :: LHsExpr RdrName
+checkDoAndIfThenElse :: LHsExpr GhcPs
-> Bool
- -> LHsExpr RdrName
+ -> LHsExpr GhcPs
-> Bool
- -> LHsExpr RdrName
+ -> LHsExpr GhcPs
-> P ()
checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
| semiThen || semiElse
@@ -1038,7 +1040,7 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
-- The parser left-associates, so there should
-- not be any OpApps inside the e's
-splitBang :: LHsExpr RdrName -> Maybe (LHsExpr RdrName, [LHsExpr RdrName])
+splitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])
-- Splits (f ! g a b) into (f, [(! g), a, b])
splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg))
| op == bang_RDR = Just (l_arg, L l' (SectionR bang arg1) : argns)
@@ -1049,8 +1051,8 @@ splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg))
split_bang e es = (e,es)
splitBang _ = Nothing
-isFunLhs :: LHsExpr RdrName
- -> P (Maybe (Located RdrName, LexicalFixity, [LHsExpr RdrName],[AddAnn]))
+isFunLhs :: LHsExpr GhcPs
+ -> P (Maybe (Located RdrName, LexicalFixity, [LHsExpr GhcPs],[AddAnn]))
-- A variable binding is parsed as a FunBind.
-- Just (fun, is_infix, arg_pats) if e is a function LHS
--
@@ -1104,7 +1106,7 @@ isFunLhs e = go e [] []
-- | Transform btype_no_ops with strict_mark's into HsEqTy's
-- (((~a) ~b) c) ~d ==> ((~a) ~ (b c)) ~ d
-splitTilde :: LHsType RdrName -> P (LHsType RdrName)
+splitTilde :: LHsType GhcPs -> P (LHsType GhcPs)
splitTilde t = go t
where go (L loc (HsAppTy t1 t2))
| L lo (HsBangTy (HsSrcBang NoSourceText NoSrcUnpack SrcLazy) t2')
@@ -1129,7 +1131,7 @@ splitTilde t = go t
-- | Transform tyapps with strict_marks into uses of twiddle
-- [~a, ~b, c, ~d] ==> (~a) ~ b c ~ d
-splitTildeApps :: [LHsAppType RdrName] -> P [LHsAppType RdrName]
+splitTildeApps :: [LHsAppType GhcPs] -> P [LHsAppType GhcPs]
splitTildeApps [] = return []
splitTildeApps (t : rest) = do
rest' <- concatMapM go rest
@@ -1170,13 +1172,13 @@ checkMonadComp = do
-- We parse arrow syntax as expressions and check for valid syntax below,
-- converting the expression into a pattern at the same time.
-checkCommand :: LHsExpr RdrName -> P (LHsCmd RdrName)
+checkCommand :: LHsExpr GhcPs -> P (LHsCmd GhcPs)
checkCommand lc = locMap checkCmd lc
locMap :: (SrcSpan -> a -> P b) -> Located a -> P (Located b)
locMap f (L l a) = f l a >>= (\b -> return $ L l b)
-checkCmd :: SrcSpan -> HsExpr RdrName -> P (HsCmd RdrName)
+checkCmd :: SrcSpan -> HsExpr GhcPs -> P (HsCmd GhcPs)
checkCmd _ (HsArrApp e1 e2 ptt haat b) =
return $ HsCmdArrApp e1 e2 ptt haat b
checkCmd _ (HsArrForm e mf args) =
@@ -1208,10 +1210,10 @@ checkCmd _ (OpApp eLeft op _fixity eRight) = do
checkCmd l e = cmdFail l e
-checkCmdLStmt :: ExprLStmt RdrName -> P (CmdLStmt RdrName)
+checkCmdLStmt :: ExprLStmt GhcPs -> P (CmdLStmt GhcPs)
checkCmdLStmt = locMap checkCmdStmt
-checkCmdStmt :: SrcSpan -> ExprStmt RdrName -> P (CmdStmt RdrName)
+checkCmdStmt :: SrcSpan -> ExprStmt GhcPs -> P (CmdStmt GhcPs)
checkCmdStmt _ (LastStmt e s r) =
checkCommand e >>= (\c -> return $ LastStmt c s r)
checkCmdStmt _ (BindStmt pat e b f t) =
@@ -1224,7 +1226,8 @@ checkCmdStmt _ stmt@(RecStmt { recS_stmts = stmts }) = do
return $ stmt { recS_stmts = ss }
checkCmdStmt l stmt = cmdStmtFail l stmt
-checkCmdMatchGroup :: MatchGroup RdrName (LHsExpr RdrName) -> P (MatchGroup RdrName (LHsCmd RdrName))
+checkCmdMatchGroup :: MatchGroup GhcPs (LHsExpr GhcPs)
+ -> P (MatchGroup GhcPs (LHsCmd GhcPs))
checkCmdMatchGroup mg@(MG { mg_alts = L l ms }) = do
ms' <- mapM (locMap $ const convert) ms
return $ mg { mg_alts = L l ms' }
@@ -1232,12 +1235,12 @@ checkCmdMatchGroup mg@(MG { mg_alts = L l ms }) = do
grhss' <- checkCmdGRHSs grhss
return $ Match mf pat mty grhss'
-checkCmdGRHSs :: GRHSs RdrName (LHsExpr RdrName) -> P (GRHSs RdrName (LHsCmd RdrName))
+checkCmdGRHSs :: GRHSs GhcPs (LHsExpr GhcPs) -> P (GRHSs GhcPs (LHsCmd GhcPs))
checkCmdGRHSs (GRHSs grhss binds) = do
grhss' <- mapM checkCmdGRHS grhss
return $ GRHSs grhss' binds
-checkCmdGRHS :: LGRHS RdrName (LHsExpr RdrName) -> P (LGRHS RdrName (LHsCmd RdrName))
+checkCmdGRHS :: LGRHS GhcPs (LHsExpr GhcPs) -> P (LGRHS GhcPs (LHsCmd GhcPs))
checkCmdGRHS = locMap $ const convert
where
convert (GRHS stmts e) = do
@@ -1246,9 +1249,9 @@ checkCmdGRHS = locMap $ const convert
return $ GRHS {- cmdStmts -} stmts c
-cmdFail :: SrcSpan -> HsExpr RdrName -> P a
+cmdFail :: SrcSpan -> HsExpr GhcPs -> P a
cmdFail loc e = parseErrorSDoc loc (text "Parse error in command:" <+> ppr e)
-cmdStmtFail :: SrcSpan -> Stmt RdrName (LHsExpr RdrName) -> P a
+cmdStmtFail :: SrcSpan -> Stmt GhcPs (LHsExpr GhcPs) -> P a
cmdStmtFail loc e = parseErrorSDoc loc
(text "Parse error in command statement:" <+> ppr e)
@@ -1262,10 +1265,10 @@ checkPrecP (L l (src,i))
= parseErrorSDoc l (text ("Precedence out of range: " ++ show i))
mkRecConstrOrUpdate
- :: LHsExpr RdrName
+ :: LHsExpr GhcPs
-> SrcSpan
- -> ([LHsRecField RdrName (LHsExpr RdrName)], Bool)
- -> P (HsExpr RdrName)
+ -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)
+ -> P (HsExpr GhcPs)
mkRecConstrOrUpdate (L l (HsVar (L _ c))) _ (fs,dd)
| isRdrDataCon c
@@ -1274,14 +1277,14 @@ mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
| dd = parseErrorSDoc l (text "You cannot use `..' in a record update")
| otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))
-mkRdrRecordUpd :: LHsExpr RdrName -> [LHsRecUpdField RdrName] -> HsExpr RdrName
+mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
mkRdrRecordUpd exp flds
= RecordUpd { rupd_expr = exp
, rupd_flds = flds
, rupd_cons = PlaceHolder, rupd_in_tys = PlaceHolder
, rupd_out_tys = PlaceHolder, rupd_wrap = PlaceHolder }
-mkRdrRecordCon :: Located RdrName -> HsRecordBinds RdrName -> HsExpr RdrName
+mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
mkRdrRecordCon con flds
= RecordCon { rcon_con_name = con, rcon_flds = flds
, rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
@@ -1290,7 +1293,7 @@ mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg
mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
mk_rec_fields fs True = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
-mk_rec_upd_field :: HsRecField RdrName (LHsExpr RdrName) -> HsRecUpdField RdrName
+mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field (HsRecField (L loc (FieldOcc rdr _)) arg pun)
= HsRecField (L loc (Unambiguous rdr PlaceHolder)) arg pun
@@ -1319,8 +1322,8 @@ mkInlinePragma src (inl, match_info) mb_act
--
mkImport :: Located CCallConv
-> Located Safety
- -> (Located StringLiteral, Located RdrName, LHsSigType RdrName)
- -> P (HsDecl RdrName)
+ -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)
+ -> P (HsDecl GhcPs)
mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
case cconv of
L _ CCallConv -> mkCImport
@@ -1419,8 +1422,8 @@ parseCImport cconv safety nm str sourceText =
-- construct a foreign export declaration
--
mkExport :: Located CCallConv
- -> (Located StringLiteral, Located RdrName, LHsSigType RdrName)
- -> P (HsDecl RdrName)
+ -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)
+ -> P (HsDecl GhcPs)
mkExport (L lc cconv) (L le (StringLiteral esrc entity), v, ty)
= return $ ForD $
ForeignExport { fd_name = v, fd_sig_ty = ty
@@ -1452,7 +1455,7 @@ data ImpExpQcSpec = ImpExpQcName (Located RdrName)
| ImpExpQcType (Located RdrName)
| ImpExpQcWildcard
-mkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE RdrName)
+mkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp (L l specname) subs =
case subs of
ImpExpAbs
@@ -1506,7 +1509,7 @@ mkTypeImpExp name =
else parseErrorSDoc (getLoc name)
(text "Illegal keyword 'type' (use ExplicitNamespaces to enable)")
-checkImportSpec :: Located [LIE RdrName] -> P (Located [LIE RdrName])
+checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])
checkImportSpec ie@(L _ specs) =
case [l | (L l (IEThingWith _ (IEWildcard _) _ _)) <- specs] of
[] -> return ie
@@ -1538,10 +1541,10 @@ parseErrorSDoc :: SrcSpan -> SDoc -> P a
parseErrorSDoc span s = failSpanMsgP span s
data SumOrTuple
- = Sum ConTag Arity (LHsExpr RdrName)
- | Tuple [LHsTupArg RdrName]
+ = Sum ConTag Arity (LHsExpr GhcPs)
+ | Tuple [LHsTupArg GhcPs]
-mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr RdrName)
+mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)
-- Tuple
mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple es boxity)
@@ -1552,7 +1555,7 @@ mkSumOrTuple Unboxed _ (Sum alt arity e) =
mkSumOrTuple Boxed l (Sum alt arity (L _ e)) =
parseErrorSDoc l (hang (text "Boxed sums not supported:") 2 (ppr_boxed_sum alt arity e))
where
- ppr_boxed_sum :: ConTag -> Arity -> HsExpr RdrName -> SDoc
+ ppr_boxed_sum :: ConTag -> Arity -> HsExpr GhcPs -> SDoc
ppr_boxed_sum alt arity e =
text "(" <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt) <+> text ")"
View Lorry Controller Status