From 96dac7ab14199b2d2ea66ef9da77332d19e6a6d1 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Sat, 27 Apr 2024 10:47:53 +0200 Subject: [PATCH] Support ghc 9.10.1 (tested with alpha3) --- .github/workflows/haskell-ci.yml | 22 +++- cabal.project.plugin-9.10.0.20240413 | 11 ++ example-pkg-A/example-pkg-A.cabal | 3 +- example-pkg-B/example-pkg-B.cabal | 3 +- .../src/Plugin/TraceForeignCalls.hs | 19 ++-- .../Plugin/TraceForeignCalls/Instrument.hs | 13 ++- .../src/Plugin/TraceForeignCalls/Util/GHC.hs | 9 +- .../src/Plugin/TraceForeignCalls/Util/Shim.hs | 107 ++++++++++++++++++ trace-foreign-calls/trace-foreign-calls.cabal | 6 +- 9 files changed, 165 insertions(+), 28 deletions(-) create mode 100644 cabal.project.plugin-9.10.0.20240413 create mode 100644 trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/Shim.hs diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 9e32bd4..b15617c 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -28,6 +28,11 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.10.0.20240413 + compilerKind: ghc + compilerVersion: 9.10.0.20240413 + setup-method: ghcup + allow-failure: false - compiler: ghc-9.8.2 compilerKind: ghc compilerVersion: 9.8.2 @@ -72,7 +77,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91000)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -101,6 +106,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(example-pkg-A|example-pkg-B|trace-foreign-calls)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/cabal.project.plugin-9.10.0.20240413 b/cabal.project.plugin-9.10.0.20240413 new file mode 100644 index 0000000..0ce57c5 --- /dev/null +++ b/cabal.project.plugin-9.10.0.20240413 @@ -0,0 +1,11 @@ +import: cabal.project + +-- ghc 9.10.1-alpha3 +package * + ghc-options: + -package-db=/tmp/cabal-plugin-store/ghc-9.10.0.20240413/package.db + -fplugin-trustworthy + -plugin-package=trace-foreign-calls + -fplugin=Plugin.TraceForeignCalls + +store-dir: /tmp/cabal-plugin-store diff --git a/example-pkg-A/example-pkg-A.cabal b/example-pkg-A/example-pkg-A.cabal index 58cc146..520b108 100644 --- a/example-pkg-A/example-pkg-A.cabal +++ b/example-pkg-A/example-pkg-A.cabal @@ -14,12 +14,13 @@ extra-source-files: cbits/cbits.h cbits/cbits.c tested-with: GHC ==9.6.4 GHC ==9.8.2 + GHC ==9.10.1 common lang ghc-options: -Wall build-depends: - base >= 4.18 && < 4.20 + base >= 4.18 && < 4.21 default-language: GHC2021 diff --git a/example-pkg-B/example-pkg-B.cabal b/example-pkg-B/example-pkg-B.cabal index 7ba6417..9c4b3d9 100644 --- a/example-pkg-B/example-pkg-B.cabal +++ b/example-pkg-B/example-pkg-B.cabal @@ -14,12 +14,13 @@ category: Development build-type: Simple tested-with: GHC ==9.6.4 GHC ==9.8.2 + GHC ==9.10.1 common lang ghc-options: -Wall build-depends: - base >= 4.18 && < 4.20 + base >= 4.18 && < 4.21 default-language: GHC2021 diff --git a/trace-foreign-calls/src/Plugin/TraceForeignCalls.hs b/trace-foreign-calls/src/Plugin/TraceForeignCalls.hs index 51fcd7c..ac468ac 100644 --- a/trace-foreign-calls/src/Plugin/TraceForeignCalls.hs +++ b/trace-foreign-calls/src/Plugin/TraceForeignCalls.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Plugin.TraceForeignCalls (plugin) where @@ -20,6 +19,7 @@ import GHC.Types.SourceText import Plugin.TraceForeignCalls.Instrument import Plugin.TraceForeignCalls.Options import Plugin.TraceForeignCalls.Util.GHC +import Plugin.TraceForeignCalls.Util.Shim {------------------------------------------------------------------------------- Top-level @@ -171,12 +171,12 @@ mkWrapper rfi@ReplacedForeignImport { mHasCallStack :: Maybe (LHsType GhcRn) <- whenOption (not . optionsDisableCallStack) $ do hasCallStack <- findName nameHasCallStack - return $ noLocA $ HsTyVar EpAnnNotUsed NotPromoted (noLocA hasCallStack) + return $ noLocA $ HsTyVar noAnnotation NotPromoted (noLocA hasCallStack) return ( noLocA $ TypeSig - EpAnnNotUsed + noAnnotation [rfiOriginalName] HsWC { hswc_ext = [] @@ -199,15 +199,10 @@ mkWrapper rfi@ReplacedForeignImport { fun_ext = mkNameSet [unLoc rfiSuffixedName] -- TODO: what is this? , fun_id = rfiOriginalName , fun_matches = MG { -#if __GLASGOW_HASKELL__ == 906 - mg_ext = Generated -#endif -#if __GLASGOW_HASKELL__ >= 908 - mg_ext = Generated SkipPmc -#endif + mg_ext = originGenerated , mg_alts = noLocA . map noLocA $ [ Match { - m_ext = EpAnnNotUsed + m_ext = noAnnotation , m_ctxt = FunRhs { mc_fun = rfiOriginalName , mc_fixity = Prefix @@ -218,7 +213,7 @@ mkWrapper rfi@ReplacedForeignImport { grhssExt = emptyComments , grhssGRHSs = map noLocA [ GRHS - EpAnnNotUsed + noAnnotation [] -- guards body ] @@ -406,7 +401,7 @@ emptyWhereClause :: HsLocalBinds GhcRn emptyWhereClause = EmptyLocalBinds NoExtField stringExpr :: String -> LHsExpr GhcRn -stringExpr = noLocA . HsLit EpAnnNotUsed . HsString NoSourceText . fsLit +stringExpr = noLocA . HsLit undefined . HsString NoSourceText . fsLit callLNamedFn :: LIdP GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn callLNamedFn fn args = mkHsApps (noLocA $ HsVar NoExtField fn) args diff --git a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs index b565ff6..8122c62 100644 --- a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs +++ b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs @@ -25,6 +25,7 @@ import GHC.Utils.Logger import Plugin.TraceForeignCalls.Options import Plugin.TraceForeignCalls.Util.GHC +import Plugin.TraceForeignCalls.Util.Shim {------------------------------------------------------------------------------- Definition @@ -112,12 +113,12 @@ data Names = Names { mkNames :: Names mkNames = Names { - nameTraceEventIO = resolveVarName "Debug.Trace" "traceEventIO" - , nameEvaluate = resolveVarName "GHC.IO" "evaluate" - , nameUnsafePerformIO = resolveVarName "GHC.IO.Unsafe" "unsafePerformIO" - , nameHasCallStack = resolveTcName "GHC.Stack.Types" "HasCallStack" - , nameCallStack = resolveVarName "GHC.Stack" "callStack" - , namePrettyCallStack = resolveVarName "GHC.Exception" "prettyCallStack" + nameTraceEventIO = resolveVarName modlTraceEventIO "traceEventIO" + , nameEvaluate = resolveVarName modlEvaluate "evaluate" + , nameUnsafePerformIO = resolveVarName modlUnsafePerformIO "unsafePerformIO" + , nameHasCallStack = resolveTcName modlHasCallStack "HasCallStack" + , nameCallStack = resolveVarName modlCallStack "callStack" + , namePrettyCallStack = resolveVarName modlPrettyCallStack "prettyCallStack" } findName :: (Names -> TcM Name) -> Instrument Name diff --git a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs index d7060eb..f6e2d2f 100644 --- a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs +++ b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs @@ -101,13 +101,12 @@ printSimpleWarning l doc = do modules. -------------------------------------------------------------------------------} -resolveVarName :: String -> String -> TcM Name +resolveVarName :: Module -> String -> TcM Name resolveVarName = resolveName mkVarOcc -resolveTcName :: String -> String -> TcM Name +resolveTcName :: Module -> String -> TcM Name resolveTcName = resolveName mkTcOcc -- | Internal generalization -resolveName :: (String -> OccName) -> String -> String -> TcM Name -resolveName f modl name = - lookupOccRn $ Orig (mkModule baseUnit (mkModuleName modl)) (f name) +resolveName :: (String -> OccName) -> Module -> String -> TcM Name +resolveName f modl name = lookupOccRn $ Orig modl (f name) diff --git a/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/Shim.hs b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/Shim.hs new file mode 100644 index 0000000..16235b7 --- /dev/null +++ b/trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/Shim.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE CPP #-} + +-- | GHC shim +-- +-- All CPP should live in this module. +module Plugin.TraceForeignCalls.Util.Shim ( + -- * Constructing the AST + noAnnotation + , originGenerated + -- * Name resolution + , modlCallStack + , modlEvaluate + , modlHasCallStack + , modlPrettyCallStack + , modlTraceEventIO + , modlUnsafePerformIO + ) where + +import GHC +import GHC.Plugins + +{------------------------------------------------------------------------------- + Annotations +-------------------------------------------------------------------------------} + +#if __GLASGOW_HASKELL__ >= 910 + +noAnnotation :: NoAnn a => a +noAnnotation = noAnn + +#else + +class NoAnnotation a where + noAnnotation :: a + +instance NoAnnotation (EpAnn a) where + noAnnotation = EpAnnNotUsed + +#endif + +{------------------------------------------------------------------------------- + Origin +-------------------------------------------------------------------------------} + +originGenerated :: Origin +#if __GLASGOW_HASKELL__ == 906 +originGenerated = Generated +#endif +#if __GLASGOW_HASKELL__ == 908 +originGenerated = Generated SkipPmc +#endif +#if __GLASGOW_HASKELL__ >= 910 +originGenerated = Generated OtherExpansion SkipPmc +#endif + +{------------------------------------------------------------------------------- + Defining modules for various symbols +-------------------------------------------------------------------------------} + +modlTraceEventIO :: Module +modlTraceEventIO = +#if __GLASGOW_HASKELL__ < 910 + mkModule baseUnit $ mkModuleName "Debug.Trace" +#else + mkModule ghcInternalUnit $ mkModuleName "GHC.Internal.Debug.Trace" +#endif + +modlEvaluate :: Module +modlEvaluate = +#if __GLASGOW_HASKELL__ < 910 + mkModule baseUnit $ mkModuleName "GHC.IO" +#else + mkModule ghcInternalUnit $ mkModuleName "GHC.Internal.IO" +#endif + +modlUnsafePerformIO :: Module +modlUnsafePerformIO = +#if __GLASGOW_HASKELL__ < 910 + mkModule baseUnit $ mkModuleName "GHC.IO.Unsafe" +#else + mkModule ghcInternalUnit $ mkModuleName "GHC.Internal.IO.Unsafe" +#endif + +modlHasCallStack :: Module +modlHasCallStack = +#if __GLASGOW_HASKELL__ < 910 + mkModule baseUnit $ mkModuleName "GHC.Stack.Types" +#else + mkModule ghcInternalUnit $ mkModuleName "GHC.Internal.Stack.Types" +#endif + +modlCallStack :: Module +modlCallStack = +#if __GLASGOW_HASKELL__ < 910 + mkModule baseUnit $ mkModuleName "GHC.Stack" +#else + mkModule ghcInternalUnit $ mkModuleName "GHC.Internal.Stack" +#endif + +modlPrettyCallStack :: Module +modlPrettyCallStack = +#if __GLASGOW_HASKELL__ < 910 + mkModule baseUnit $ mkModuleName "GHC.Exception" +#else + mkModule ghcInternalUnit $ mkModuleName "GHC.Internal.Stack" +#endif + diff --git a/trace-foreign-calls/trace-foreign-calls.cabal b/trace-foreign-calls/trace-foreign-calls.cabal index 1eb7cbb..4aedee9 100644 --- a/trace-foreign-calls/trace-foreign-calls.cabal +++ b/trace-foreign-calls/trace-foreign-calls.cabal @@ -19,6 +19,7 @@ extra-source-files: test-cbits/test_cbits.h test-cbits/test_cbits.c tested-with: GHC ==9.6.4 GHC ==9.8.2 + GHC ==9.10.1 source-repository head type: git @@ -26,7 +27,7 @@ source-repository head common lang build-depends: - base >= 4.18 && < 4.20 + base >= 4.18 && < 4.21 default-language: GHC2021 ghc-options: @@ -45,12 +46,13 @@ library Plugin.TraceForeignCalls.Instrument Plugin.TraceForeignCalls.Options Plugin.TraceForeignCalls.Util.GHC + Plugin.TraceForeignCalls.Util.Shim hs-source-dirs: src build-depends: -- dependencies intentionally kept at a minimum -- (we want to be able to build the boot libs with this plugin) - , ghc >= 9.6 && < 9.9 + , ghc >= 9.6 && < 9.11 test-suite test-trace-foreign-calls import: