X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=e03993aab32ae5b16594b3ad3cce9b26e37930c8;hb=1fede4bc9501744bf2269ce2a4cb9fb735969caa;hp=7b92b810d71339729738d160b175ba5b033ddd19;hpb=389cca214f33a29646e08d57e3dca862140007b2;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 7b92b81..e03993a 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -64,7 +64,7 @@ import ErrUtils
 import SrcLoc
 import Outputable
 import Unique
-import Maybe
+import Data.Maybe
 import BasicTypes
 import Panic
 import FastString
@@ -233,7 +233,7 @@ tcBracket brack res_ty
        ; tcSimplifyBracket lie
 
 	-- Make the expected type have the right shape
-       ; boxyUnify meta_ty res_ty
+       ; _ <- boxyUnify meta_ty res_ty
 
 	-- Return the original expression, not the type-decorated one
        ; pendings <- readMutVar pending_splices
@@ -257,17 +257,17 @@ tc_bracket use_lvl (VarBr name) 	-- Note [Quoting names]
 
 tc_bracket _ (ExpBr expr) 
   = do	{ any_ty <- newFlexiTyVarTy liftedTypeKind
-	; tcMonoExprNC expr any_ty  -- NC for no context; tcBracket does that
+	; _ <- tcMonoExprNC expr any_ty  -- NC for no context; tcBracket does that
 	; tcMetaTy expQTyConName }
 	-- Result type is Expr (= Q Exp)
 
 tc_bracket _ (TypBr typ) 
-  = do	{ tcHsSigTypeNC ThBrackCtxt typ
+  = do	{ _ <- tcHsSigTypeNC ThBrackCtxt typ
 	; tcMetaTy typeQTyConName }
 	-- Result type is Type (= Q Typ)
 
 tc_bracket _ (DecBr decls)
-  = do	{  tcTopSrcDecls emptyModDetails decls
+  = do	{ _ <- tcTopSrcDecls emptyModDetails decls
 	-- Typecheck the declarations, dicarding the result
 	-- We'll get all that stuff later, when we splice it in
 
@@ -312,7 +312,7 @@ tcSpliceExpr (HsSplice name expr) res_ty
 	-- Here (h 4) :: Q Exp
 	-- but $(h 4) :: forall a.a 	i.e. anything!
 
-      unBox res_ty
+      _ <- unBox res_ty
       meta_exp_ty <- tcMetaTy expQTyConName
       expr' <- setStage (Splice next_level) (
                  setLIEVar lie_var    $
@@ -348,8 +348,7 @@ tcTopSplice expr res_ty = do
 
     traceTc (text "Got result" <+> ppr expr2)
 
-    showSplice "expression" 
-               zonked_q_expr (ppr expr2)
+    showSplice "expression" expr (ppr expr2)
 
         -- Rename it, but bale out if there are errors
         -- otherwise the type checker just gives more spurious errors
@@ -489,7 +488,7 @@ runQuasiQuote (HsQuasiQuote _name quoter q_span quote) quote_selector desc meta_
       	; traceTc (text "About to run" <+> ppr zonked_q_expr)
       	; result <- runMetaQ convert zonked_q_expr
       	; traceTc (text "Got result" <+> ppr result)
-      	; showSplice desc zonked_q_expr (ppr result)
+      	; showSplice desc quoteExpr (ppr result)
       	; return result
       	}
 
@@ -559,7 +558,7 @@ kcTopSpliceType expr
   
 	; traceTc (text "Got result" <+> ppr hs_ty2)
 
-	; showSplice "type" zonked_q_expr (ppr hs_ty2)
+	; showSplice "type" expr (ppr hs_ty2)
 
 	-- Rename it, but bale out if there are errors
 	-- otherwise the type checker just gives more spurious errors
@@ -591,7 +590,7 @@ tcSpliceDecls expr
 
 	; traceTc (text "Got result" <+> vcat (map ppr decls))
 	; showSplice "declarations"
-	  	     zonked_q_expr 
+	  	     expr 
 		     (ppr (getLoc expr) $$ (vcat (map ppr decls)))
 	; return decls }
 \end{code}
@@ -764,13 +763,18 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
 %************************************************************************
 
 \begin{code}
-showSplice :: String -> LHsExpr Id -> SDoc -> TcM ()
-showSplice what before after = do
-    loc <- getSrcSpanM
-    traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what, 
-		       nest 2 (sep [nest 2 (ppr before),
-				    text "======>",
-				    nest 2 after])])
+showSplice :: String -> LHsExpr Name -> SDoc -> TcM ()
+-- Note that 'before' is *renamed* but not *typechecked*
+-- Reason (a) less typechecking crap
+--        (b) data constructors after type checking have been
+--	      changed to their *wrappers*, and that makes them
+--	      print always fully qualified
+showSplice what before after
+  = do { loc <- getSrcSpanM
+       ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what, 
+		            nest 2 (sep [nest 2 (ppr before),
+				         text "======>",
+				         nest 2 after])]) }
 
 illegalBracket :: ThStage -> SDoc
 illegalBracket level