Repository : http://darcs.haskell.org/ghc.git/
On branch : th-new https://github.com/ghc/ghc/commit/48bb7aef772259dbf716b64a3cf1bb23919c0921 >--------------------------------------------------------------- commit 48bb7aef772259dbf716b64a3cf1bb23919c0921 Author: Geoffrey Mainland <[email protected]> Date: Thu May 16 16:47:06 2013 +0100 Clean up smart constructors for splices. >--------------------------------------------------------------- compiler/hsSyn/HsUtils.lhs | 15 +++++++++------ compiler/parser/Parser.y.pp | 12 ++++++------ compiler/parser/RdrHsSyn.lhs | 2 +- 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 657b3d7..c11df34 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -54,7 +54,7 @@ module HsUtils( emptyRecStmt, mkRecStmt, -- Template Haskell - unqualSplice, mkHsSpliceTy, mkHsSplice, mkHsTExpSplice, mkHsQuasiQuote, unqualQuasiQuote, + unqualSplice, mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsQuasiQuote, unqualQuasiQuote, -- Flags noRebindableInfo, @@ -246,14 +246,17 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts } mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2 -mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName -mkHsSplice e = HsSplice False unqualSplice e +mkHsSplice :: Bool -> LHsExpr RdrName -> HsSplice RdrName +mkHsSplice isTyped e = HsSplice isTyped unqualSplice e -mkHsTExpSplice :: LHsExpr RdrName -> HsSplice RdrName -mkHsTExpSplice e = HsSplice True unqualSplice e +mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName +mkHsSpliceE e = HsSpliceE (mkHsSplice False e) + +mkHsSpliceTE :: LHsExpr RdrName -> HsExpr RdrName +mkHsSpliceTE e = HsSpliceE (mkHsSplice True e) mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName -mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind +mkHsSpliceTy e = HsSpliceTy (mkHsSplice False e) emptyFVs placeHolderKind unqualSplice :: RdrName unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index c4c3dd2..9777219 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1537,14 +1537,14 @@ aexp2 :: { LHsExpr RdrName } | '_' { L1 EWildPat } -- Template Haskell Extension - | TH_ID_SPLICE { L1 $ HsSpliceE (mkHsSplice + | TH_ID_SPLICE { L1 $ mkHsSpliceE (L1 $ HsVar (mkUnqual varName - (getTH_ID_SPLICE $1)))) } - | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } - | TH_ID_TY_SPLICE { L1 $ HsSpliceE (mkHsTExpSplice + (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 $ HsSpliceE (mkHsTExpSplice $2) } + (getTH_ID_TY_SPLICE $1))) } + | '$$(' exp ')' { LL $ mkHsSpliceTE $2 } | SIMPLEQUOTE qvar { LL $ HsBracket (VarBr True (unLoc $2)) } diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 87962d3..7880742 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -7,7 +7,7 @@ Functions over HsSyn specialised to RdrName. module RdrHsSyn ( mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, - mkHsDo, mkHsSplice, mkTopSpliceDecl, + mkHsDo, mkHsSpliceE, mkTopSpliceDecl, mkClassDecl, mkTyData, mkFamInstData, mkTySynonym, mkTyFamInstEqn, mkTyFamInstGroup, _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
