Repository : ssh://g...@git.haskell.org/ghc
On branch : wip/th-new
Link :
http://ghc.haskell.org/trac/ghc/changeset/047b3b8c02f3e9b23948a7e259bcf73e87d9192e/ghc
>---------------------------------------------------------------
commit 047b3b8c02f3e9b23948a7e259bcf73e87d9192e
Author: Geoffrey Mainland <mainl...@apeiron.net>
Date: Thu May 16 16:47:06 2013 +0100
Clean up smart constructors for splices.
>---------------------------------------------------------------
047b3b8c02f3e9b23948a7e259bcf73e87d9192e
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 67b3d02..9871f42 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 eb7a4b2..97276b8 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 2546cde..8016a45 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,
_______________________________________________
ghc-commits mailing list
ghc-commits@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-commits
