diff options
| author | Geoffrey Mainland <mainland@apeiron.net> | 2013-05-16 16:47:06 +0100 |
|---|---|---|
| committer | Geoffrey Mainland <mainland@apeiron.net> | 2013-10-04 17:22:48 -0400 |
| commit | 047b3b8c02f3e9b23948a7e259bcf73e87d9192e (patch) | |
| tree | ad37b4123e5a804adcaa54e94f22139b7694f668 | |
| parent | 1e6a9410911475d5afb57fb4e6b6b29d85a1e13e (diff) | |
| download | haskell-047b3b8c02f3e9b23948a7e259bcf73e87d9192e.tar.gz | |
Clean up smart constructors for splices.
| -rw-r--r-- | compiler/hsSyn/HsUtils.lhs | 15 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 12 | ||||
| -rw-r--r-- | 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 67b3d0266f..9871f42612 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 eb7a4b2cdf..97276b8350 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1552,14 +1552,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 2546cdecaa..8016a4530f 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, mkTopSpliceDecl, mkRoleAnnotDecl, mkClassDecl, mkTyData, mkFamInstData, |