X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=42cb96f1016b1486c48cff56d57c0620753d7c7e;hp=e7c991b36a3bc6a99b6a96f0ccb7ea62aefc3526;hb=0a5613f40b0e32cf59966e6b56b807cdbe80aa7b;hpb=c75d5fc876279575226ec22a27ce056851128ade diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index e7c991b..42cb96f 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1013,10 +1013,10 @@ atype :: { LHsType RdrName } | '[:' ctype ':]' { LL $ HsPArrTy $2 } | '(' ctype ')' { LL $ HsParTy $2 } | '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) } - | '$(' exp ')' { LL $ HsSpliceTy (mkHsSplice $2 ) } - | TH_ID_SPLICE { LL $ HsSpliceTy (mkHsSplice - (L1 $ HsVar (mkUnqual varName - (getTH_ID_SPLICE $1)))) } -- $x + | quasiquote { L1 (HsQuasiQuoteTy (unLoc $1)) } + | '$(' exp ')' { LL $ mkHsSpliceTy $2 } + | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $ + mkUnqual varName (getTH_ID_SPLICE $1) } -- Generics | INTEGER { L1 (HsNumTy (getINTEGER $1)) } @@ -1044,7 +1044,7 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] } | {- empty -} { [] } tv_bndr :: { LHsTyVarBndr RdrName } - : tyvar { L1 (UserTyVar (unLoc $1)) } + : tyvar { L1 (UserTyVar (unLoc $1) placeHolderKind) } | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) (unLoc $4)) } @@ -1245,6 +1245,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } ----------------------------------------------------------------------------- -- 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 } @@ -1356,14 +1362,10 @@ aexp2 :: { LHsExpr RdrName } -- Template Haskell Extension | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice (L1 $ HsVar (mkUnqual varName - (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) } + (getTH_ID_SPLICE $1)))) } + | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $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)) } @@ -1372,8 +1374,8 @@ aexp2 :: { LHsExpr RdrName } | '[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) } @@ -1631,11 +1633,10 @@ fbinds1 :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) } | '..' { ([], True) } fbind :: { HsRecField RdrName (LHsExpr RdrName) } - : qvar '=' exp { HsRecField $1 $3 False } - | qvar { HsRecField $1 (L (getLoc $1) placeHolderPunRhs) True } - -- Here's where we say that plain 'x' - -- means exactly 'x = x'. The pun-flag boolean is - -- there so we can still print it right + : qvar '=' exp { HsRecField $1 $3 False } + | qvar { HsRecField $1 placeHolderPunRhs True } + -- In the punning case, use a place-holder + -- The renamer fills in the final value ----------------------------------------------------------------------------- -- Implicit Parameter Bindings