[commit: ghc] wip/spj-improvement: A bit of refactoring RnSplice (7f6e931)

[git at git.haskell.org]

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

On branch  : wip/spj-improvement
Link       : http://ghc.haskell.org/trac/ghc/changeset/7f6e931eee0856f08441cfac50c6dafdf858e489/ghc

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

commit 7f6e931eee0856f08441cfac50c6dafdf858e489
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)


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

7f6e931eee0856f08441cfac50c6dafdf858e489
 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 930cea3..4a857fd 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -586,17 +586,25 @@ 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 |]
 --            [| map |]
 
-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)
@@ -627,8 +635,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 */
 
 {-