[commit: ghc] master: A bit of refactoring RnSplice (931d014)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/931d014d4276d4213d8de4b1f5e51f0219b724dd/ghc

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

commit 931d014d4276d4213d8de4b1f5e51f0219b724dd
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue May 5 12:17:21 2015 +0100

    A bit of refactoring RnSplice
    
    ...to make clearer what the cross-stage lifting code
    applies to (c.f. Trac #10384)


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

931d014d4276d4213d8de4b1f5e51f0219b724dd
 compiler/rename/RnSplice.hs | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index a20640b..5306b6e 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -586,11 +586,11 @@ checkThLocalName name
     do  { let use_lvl = thLevel use_stage
         ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
         ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
-        ; when (use_lvl > bind_lvl) $
-          checkCrossStageLifting top_lvl name use_stage } } }
+        ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
 
 --------------------------------------
-checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM ()
+checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
+                       -> Name -> TcM ()
 -- We are inside brackets, and (use_lvl > bind_lvl)
 -- Now we must check whether there's a cross-stage lift to do
 -- Examples   \x -> [| x |]
@@ -599,7 +599,15 @@ checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM ()
 -- This code is similar to checkCrossStageLifting in TcExpr, but
 -- this is only run on *untyped* brackets.
 
-checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var))
+checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
+  | Brack _ (RnPendingUntyped ps_var) <- use_stage   -- Only for untyped brackets
+  , use_lvl > bind_lvl                               -- Cross-stage condition
+  = check_cross_stage_lifting top_lvl name ps_var
+  | otherwise
+  = return ()
+
+check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
+check_cross_stage_lifting top_lvl name ps_var
   | isTopLevel top_lvl
         -- Top-level identifiers in this module,
         -- (which have External Names)
@@ -630,8 +638,6 @@ checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var))
           -- Update the pending splices
         ; ps <- readMutVar ps_var
         ; writeMutVar ps_var (pend_splice : ps) }
-
-checkCrossStageLifting _ _ _ = return ()
 #endif /* GHCI */
 
 {-