[Git][ghc/ghc][wip/splice-imports-2024] basics
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Fri Oct 11 17:20:58 UTC 2024
Matthew Pickering pushed to branch wip/splice-imports-2024 at Glasgow Haskell Compiler / GHC
Commits:
9f6fc650 by Matthew Pickering at 2024-10-11T18:20:41+01:00
basics
- - - - -
17 changed files:
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Utils/Monad.hs
- testsuite/tests/splice-imports/SI01.hs
- testsuite/tests/splice-imports/SI02.hs
- testsuite/tests/splice-imports/SI03.hs
- testsuite/tests/splice-imports/SI04.hs
- testsuite/tests/splice-imports/SI05.hs
- testsuite/tests/splice-imports/SI06.hs
- testsuite/tests/splice-imports/SI07.hs
- testsuite/tests/splice-imports/SI08.hs
- testsuite/tests/splice-imports/SI09.hs
- testsuite/tests/splice-imports/SI10.hs
- testsuite/tests/splice-imports/SI11.hs
- testsuite/tests/splice-imports/SI13.hs
- testsuite/tests/th/overloaded/TH_overloaded_csp.hs
Changes:
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -311,8 +311,8 @@ finishHsVar :: LocatedA Name -> RnM (HsExpr GhcRn, FreeVars)
-- when renaming infix expressions
finishHsVar (L l name)
= do { this_mod <- getModule
- ; when (nameIsLocalOrFrom this_mod name) $
- checkThLocalName name
+-- ; when (nameIsLocalOrFrom this_mod name) $
+ ; checkThLocalName name
; return (HsVar noExtField (L (l2l l) name), unitFV name) }
rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -970,6 +970,9 @@ checkThLocalName name
| isUnboundName name -- Do not report two errors for
= return () -- $(not_in_scope args)
+ | isWiredInName name
+ = return ()
+
| otherwise
= do { traceRn "checkThLocalName" (ppr name)
; mb_local_use <- getStageAndBindLevel name
@@ -981,10 +984,11 @@ checkThLocalName name
; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl
<+> ppr use_stage
<+> ppr use_lvl)
- ; checkCrossStageLifting (StageCheckSplice name) top_lvl bind_lvl use_stage use_lvl name } } }
+ ; dflags <- getDynFlags
+ ; checkCrossStageLifting dflags (StageCheckSplice name) top_lvl bind_lvl use_stage use_lvl name } } }
--------------------------------------
-checkCrossStageLifting :: StageCheckReason -> TopLevelFlag -> Set.Set ThLevel -> ThStage -> ThLevel
+checkCrossStageLifting :: DynFlags -> StageCheckReason -> TopLevelFlag -> Set.Set 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
@@ -994,13 +998,16 @@ checkCrossStageLifting :: StageCheckReason -> TopLevelFlag -> Set.Set ThLevel ->
-- This code is similar to checkCrossStageLifting in GHC.Tc.Gen.Expr, but
-- this is only run on *untyped* brackets.
-checkCrossStageLifting reason top_lvl bind_lvl use_stage use_lvl name
+checkCrossStageLifting dflags reason top_lvl bind_lvl use_stage use_lvl name
| use_lvl `Set.member` bind_lvl = return ()
| Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets
= do
dflags <- getDynFlags
let err = TcRnBadlyStaged reason bind_lvl use_lvl
check_cross_stage_lifting err dflags top_lvl name ps_var
+ | Brack _ RnPendingTyped <- use_stage -- Lift for typed brackets is inserted later.
+ , xopt LangExt.LiftCrossStagedPersistence dflags
+ = return ()
| otherwise = addErrTc (TcRnBadlyStaged reason bind_lvl use_lvl)
check_cross_stage_lifting :: TcRnMessage -> DynFlags -> TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -1060,6 +1060,7 @@ checkThLocalId :: Id -> TcM ()
-- Here we just add constraints for cross-stage lifting
checkThLocalId id
= do { mb_local_use <- getStageAndBindLevel (idName id)
+ ; pprTraceM "local" (ppr id $$ ppr mb_local_use)
; case mb_local_use of
Just (top_lvl, bind_lvl, use_stage)
| thLevel use_stage `notElem` bind_lvl
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -218,7 +218,7 @@ import GHC.Types.Name.Ppr
import GHC.Types.Unique.FM ( emptyUFM )
import GHC.Types.Unique.Supply
import GHC.Types.Annotations
-import GHC.Types.Basic( TopLevelFlag, TypeOrKind(..) )
+import GHC.Types.Basic( TopLevelFlag(..), TypeOrKind(..) )
import GHC.Types.CostCentre.State
import GHC.Types.SourceFile
@@ -2079,7 +2079,10 @@ getStageAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevel, ThSt
getStageAndBindLevel name
= do { env <- getLclEnv;
; case lookupNameEnv (getLclEnvThBndrs env) name of
- Nothing -> return Nothing
+ Nothing -> do
+ lvls <- getExternalBindLvl name
+ pprTraceM "lvls" (ppr name $$ ppr lvls $$ ppr (getLclEnvThStage env))
+ return (Just (TopLevel, lvls, getLclEnvThStage env))
Just (top_lvl, bind_lvl) -> return (Just (top_lvl, Set.singleton bind_lvl, getLclEnvThStage env)) }
getExternalBindLvl :: Name -> TcRn (Set.Set ThLevel)
=====================================
testsuite/tests/splice-imports/SI01.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI01 where
=====================================
testsuite/tests/splice-imports/SI02.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI02 where
=====================================
testsuite/tests/splice-imports/SI03.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI03 where
=====================================
testsuite/tests/splice-imports/SI04.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI04 where
=====================================
testsuite/tests/splice-imports/SI05.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI04 where
=====================================
testsuite/tests/splice-imports/SI06.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
module SI06 where
import splice SI01A
=====================================
testsuite/tests/splice-imports/SI07.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI07 where
=====================================
testsuite/tests/splice-imports/SI08.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI08 where
=====================================
testsuite/tests/splice-imports/SI09.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI09 where
=====================================
testsuite/tests/splice-imports/SI10.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE SpliceImports #-}
+{-# LANGUAGE ExplicitStageImports #-}
{-# LANGUAGE TemplateHaskell #-}
module SI09 where
=====================================
testsuite/tests/splice-imports/SI11.hs
=====================================
@@ -2,9 +2,12 @@
{-# LANGUAGE TemplateHaskell #-}
module SI11 where
+import Language.Haskell.TH
+
-- Is path-based CSP banned?
data X = X
+x :: X -> Q Exp
x X = [| X |]
=====================================
testsuite/tests/splice-imports/SI13.hs
=====================================
@@ -2,8 +2,10 @@
{-# LANGUAGE TemplateHaskell #-}
module SI13 where
+import Language.Haskell.TH
import quote Prelude
+x :: Q Exp
x = [| id |]
=====================================
testsuite/tests/th/overloaded/TH_overloaded_csp.hs
=====================================
@@ -1,5 +1,6 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LiftCSP #-}
module Main where
-- A test to check that CSP works with overloaded quotes
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f6fc65014821360cceff29a387534367ad848a3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f6fc65014821360cceff29a387534367ad848a3
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241011/c307e3ac/attachment-0001.html>
More information about the ghc-commits
mailing list