diff options
Diffstat (limited to 'compiler/parser/Parser.y.pp')
| -rw-r--r-- | compiler/parser/Parser.y.pp | 34 |
1 files changed, 22 insertions, 12 deletions
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 97276b8350..b520d62fbc 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -599,13 +599,13 @@ topdecl :: { OrdList (LHsDecl RdrName) } VectD (HsVectTypeIn True $3 (Just $5)) } | '{-# VECTORISE' 'class' gtycon '#-}' { unitOL $ LL $ VectD (HsVectClassIn $3) } | annotation { unitOL $1 } - | decl { unLoc $1 } + | decl_no_th { unLoc $1 } -- Template Haskell Extension -- The $(..) form is one possible form of infixexp -- but we treat an arbitrary expression just as if -- it had a $(..) wrapped around it - | infixexp { unitOL (LL $ mkTopSpliceDecl $1) } + | infixexp { unitOL (LL $ mkSpliceDecl $1) } -- Type classes -- @@ -1367,7 +1367,7 @@ docdecld :: { LDocDecl } | docnamed { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) } | docsection { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) } -decl :: { Located (OrdList (LHsDecl RdrName)) } +decl_no_th :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } | '!' aexp rhs {% do { let { e = LL (SectionR (LL (HsVar bang_RDR)) $2) }; @@ -1383,6 +1383,14 @@ decl :: { Located (OrdList (LHsDecl RdrName)) } return $! (sL l (unitOL $! (sL l $ ValD r))) } } | docdecl { LL $ unitOL $1 } +decl :: { Located (OrdList (LHsDecl RdrName)) } + : decl_no_th { $1 } + + -- Why do we only allow naked declaration splices in top-level + -- declarations and not here? Short answer: because readFail009 + -- fails terribly with a panic in cvBindsAndSigs otherwise. + | splice_exp { LL $ unitOL (LL $ mkSpliceDecl $1) } + rhs :: { Located (GRHSs RdrName (LHsExpr RdrName)) } : '=' exp wherebinds { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) } | gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) } @@ -1552,15 +1560,7 @@ aexp2 :: { LHsExpr RdrName } | '_' { L1 EWildPat } -- Template Haskell Extension - | TH_ID_SPLICE { L1 $ mkHsSpliceE - (L1 $ HsVar (mkUnqual varName - (getTH_ID_SPLICE $1))) } - | '$(' exp ')' { LL $ mkHsSpliceE $2 } - | TH_ID_TY_SPLICE { L1 $ mkHsSpliceTE - (L1 $ HsVar (mkUnqual varName - (getTH_ID_TY_SPLICE $1))) } - | '$$(' exp ')' { LL $ mkHsSpliceTE $2 } - + | splice_exp { $1 } | SIMPLEQUOTE qvar { LL $ HsBracket (VarBr True (unLoc $2)) } | SIMPLEQUOTE qcon { LL $ HsBracket (VarBr True (unLoc $2)) } @@ -1577,6 +1577,16 @@ aexp2 :: { LHsExpr RdrName } -- arrow notation extension | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) } +splice_exp :: { LHsExpr RdrName } + : TH_ID_SPLICE { L1 $ mkHsSpliceE + (L1 $ HsVar (mkUnqual varName + (getTH_ID_SPLICE $1))) } + | '$(' exp ')' { LL $ mkHsSpliceE $2 } + | TH_ID_TY_SPLICE { L1 $ mkHsSpliceTE + (L1 $ HsVar (mkUnqual varName + (getTH_ID_TY_SPLICE $1))) } + | '$$(' exp ')' { LL $ mkHsSpliceTE $2 } + cmdargs :: { [LHsCmdTop RdrName] } : cmdargs acmd { $2 : $1 } | {- empty -} { [] } |