diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for breakpoint +## 0.1.5.0 -- 2025-08-14 +* Support GHC 9.12.x +* Drop support for 9.4 + ## 0.1.4.0 -- 2024-02-25 * Support GHC 9.10.x * Drop support for 9.2 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -89,7 +89,8 @@ with a blank line. ### Caveats -- Currently supports GHC version 9.2.x - 9.8.x +- Aims to support the 4 latest major GHC releases. Check the cabal file to see + which versions are currently supported. - Printing values may cause thunks to be evaluated earlier than they otherwise would which could be problematic for programs that rely heavily on laziness. - `ApplicativeDo` can sometimes cause variables that are in scope to not be traced. diff --git a/breakpoint.cabal b/breakpoint.cabal --- a/breakpoint.cabal +++ b/breakpoint.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: breakpoint -version: 0.1.4.0 +version: 0.1.5.0 synopsis: Set breakpoints using a GHC plugin @@ -13,7 +13,7 @@ license-file: LICENSE author: Aaron Allen maintainer: aaronallen8455@gmail.com -tested-with: GHC==9.10.1, GHC==9.8.1, GHC==9.6.1, GHC==9.4.2 +tested-with: GHC==9.12.1, GHC==9.10.1, GHC==9.8.1, GHC==9.6.1 bug-reports: https://github.com/aaronallen8455/breakpoint/issues -- A copyright notice. @@ -34,17 +34,17 @@ -- LANGUAGE extensions used by modules in this package. -- other-extensions: - build-depends: base >= 4.16.0.0 && < 4.21.0.0, - ghc >= 9.4.0 && < 9.11, - containers >= 0.6.5 && < 0.8, - mtl >= 2.2.2 && < 2.4, - transformers >= 0.5.6 && < 0.7, - haskeline >= 0.8.2 && < 0.9, - pretty-simple >= 4.1.2 && < 4.2, - text >= 1.2.5 && < 2.2, - template-haskell >= 2.18.0 && < 2.23, - ansi-terminal >= 1.0 && < 2.0, - deepseq >= 1.0 && < 1.6 + build-depends: base >= 4.18.0.0 && < 4.22.0.0, + ghc >= 9.6.0 && < 9.13, + containers >= 0.6.5 && < 0.9, + mtl >= 2.2.2 && < 2.4, + transformers >= 0.5.6 && < 0.7, + haskeline >= 0.8.2 && < 0.9, + pretty-simple >= 4.1.2 && < 4.2, + text >= 1.2.5 && < 2.2, + template-haskell >= 2.20.0 && < 2.24, + ansi-terminal >= 1.0 && < 2.0, + deepseq >= 1.0 && < 1.6 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Debug/Breakpoint/GhcFacade.hs b/src/Debug/Breakpoint/GhcFacade.hs --- a/src/Debug/Breakpoint/GhcFacade.hs +++ b/src/Debug/Breakpoint/GhcFacade.hs @@ -18,9 +18,10 @@ , pattern HsLet' , pattern OverLit' , pattern CDictCan' + , mkHsLam' ) where -#if MIN_VERSION_ghc(9,6,0) +#if MIN_VERSION_ghc(9,12,0) import GHC.Driver.Plugins as Ghc hiding (TcPlugin) import GHC.Hs.Extension as Ghc import Language.Haskell.Syntax as Ghc @@ -57,8 +58,9 @@ import GHC.Hs.Expr as Ghc import GHC.Types.PkgQual as Ghc import GHC.Tc.Types.Origin as Ghc +import GHC.Tc.Types.CtLoc as Ghc -#elif MIN_VERSION_ghc(9,4,0) +#elif MIN_VERSION_ghc(9,6,0) import GHC.Driver.Plugins as Ghc hiding (TcPlugin) import GHC.Hs.Extension as Ghc import Language.Haskell.Syntax as Ghc @@ -70,7 +72,6 @@ import GHC.Iface.Env as Ghc import GHC.Unit.Finder as Ghc import GHC.Unit.Types as Ghc -import GHC.Unit.Module.Name as Ghc import GHC.Tc.Utils.Monad as Ghc hiding (TcPlugin, DefaultingPlugin) import GHC.Data.FastString as Ghc import GHC.Hs.Utils as Ghc @@ -129,14 +130,8 @@ _ -> fail "Could not find module!" findPluginModule' :: Ghc.ModuleName -> Ghc.TcM Ghc.FindResult -#if MIN_VERSION_ghc(9,4,0) findPluginModule' modName = Ghc.runTcPluginM $ Plugin.findImportedModule modName Ghc.NoPkgQual -#else -findPluginModule' modName = do - hscEnv <- Ghc.getTopEnv - liftIO $ Ghc.findPluginModule hscEnv modName -#endif type LetToken = #if MIN_VERSION_ghc(9,10,0) @@ -192,3 +187,12 @@ <- Ghc.CDictCan { Ghc.cc_ev = diEv, Ghc.cc_class = diCls, Ghc.cc_tyargs = diTys } #endif +mkHsLam' + :: [LPat GhcRn] + -> LHsExpr GhcRn + -> LHsExpr GhcRn +#if MIN_VERSION_ghc(9,12,0) +mkHsLam' pats = Ghc.mkHsLam (Ghc.noLocA pats) +#else +mkHsLam' = Ghc.mkHsLam +#endif diff --git a/src/Debug/Breakpoint/Renamer.hs b/src/Debug/Breakpoint/Renamer.hs --- a/src/Debug/Breakpoint/Renamer.hs +++ b/src/Debug/Breakpoint/Renamer.hs @@ -22,6 +22,7 @@ import Data.Maybe import Data.Monoid (Any(..)) import Data.Traversable (for) +import GHC.Exts (fromList, toList) import qualified Debug.Breakpoint.GhcFacade as Ghc @@ -121,7 +122,7 @@ bpExpr = do resultName <- Ghc.newName (Ghc.mkOccName Ghc.varName "_result_") pure $ - Ghc.mkHsLam [Ghc.nlVarPat resultName] $ + Ghc.mkHsLam' [Ghc.nlVarPat resultName] $ Ghc.nlHsApp (Ghc.nlHsApp (Ghc.nlHsApp (Ghc.nlHsVar printAndWaitName) srcLocStringExpr) @@ -147,7 +148,7 @@ queryVarsExpr = do resultName <- Ghc.newName (Ghc.mkOccName Ghc.varName "_result_") pure $ - Ghc.mkHsLam [Ghc.nlVarPat resultName] $ + Ghc.mkHsLam' [Ghc.nlVarPat resultName] $ Ghc.nlHsApp (Ghc.nlHsApp (Ghc.nlHsApp (Ghc.nlHsVar runPromptName) srcLocStringExpr) @@ -231,7 +232,11 @@ matchCase :: Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn) -> EnvReader (Maybe (Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn))) matchCase Ghc.Match {..} = do +#if MIN_VERSION_ghc(9,12,0) + let names = (foldMap . foldMap) extractVarPats m_pats +#else let names = foldMap extractVarPats m_pats +#endif grhRes <- addScopedVars names $ recurse m_grhss pure $ Just Ghc.Match { Ghc.m_grhss = grhRes, .. } @@ -311,10 +316,6 @@ | otherwise = psb_ext pure $ Ghc.PatSynBind x Ghc.PSB { psb_def = defRes, psb_ext = rhsVars, .. } -#if !MIN_VERSION_ghc(9,4,0) - other -> pure other -#endif - grhsCase :: Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn) -> EnvReader (Maybe (Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn))) grhsCase (Ghc.GRHS x guards body) = do @@ -344,8 +345,8 @@ hlb@(Ghc.HsValBinds x valBinds) -> case valBinds of Ghc.ValBinds{} -> pure (hlb, mempty) Ghc.XValBindsLR (Ghc.NValBinds bindPairs sigs) -> do - let binds = Ghc.bagToList - . Ghc.unionManyBags + let binds = toList + . mconcat $ map snd bindPairs :: [Ghc.LHsBind Ghc.GhcRn] names = map (foldMap Ghc.collectHsBindBinders') binds @@ -419,7 +420,11 @@ tell names pure $ Ghc.LetStmt x bindsRes +#if MIN_VERSION_ghc(9,12,0) + Ghc.XStmtLR (Ghc.ApplicativeStmt x pairs mbJoin) -> do +#else Ghc.ApplicativeStmt x pairs mbJoin -> do +#endif let dealWithAppArg = \case a@Ghc.ApplicativeArgOne{..} -> do tell $ extractVarPats app_arg_pattern @@ -429,7 +434,11 @@ (stmtsRes, _) <- lift . runWriterT $ dealWithStatements app_stmts pure a {Ghc.app_stmts = stmtsRes} pairsRes <- (traverse . traverse) dealWithAppArg pairs +#if MIN_VERSION_ghc(9,12,0) + pure $ Ghc.XStmtLR (Ghc.ApplicativeStmt x pairsRes mbJoin) +#else pure $ Ghc.ApplicativeStmt x pairsRes mbJoin +#endif other -> lift $ gmapM recurse other @@ -514,7 +523,6 @@ binds_w_dus get_binds (Graph.AcyclicSCC (bind, _, _)) = - (Ghc.NonRecursive, Ghc.unitBag bind) + (Ghc.NonRecursive, fromList [bind]) get_binds (Graph.CyclicSCC binds_w_dus') = - (Ghc.Recursive, Ghc.listToBag [b | (b,_,_) <- binds_w_dus']) - + (Ghc.Recursive, fromList [b | (b,_,_) <- binds_w_dus'])