diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-05-05 12:17:21 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-05-07 09:10:18 +0100 |
| commit | 931d014d4276d4213d8de4b1f5e51f0219b724dd (patch) | |
| tree | 7db1b55d253c55656c656edf68952c81a8c4b121 | |
| parent | d1295da3a4031cd102de77ab65d6d5b9b452213c (diff) | |
| download | haskell-931d014d4276d4213d8de4b1f5e51f0219b724dd.tar.gz | |
A bit of refactoring RnSplice
...to make clearer what the cross-stage lifting code
applies to (c.f. Trac #10384)
| -rw-r--r-- | compiler/rename/RnSplice.hs | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index a20640b07c..5306b6e800 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 */ {- |