[commit: ghc] th-new: Clean up smart constructors for splices. (cef1d28)

[Geoffrey Mainland]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : th-new

https://github.com/ghc/ghc/commit/cef1d280d1567cd46e01b734d2c461dfebe8159b

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

commit cef1d280d1567cd46e01b734d2c461dfebe8159b
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 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,