[Git][ghc/ghc][wip/splice-imports-2024] 2 commits: trace

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/splice-imports-2024 at Glasgow Haskell Compiler / GHC


Commits:
0b49ac1d by Matthew Pickering at 2024-11-05T17:37:19+00:00
trace

- - - - -
b272697d by Matthew Pickering at 2024-11-05T17:41:50+00:00
fix order

- - - - -


2 changed files:

- compiler/GHC/Driver/Make.hs
- compiler/GHC/Tc/Solver/Monad.hs


Changes:

=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1600,7 +1600,6 @@ downsweep_imports hsc_env old_summaries excl_mods allow_dup_roots (root_errs, ro
    = do
        let root_map = mkRootMap rootSummariesOk
        checkDuplicates root_map
-       pprTraceM "roots" (ppr root_map)
        (deps, map0) <- loopSummaries (zip (repeat zeroStage) rootSummariesOk) (M.empty, root_map)
        let closure_errs = checkHomeUnitsClosed unit_env
            unit_env = hsc_unit_env hsc_env


=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -1437,14 +1437,14 @@ checkWellStagedDFun loc what pred
 checkCrossStageClass :: DynFlags -> StageCheckReason -> Set.Set ThLevel -> ThLevel
                             -> Bool -> TcM ()
 checkCrossStageClass dflags reason bind_lvl use_lvl is_local
-  | use_lvl `Set.member` bind_lvl = return ()
-  -- With path CSP, using later than bound is fine
-  | xopt LangExt.PathCrossStagedPersistence dflags
-  , any (use_lvl >=) bind_lvl  = return ()
   -- If the Id is imported, ie global, then allow with PathCrossStagedPersist
   | not is_local
   , xopt LangExt.PathCrossStagedPersistence dflags
   = return ()
+  | use_lvl `Set.member` bind_lvl = return ()
+  -- With path CSP, using later than bound is fine
+  | xopt LangExt.PathCrossStagedPersistence dflags
+  , any (use_lvl >=) bind_lvl  = return ()
   | otherwise = TcM.failWithTc (TcRnBadlyStaged reason bind_lvl use_lvl)
 
 
@@ -1458,8 +1458,6 @@ checkWellStagedInstanceWhat what
         cur_mod <- extractModule <$> getGblEnv
         hsc_env <- getTopEnv
         let tg = mkTransDepsZero (hsc_units hsc_env) (mgModSummaries' (hsc_mod_graph hsc_env))
-        pprTraceM "tg" (ppr tg)
-        pprTraceM "tg" (ppr $ mgModSummaries' (hsc_mod_graph hsc_env))
         let lkup s = Set.map (bimap (\(ModNodeKeyWithUid mn _ u,_) -> mkModule (RealUnit (Definite u)) (gwib_mod mn)) id) $ flip (Map.!) (Left (ModNodeKeyWithUid (GWIB (moduleName cur_mod) NotBoot) zeroStage (moduleUnitId cur_mod), s)) tg
         let splice_lvl = lkup SpliceStage
             normal_lvl = lkup NormalStage
@@ -1473,7 +1471,6 @@ checkWellStagedInstanceWhat what
         let lvls = [ 0 | instance_key `Set.member` splice_lvl]
                  ++ [ 1 | instance_key `Set.member` normal_lvl ]
                  ++ [ 2 | instance_key `Set.member` quote_lvl ]
-        pprTraceM "lvls" (ppr dfun_id $$ ppr splice_lvl $$ ppr normal_lvl $$ ppr quote_lvl)
         if isLocalId dfun_id
           then return $ Just ( (Set.singleton outerLevel, True) )
           else return $ Just ( Set.fromList lvls, False )



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48c4e78bd382f53846a30daa7d3f2ab1dbf17d55...b272697dbaae57edd7c770d39bc5325dbb7a04ba

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48c4e78bd382f53846a30daa7d3f2ab1dbf17d55...b272697dbaae57edd7c770d39bc5325dbb7a04ba
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/20241105/6b4bce84/attachment-0001.html>