Support ghc 9.10.1 (tested with alpha3)

.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 <<EOF
+          repository head.hackage.ghc.haskell.org
+             url: https://ghc.gitlab.haskell.org/head.hackage/
+             secure: True
+             root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d
+                        26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
+                        f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
+             key-threshold: 3
+          active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override
+          EOF
+          fi
           cat >> $CABAL_CONFIG <<EOF
           program-default-options
             ghc-options: $GHCJOBS +RTS -M3G -RTS
@@ -175,6 +192,9 @@ jobs:
             tests:       True
             ghc-options: -Werror
           EOF
+          if $HEADHACKAGE; then
+          echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> 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

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

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
 

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
 

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

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

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)

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
+

trace-foreign-calls/trace-foreign-calls.cabal

@@ -19,14 +19,15 @@ 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
   location: https://github.com/well-typed/trace-foreign-calls
 
 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: