X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcSplice.lhs;h=ddd7ace056910c66e8d3c7e60e13e662bd4bb76a;hb=53fe941370fd7fc90bf2e725f0f0b7c0382ceb4e;hp=1a488215e5cc0e075fcc4a41890ced37574a038f;hpb=4ab2b24ec244b5b9e7c1df1bb7093f110fc04b02;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
index 1a48821..ddd7ace 100644
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ b/ghc/compiler/typecheck/TcSplice.lhs
@@ -13,9 +13,9 @@ import TcRnDriver	( tcTopSrcDecls )
 	-- These imports are the reason that TcSplice 
 	-- is very high up the module hierarchy
 
-import qualified Language.Haskell.TH.THSyntax as TH
-import qualified Language.Haskell.TH.THLib    as TH
+import qualified Language.Haskell.TH as TH
 -- THSyntax gives access to internal functions and data types
+import qualified Language.Haskell.TH.Syntax as TH
 
 import HsSyn		( HsBracket(..), HsExpr(..), HsSplice(..), LHsExpr, LHsDecl, 
 		   	  HsType, LHsType )
@@ -100,6 +100,7 @@ tcBracket brack res_ty
    	-- Typecheck expr to make sure it is valid,
 	-- but throw away the results.  We'll type check
 	-- it again when we actually use it.
+    recordThUse				`thenM_`
     newMutVar []	 		`thenM` \ pending_splices ->
     getLIEVar				`thenM` \ lie_var ->
 
@@ -159,8 +160,8 @@ tcSpliceExpr (HsSplice name expr) res_ty
 	Just next_level -> 
 
     case level of {
-	Comp 		       -> do { e <- tcTopSplice expr res_ty ;
-				       returnM (unLoc e) };
+	Comp 		       -> do { e <- tcTopSplice expr res_ty
+				     ; returnM (unLoc e) } ;
 	Brack _ ps_var lie_var ->  
 
 	-- A splice inside brackets
@@ -226,16 +227,19 @@ tcTopSpliceExpr expr meta_ty
   = checkNoErrs $	-- checkNoErrs: must not try to run the thing
 			--	        if the type checker fails!
 
-    setStage topSpliceStage $
+    setStage topSpliceStage $ do
 
-	-- Typecheck the expression
-    getLIE (tcCheckRho expr meta_ty)	`thenM` \ (expr', lie) ->
+	
+    do	{ recordThUse	-- Record that TH is used (for pkg depdendency)
 
+	-- Typecheck the expression
+	; (expr', lie) <- getLIE (tcCheckRho expr meta_ty)
+	
 	-- Solve the constraints
-    tcSimplifyTop lie			`thenM` \ const_binds ->
+	; const_binds <- tcSimplifyTop lie
 	
 	-- And zonk it
-    zonkTopLExpr (mkHsLet const_binds expr')
+	; zonkTopLExpr (mkHsLet const_binds expr') }
 \end{code}
 
 
@@ -481,7 +485,7 @@ mk_uniq :: Int# -> Unique
 mk_uniq u = mkUniqueGrimily (I# u)
 
 notInScope :: TH.Name -> SDoc
-notInScope th_name = quotes (text (show (TH.pprName th_name))) <+> 
+notInScope th_name = quotes (text (TH.pprint th_name)) <+> 
 		     ptext SLIT("is not in scope at a reify")
 	-- Ugh! Rather an indirect way to display the name