projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Simplify syntax for quasi-quotation
[ghc-hetmet.git]
/
compiler
/
parser
/
Parser.y.pp
diff --git
a/compiler/parser/Parser.y.pp
b/compiler/parser/Parser.y.pp
index
4cd637f
..
c56b0c1
100644
(file)
--- a/
compiler/parser/Parser.y.pp
+++ b/
compiler/parser/Parser.y.pp
@@
-45,7
+45,8
@@
import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
mkSrcLoc, mkSrcSpan )
import Module
import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
mkSrcLoc, mkSrcSpan )
import Module
import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
-import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
+import Type ( Kind, liftedTypeKind, unliftedTypeKind )
+import Coercion ( mkArrowKind )
import Class ( FunDep )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..), RuleMatchInfo(..), defaultInlinePragma )
import Class ( FunDep )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..), RuleMatchInfo(..), defaultInlinePragma )
@@
-1012,10
+1013,12
@@
atype :: { LHsType RdrName }
| '[:' ctype ':]' { LL $ HsPArrTy $2 }
| '(' ctype ')' { LL $ HsParTy $2 }
| '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
| '[:' ctype ':]' { LL $ HsPArrTy $2 }
| '(' ctype ')' { LL $ HsParTy $2 }
| '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
+ | quasiquote { L1 (HsQuasiQuoteTy (unLoc $1)) }
| '$(' exp ')' { LL $ HsSpliceTy (mkHsSplice $2 ) }
| TH_ID_SPLICE { LL $ HsSpliceTy (mkHsSplice
(L1 $ HsVar (mkUnqual varName
(getTH_ID_SPLICE $1)))) } -- $x
| '$(' exp ')' { LL $ HsSpliceTy (mkHsSplice $2 ) }
| TH_ID_SPLICE { LL $ HsSpliceTy (mkHsSplice
(L1 $ HsVar (mkUnqual varName
(getTH_ID_SPLICE $1)))) } -- $x
+
-- Generics
| INTEGER { L1 (HsNumTy (getINTEGER $1)) }
-- Generics
| INTEGER { L1 (HsNumTy (getINTEGER $1)) }
@@
-1167,7
+1170,9
@@
deriving :: { Located (Maybe [LHsType RdrName]) }
-----------------------------------------------------------------------------
-- Value definitions
-----------------------------------------------------------------------------
-- Value definitions
-{- There's an awkward overlap with a type signature. Consider
+{- Note [Declaration/signature overlap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's an awkward overlap with a type signature. Consider
f :: Int -> Int = ...rhs...
Then we can't tell whether it's a type signature or a value
definition with a result signature until we see the '='.
f :: Int -> Int = ...rhs...
Then we can't tell whether it's a type signature or a value
definition with a result signature until we see the '='.
@@
-1219,10
+1224,9
@@
gdrh :: { LGRHS RdrName }
: '|' guardquals '=' exp { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
: '|' guardquals '=' exp { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
- : infixexp '::' sigtypedoc
- {% do s <- checkValSig $1 $3;
- return (LL $ unitOL (LL $ SigD s)) }
- -- See the above notes for why we need infixexp here
+ : infixexp '::' sigtypedoc {% do s <- checkValSig $1 $3
+ ; return (LL $ unitOL (LL $ SigD s)) }
+ -- See Note [Declaration/signature overlap] for why we need infixexp here
| var ',' sig_vars '::' sigtypedoc
{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| var ',' sig_vars '::' sigtypedoc
{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
@@
-1243,6
+1247,12
@@
sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
-----------------------------------------------------------------------------
-- Expressions
-----------------------------------------------------------------------------
-- Expressions
+quasiquote :: { Located (HsQuasiQuote RdrName) }
+ : TH_QUASIQUOTE { let { loc = getLoc $1
+ ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
+ ; quoterId = mkUnqual varName quoter }
+ in L1 (mkHsQuasiQuote quoterId quoteSpan quote) }
+
exp :: { LHsExpr RdrName }
: infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
| infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
exp :: { LHsExpr RdrName }
: infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
| infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
@@
-1357,11
+1367,7
@@
aexp2 :: { LHsExpr RdrName }
(getTH_ID_SPLICE $1)))) } -- $x
| '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
(getTH_ID_SPLICE $1)))) } -- $x
| '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
- | TH_QUASIQUOTE { let { loc = getLoc $1
- ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
- ; quoterId = mkUnqual varName quoter
- }
- in sL loc $ HsQuasiQuoteE (mkHsQuasiQuote quoterId quoteSpan quote) }
+
| TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
@@
-1370,8
+1376,8
@@
aexp2 :: { LHsExpr RdrName }
| '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
| '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
return (LL $ HsBracket (PatBr p)) }
| '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
| '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
return (LL $ HsBracket (PatBr p)) }
- | '[d|' cvtopbody '|]' {% checkDecBrGroup $2 >>= \g ->
- return (LL $ HsBracket (DecBr g)) }
+ | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBrL $2) }
+ | quasiquote { L1 (HsQuasiQuoteE (unLoc $1)) }
-- arrow notation extension
| '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
-- arrow notation extension
| '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
@@
-1415,7
+1421,7
@@
texp :: { LHsExpr RdrName }
| qopm infixexp { LL $ SectionR $1 $2 }
-- View patterns get parenthesized above
| qopm infixexp { LL $ SectionR $1 $2 }
-- View patterns get parenthesized above
- | exp '->' exp { LL $ EViewPat $1 $3 }
+ | exp '->' texp { LL $ EViewPat $1 $3 }
-- Always at least one comma
tup_exprs :: { [HsTupArg RdrName] }
-- Always at least one comma
tup_exprs :: { [HsTupArg RdrName] }