[commit: ghc] wip/th-new: Clean up smart constructors for splices. (545632f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/th-new
Link       : http://ghc.haskell.org/trac/ghc/changeset/545632ff3980be668dcd2cbe08c929090ab12d85/ghc

>---------------------------------------------------------------

commit 545632ff3980be668dcd2cbe08c929090ab12d85
Author: Geoffrey Mainland <mainland at apeiron.net>
Date:   Thu May 16 16:47:06 2013 +0100

    Clean up smart constructors for splices.


>---------------------------------------------------------------

545632ff3980be668dcd2cbe08c929090ab12d85
 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 66aa32c..a4669ce 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 5c7005a..8cc310b 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 e22bdb5..e5e2166 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,