Remove dependency on template-haskell

trace-foreign-calls/src/Plugin/TraceForeignCalls/Instrument.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 -- | Instrumentation monad
 --
 -- Intended for unqualified import.
@@ -28,12 +26,6 @@ import GHC.Utils.Logger
 import Plugin.TraceForeignCalls.Options
 import Plugin.TraceForeignCalls.Util.GHC
 
--- For name resolution
-import Debug.Trace qualified
-import Control.Exception qualified
-import System.IO.Unsafe qualified
-import GHC.Stack qualified
-
 {-------------------------------------------------------------------------------
   Definition
 -------------------------------------------------------------------------------}
@@ -120,12 +112,12 @@ data Names = Names {
 
 mkNames :: Names
 mkNames = Names {
-      nameTraceEventIO    = resolveTHName 'Debug.Trace.traceEventIO
-    , nameEvaluate        = resolveTHName 'Control.Exception.evaluate
-    , nameUnsafePerformIO = resolveTHName 'System.IO.Unsafe.unsafePerformIO
-    , nameHasCallStack    = resolveTHName ''GHC.Stack.HasCallStack
-    , nameCallStack       = resolveTHName 'GHC.Stack.callStack
-    , namePrettyCallStack = resolveTHName 'GHC.Stack.prettyCallStack
+      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"
     }
 
 findName :: (Names -> TcM Name) -> Instrument Name

trace-foreign-calls/src/Plugin/TraceForeignCalls/Util/GHC.hs

@@ -7,23 +7,21 @@ module Plugin.TraceForeignCalls.Util.GHC (
   , throwSimpleError
   , printSimpleWarning
     -- * Names
-  , resolveTHName
+  , resolveVarName
+  , resolveTcName
   ) where
 
-import Data.String
-import Language.Haskell.TH qualified as TH
-
 import GHC hiding (getNamePprCtx)
 import GHC.Plugins hiding (getNamePprCtx, getHscEnv)
 
 import GHC.Data.IOEnv
 import GHC.Driver.Config.Diagnostic
 import GHC.Driver.Errors
 import GHC.Driver.Errors.Types
+import GHC.Rename.Env
 import GHC.Runtime.Context
 import GHC.Tc.Types
 import GHC.Types.Error
-import GHC.Types.Name.Cache
 import GHC.Utils.Error
 import GHC.Utils.Logger
 
@@ -51,9 +49,6 @@ getNamePprCtx =
 getDiagOpts :: HasHscEnv m => m DiagOpts
 getDiagOpts = initDiagOpts <$> getDynFlags
 
-getNameCache :: HasHscEnv m => m NameCache
-getNameCache = hsc_NC <$> getHscEnv
-
 {-------------------------------------------------------------------------------
   Errors and warnings
 -------------------------------------------------------------------------------}
@@ -91,19 +86,28 @@ printSimpleWarning l doc = do
 
 {-------------------------------------------------------------------------------
   Names
+
+  If we use 'Qual' for the 'RdrName' then the module needs to have that module
+  imported. We could /add/ the import, but that has problems of its own
+  (spurious warnings). We therefore use 'Orig'; this does mean we need to
+  provide a unit, but we only lok things up from base (we'd have to change this
+  once we have the ghc-internals split). It also means we have to import the
+  definition from the /defining/ module, rather than it's true "home base" (it's
+  canonical exporting module).
+
+  A much simpler approach is to depend on TH to resolve names, and use
+  'thNameToGhcNameIO'. However, at present the resulting dependency on
+  @template-haskell@ would make the plugin unuseable for base or the boot
+  modules.
 -------------------------------------------------------------------------------}
 
-resolveTHName :: HasHscEnv m => TH.Name -> m Name
-resolveTHName name = do
-    nameCache <- getNameCache
-    mResolved <- liftIO $ thNameToGhcNameIO nameCache name
-    case mResolved of
-      Just name' ->
-        return name'
-      Nothing ->
-        throwSimpleError noSrcSpan $ hcat [
-            "Could not resolve TH name "
-          , fromString $ show name
-          ]
+resolveVarName :: String -> String -> TcM Name
+resolveVarName = resolveName mkVarOcc
 
+resolveTcName :: String -> 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)

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

@@ -38,8 +38,6 @@ common lang
 library
   import:
       lang
-  other-extensions:
-      TemplateHaskell
   exposed-modules:
       Plugin.TraceForeignCalls
   other-modules:
@@ -51,8 +49,7 @@ library
   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.7
-    , template-haskell >= 2.20 && < 2.21
+    , ghc >= 9.6 && < 9.7
 
 test-suite test-trace-foreign-calls
   import: