Simplify dependencies (crucially, don't use TH)

README.md

@@ -162,4 +162,3 @@ cc-options: -pthread
 
 An example is `crypton`, see
 [crypton#33](https://github.com/kazu-yamamoto/crypton/pull/33) for details.
-

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

@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 -- | Instrumentation monad
 --
 -- Intended for unqualified import.
@@ -17,28 +15,17 @@ module Plugin.TraceForeignCalls.Instrument (
   ) where
 
 import Control.Monad
-import Control.Monad.Catch
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader
 
 import GHC
-import GHC.Plugins
+import GHC.Plugins hiding (getHscEnv)
 
-import GHC.Driver.Hooks
 import GHC.Tc.Types
-import GHC.Types.TyThing
 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
 -------------------------------------------------------------------------------}
@@ -48,26 +35,13 @@ data TracerEnv = TracerEnv {
     , tracerEnvNames   :: Names
     }
 
-newtype Instrument a = Wrap { unwrap :: ReaderT TracerEnv TcM a }
-  deriving newtype
-    ( -- base
-      Functor
-    , Applicative
-    , Monad
-    , MonadIO
-      -- exceptions
-    , MonadThrow
-    , MonadCatch
-    , MonadMask
-      -- ghc
-    , HasDynFlags
-    , MonadThings
-      -- trace-foreign-calls
-    , HasHscEnv
-    )
+newtype Instrument a = Wrap { unwrap :: TracerEnv -> TcM a }
 
 liftTcM :: TcM a -> Instrument a
-liftTcM = Wrap . lift
+liftTcM = Wrap . const
+
+getTracerEnv :: Instrument TracerEnv
+getTracerEnv = Wrap return
 
 runInstrument :: forall a. [String] -> Instrument a -> TcM a
 runInstrument rawOptions ma = do
@@ -79,16 +53,27 @@ runInstrument rawOptions ma = do
             , tracerEnvNames = mkNames
             }
 
-    runReaderT (unwrap ma) tracerEnv
+    unwrap ma tracerEnv
 
 {-------------------------------------------------------------------------------
-  Manual instances
-
-  Unfortunately many classes in GHC do not provide instances for transformers.
+  Instances
 -------------------------------------------------------------------------------}
 
-instance HasHooks    Instrument where getHooks         = liftTcM getHooks
-instance HasModule   Instrument where getModule        = liftTcM getModule
+instance Functor Instrument where
+  fmap = liftM
+
+instance Applicative Instrument where
+  pure x = Wrap $ \_env -> return x
+  (<*>)  = ap
+
+instance Monad Instrument where
+  x >>= f = Wrap $ \env -> unwrap x env >>= \a -> unwrap (f a) env
+
+instance MonadIO Instrument where
+  liftIO = liftTcM  . liftIO
+
+instance HasDynFlags Instrument where getDynFlags      = liftTcM getDynFlags
+instance HasHscEnv   Instrument where getHscEnv        = liftTcM getHscEnv
 instance HasLogger   Instrument where getLogger        = liftTcM getLogger
 instance MonadUnique Instrument where getUniqueSupplyM = liftTcM getUniqueSupplyM
 
@@ -97,7 +82,7 @@ instance MonadUnique Instrument where getUniqueSupplyM = liftTcM getUniqueSupply
 -------------------------------------------------------------------------------}
 
 asksOption :: (Options -> a) -> Instrument a
-asksOption f = Wrap $ asks (f . tracerEnvOptions)
+asksOption f = f . tracerEnvOptions <$> getTracerEnv
 
 whenOption :: (Options -> Bool) -> Instrument a -> Instrument (Maybe a)
 whenOption f ma = do
@@ -127,13 +112,13 @@ 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
-findName f = Wrap $ ReaderT $ f . tracerEnvNames
+findName f = Wrap $ f . tracerEnvNames

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

@@ -7,25 +7,21 @@ module Plugin.TraceForeignCalls.Util.GHC (
   , throwSimpleError
   , printSimpleWarning
     -- * Names
-  , resolveTHName
+  , resolveVarName
+  , resolveTcName
   ) where
 
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader
-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
 
@@ -39,9 +35,6 @@ class (MonadIO m, HasDynFlags m) => HasHscEnv m where
 instance HasHscEnv TcM where
   getHscEnv = env_top <$> getEnv
 
-instance HasHscEnv m => HasHscEnv (ReaderT r m) where
-  getHscEnv = lift getHscEnv
-
 {-------------------------------------------------------------------------------
   Internal auxiliary: using the 'HscEnv'
 -------------------------------------------------------------------------------}
@@ -56,9 +49,6 @@ getNamePprCtx =
 getDiagOpts :: HasHscEnv m => m DiagOpts
 getDiagOpts = initDiagOpts <$> getDynFlags
 
-getNameCache :: HasHscEnv m => m NameCache
-getNameCache = hsc_NC <$> getHscEnv
-
 {-------------------------------------------------------------------------------
   Errors and warnings
 -------------------------------------------------------------------------------}
@@ -96,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/test/Test/TraceForeignCalls/UsePlugin.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CApiFFI #-}
 {-# OPTIONS_GHC -fplugin=Plugin.TraceForeignCalls
                 -fplugin-opt Plugin.TraceForeignCalls:dump-generated
 #-}

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

@@ -25,14 +25,9 @@ source-repository head
 
 common lang
   build-depends:
-      -- ghc 9.6
       base >= 4.18 && < 4.19
   default-language:
       GHC2021
-  default-extensions:
-      CApiFFI
-      DerivingStrategies
-      UndecidableInstances
   ghc-options:
       -Wall
       -Wredundant-constraints
@@ -43,8 +38,6 @@ common lang
 library
   import:
       lang
-  other-extensions:
-      TemplateHaskell
   exposed-modules:
       Plugin.TraceForeignCalls
   other-modules:
@@ -54,10 +47,9 @@ library
   hs-source-dirs:
       src
   build-depends:
-    , exceptions       >= 0.10 && < 0.11
-    , ghc              >= 9.6  && < 9.7
-    , template-haskell >= 2.20 && < 2.21
-    , transformers     >= 0.6  && < 0.7
+      -- dependencies intentionally kept at a minimum
+      -- (we want to be able to build the boot libs with this plugin)
+    , ghc >= 9.6 && < 9.7
 
 test-suite test-trace-foreign-calls
   import: