[commit: ghc] : Clean up smart constructors for splices. (22a2ba0)
Geoffrey Mainland
gmainlan at microsoft.com
Thu Jun 27 11:41:25 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch :
https://github.com/ghc/ghc/commit/22a2ba0dcc6e3688ddfff535d392ab55aceca469
>---------------------------------------------------------------
commit 22a2ba0dcc6e3688ddfff535d392ab55aceca469
Author: Geoffrey Mainland <mainland at apeiron.net>
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 6810599..7fc5478 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -55,7 +55,7 @@ module HsUtils(
emptyRecStmt, mkRecStmt,
-- Template Haskell
- unqualSplice, mkHsSpliceTy, mkHsSplice, mkHsTExpSplice, mkHsQuasiQuote, unqualQuasiQuote,
+ unqualSplice, mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsQuasiQuote, unqualQuasiQuote,
-- Flags
noRebindableInfo,
@@ -243,14 +243,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 d7874da..4b22e0a 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1484,14 +1484,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 a5be4e1..1aebd6c 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, mkFamInstSynonym,
More information about the ghc-commits
mailing list