aaronallen8455/graph-trace
1
1
Fork 0
mirror of https://github.com/aaronallen8455/graph-trace.git synced 2024-09-11 09:05:34 +03:00
Code Issues Projects Releases Wiki Activity

good progress

Browse Source
This commit is contained in:
Aaron Allen 2021-10-10 18:18:55 -05:00
parent d70b442577
commit 4b280fd824
4 changed files with 360 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
DebugPlugin.cabal
View File

@ -25,6 +25,7 @@ library
, ghc
, containers
, syb
, template-haskell
hs-source-dirs: src
executable exe

25
Main.hs
View File

@ -1,21 +1,34 @@
{-# OPTIONS_GHC -fplugin=Debug #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE DataKinds #-}
import System.IO.Unsafe (unsafePerformIO)
import GHC.Stack
main :: IO ()
import Debug
main :: Debug "main" => IO ()
main = do
let ?_debug_ip = (Nothing, "test")
--let ?_debug_ip = "insert"
test
-- test :: (?_debug_ip :: (Maybe String, String)) => IO ()
-- test = test2
test :: (?_debug_ip :: (Maybe String, String)) => IO ()
test = print (?_debug_ip :: (Maybe String, String))
trace :: (?_debug_ip :: String) => IO ()
trace = putStrLn ?_debug_ip
test :: Debug "blah" => IO ()
test = do
trace
trace
another
another :: Debug "another2" => IO ()
another = trace
-- test :: (?x :: String) => IO ()
-- test = print ?x
blah :: ()
blah = unsafePerformIO $ putStrLn "test"
st :: Debug "..." => IO ()
st = putStrLn "..."

11
Test.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ConstraintKinds #-}
@ -9,9 +10,9 @@ import GHC.TypeLits
type Debug (str :: Symbol) = (?x :: String)
test :: (Debug "yo", Num r) => r -> IO String
test _ = do
x <- getLine
let ?x = x
pure ?x
test :: Debug "yo" => String
test = let ?x = newIP in
do ?x
where
newIP = ?x <> "test"

410
src/Debug.hs
View File

@ -1,13 +1,23 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Debug where
import Control.Applicative ((<|>))
import Control.Monad.IO.Class (liftIO)
import Data.Foldable
import Data.Traversable
import Data.IORef
import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.Maybe
import GHC.TypeLits (Symbol)
import qualified Language.Haskell.TH as TH
import qualified GHC.Builtin.Names as Ghc
import qualified GHC.Builtin.Types as Ghc
@ -16,15 +26,25 @@ import qualified GHC.Core.Class as Ghc
import qualified GHC.Core.Make as Ghc
import qualified GHC.Core.Type as Ghc
import qualified GHC.Core.Utils as Ghc
import qualified GHC.Data.Bag as Ghc
import qualified GHC.Data.FastString as Ghc
import qualified GHC.Driver.Finder as Ghc
import qualified GHC.Driver.Plugins as Ghc hiding (TcPlugin)
import qualified GHC.Driver.Types as Ghc
import qualified GHC.Hs.Binds as Ghc
import qualified GHC.Hs.Decls as Ghc
import qualified GHC.Hs.Expr as Ghc
import qualified GHC.Hs.Extension as Ghc
import qualified GHC.Tc.Plugin as Ghc
import qualified GHC.Hs.Type as Ghc
import qualified GHC.Iface.Env as Ghc
import qualified GHC.Rename.Expr as Ghc
import qualified GHC.Tc.Plugin as Ghc hiding (lookupOrig, findImportedModule, getTopEnv)
import qualified GHC.Tc.Types as Ghc
import qualified GHC.Tc.Types.Constraint as Ghc
import qualified GHC.Tc.Types.Evidence as Ghc
import qualified GHC.Tc.Types.Origin as Ghc
import qualified GHC.Tc.Utils.Monad as Ghc
import qualified GHC.ThToHs as Ghc
import qualified GHC.Types.Basic as Ghc
import qualified GHC.Types.Id as Ghc
import qualified GHC.Types.Name as Ghc hiding (varName)
@ -32,32 +52,254 @@ import qualified GHC.Types.Name.Occurrence as Ghc hiding (varName)
import qualified GHC.Types.SrcLoc as Ghc
import qualified GHC.Types.Unique.Supply as Ghc
import qualified GHC.Types.Var as Ghc
import qualified GHC.Unit.Module.Name as Ghc
import qualified GHC.Utils.Outputable as Ghc
import Data.Generics (everywhereM, mkM)
--type family DebugKey (key :: Symbol) :: Constraint
type Debug (key :: Symbol) = (?_debug_ip :: String) -- (DebugKey key, ?_debug_ip :: String)
plugin :: Ghc.Plugin
plugin =
Ghc.defaultPlugin
{ Ghc.pluginRecompile = Ghc.purePlugin
, Ghc.tcPlugin = \_ -> Just tcPlugin
, Ghc.typeCheckResultAction = const typeCheckResultAction
-- , Ghc.typeCheckResultAction = const typeCheckResultAction
, Ghc.renamedResultAction = const renamedResultAction
}
typeCheckResultAction :: Ghc.ModSummary -> Ghc.TcGblEnv -> Ghc.TcM Ghc.TcGblEnv
typeCheckResultAction _modSummary tcGblEnv = do
x <- mkM test `everywhereM` Ghc.tcg_binds tcGblEnv
pure tcGblEnv
renamedResultAction :: Ghc.TcGblEnv -> Ghc.HsGroup Ghc.GhcRn
-> Ghc.TcM (Ghc.TcGblEnv, Ghc.HsGroup Ghc.GhcRn)
renamedResultAction tcGblEnv
hsGroup@Ghc.HsGroup
{ Ghc.hs_valds =
Ghc.XValBindsLR (Ghc.NValBinds binds sigs)
}
= do
hscEnv <- Ghc.getTopEnv
test :: Ghc.LHsExpr Ghc.GhcTc -> Ghc.TcM ( Ghc.LHsExpr Ghc.GhcTc )
test = undefined
Ghc.Found _ debugModule <- liftIO $
Ghc.findImportedModule hscEnv (Ghc.mkModuleName "Debug") Nothing
debugPredName <- Ghc.lookupOrig debugModule (Ghc.mkClsOcc "Debug")
let keyMap = M.fromList
$ concatMap (sigUsesDebugPred debugPredName) (Ghc.unLoc <$> sigs)
binds' <-
(traverse . traverse . traverse . traverse)
(modifyBinding keyMap)
binds
pure (tcGblEnv, hsGroup { Ghc.hs_valds = Ghc.XValBindsLR $ Ghc.NValBinds binds' sigs })
renamedResultAction tcGblEnv group = pure (tcGblEnv, group)
-- | If a sig contains the Debug constraint, get the name of the corresponding
-- binding.
--
-- Are there ever more than one name in the TypeSig? yes:
-- one, two :: Debug x => ...
sigUsesDebugPred :: Ghc.Name -> Ghc.Sig Ghc.GhcRn -> [(Ghc.Name, String)]
sigUsesDebugPred debugPredName
(Ghc.TypeSig _ lNames (Ghc.HsWC _ (Ghc.HsIB _
(Ghc.L _ (Ghc.HsQualTy _ (Ghc.L _ ctx) _))))) = concat $ do
key <- listToMaybe
$ mapMaybe (checkForDebugPred debugPredName) (Ghc.unLoc <$> ctx)
Just $ zip (Ghc.unLoc <$> lNames) (repeat key)
sigUsesDebugPred _ _ = []
-- TODO need to recurse through HsValBinds. Use syb for this?
checkForDebugPred :: Ghc.Name -> Ghc.HsType Ghc.GhcRn -> Maybe String
checkForDebugPred debugPredName
(Ghc.HsAppTy _ (Ghc.L _ (Ghc.HsTyVar _ _ (Ghc.L _ name))) (Ghc.L _ (Ghc.HsTyLit _ (Ghc.HsStrTy _ key))))
-- TODO pass in Debug name
| name == debugPredName = Just $ Ghc.unpackFS key
checkForDebugPred n (Ghc.HsForAllTy _ _ (Ghc.L _ ty)) = checkForDebugPred n ty
checkForDebugPred n (Ghc.HsParTy _ (Ghc.L _ ty)) = checkForDebugPred n ty
checkForDebugPred _ _ = Nothing
-- need a case for nested QualTy?
modifyBinding
:: M.Map Ghc.Name String
-> Ghc.HsBindLR Ghc.GhcRn Ghc.GhcRn
-> Ghc.TcM (Ghc.HsBindLR Ghc.GhcRn Ghc.GhcRn)
modifyBinding keyMap
bnd@(Ghc.FunBind _ (Ghc.L _ name) mg@(Ghc.MG _ alts _) _)
| Just key <- M.lookup name keyMap
= do
newAlts <- (traverse . traverse . traverse) (modifyMatch key) alts
pure bnd{Ghc.fun_matches = mg{ Ghc.mg_alts = newAlts }}
modifyBinding _ bnd = pure bnd
-- Oops, IP don't play well with where clauses... will not be able to debug from
-- inside a where bound function.
-- Solution: can iterate through the where bound functions and recursively
-- insert the alteration. Doesn't work because we are going to be doing
-- unsafe IO and the random identifier that gets produced must be the same
-- across all things within that scope.
-- Solution: We insert two pieces of code: 1) a where clause where the new
-- identifier is bound and 2) the let statements to bind the IP to that new val,
-- this way the val is shared across all scopes.
--
-- The new plan:
-- For each FunBind that has a Debug constraint, add a where clause that binds
-- a 'newIP' variable which makes the new debug key from the old one.
-- In all function bodies, add a let binding that binds the IP to this new
-- value. This will probably entail tracking the name of the where bound var.
-- | Add a where bind for the new value of the IP, then add let bindings to the
-- front of each GRHS to set the new value of the IP in that scope.
modifyMatch
:: String
-> Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> Ghc.TcM (Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn))
modifyMatch key
m@Ghc.Match
{ Ghc.m_grhss =
grhs@Ghc.GRHSs
{ Ghc.grhssGRHSs = grhss
, Ghc.grhssLocalBinds = Ghc.L whereLoc whereBinds
}
} = do
uniq <- Ghc.getUniqueM
let whereBindName = Ghc.mkSystemVarName uniq "new_debug_ip"
whereBindExpr <- mkWhereBind key
let bind = Ghc.FunBind
{ Ghc.fun_ext = mempty
, Ghc.fun_id = Ghc.noLoc whereBindName
, Ghc.fun_matches =
Ghc.MG
{ Ghc.mg_ext = Ghc.NoExtField
, Ghc.mg_alts = Ghc.noLoc
[Ghc.noLoc Ghc.Match
{ Ghc.m_ext = Ghc.NoExtField
, Ghc.m_ctxt = Ghc.FunRhs
{ Ghc.mc_fun = Ghc.noLoc whereBindName
, Ghc.mc_fixity = Ghc.Prefix
, Ghc.mc_strictness = Ghc.NoSrcStrict
}
, Ghc.m_pats = []
, Ghc.m_grhss = Ghc.GRHSs
{ Ghc.grhssExt = Ghc.NoExtField
, Ghc.grhssGRHSs =
[ Ghc.noLoc $ Ghc.GRHS
Ghc.NoExtField
[]
whereBindExpr
]
, Ghc.grhssLocalBinds = Ghc.noLoc $
Ghc.EmptyLocalBinds Ghc.NoExtField
}
}
]
, Ghc.mg_origin = Ghc.Generated
}
, Ghc.fun_tick = []
}
wrappedBind =
(Ghc.NonRecursive, Ghc.unitBag (Ghc.noLoc bind))
whereBinds' =
case whereBinds of
Ghc.EmptyLocalBinds x ->
Ghc.HsValBinds Ghc.NoExtField
(Ghc.XValBindsLR (Ghc.NValBinds [wrappedBind] []))
Ghc.HsValBinds x (Ghc.XValBindsLR (Ghc.NValBinds binds sigs)) ->
let otherBinds = updateDebugIPInBinds whereBindName <$> binds
in Ghc.HsValBinds x
(Ghc.XValBindsLR
(Ghc.NValBinds (wrappedBind : otherBinds) sigs
)
)
_ -> whereBinds
grhss' = fmap (updateDebugIPInGRHS whereBindName) <$> grhss
pure m { Ghc.m_grhss =
grhs
{ Ghc.grhssGRHSs = grhss'
, Ghc.grhssLocalBinds = Ghc.L whereLoc whereBinds'
} }
-- | Produce the contents of the where binding that contains the new debug IP
-- value, generated by creating a new ID and pairing it with the old one.
mkWhereBind :: String -> Ghc.TcM (Ghc.LHsExpr Ghc.GhcRn)
mkWhereBind key = do
-- TODO This is where the new ID will be generated and paired with the old ID
Right exprPs
<- fmap (Ghc.convertToHsExpr Ghc.Generated Ghc.noSrcSpan)
. liftIO
$ TH.runQ [| ?_debug_ip <> key |]
(exprRn, _) <- Ghc.rnLExpr exprPs
pure exprRn
-- TODO can use syb for this?
updateDebugIPInBinds
:: Ghc.Name
-> (Ghc.RecFlag, Ghc.LHsBinds Ghc.GhcRn)
-> (Ghc.RecFlag, Ghc.LHsBinds Ghc.GhcRn)
updateDebugIPInBinds varName (rec, binds)
= (rec, fmap updateBind <$> binds)
where
updateBind b@Ghc.FunBind{ Ghc.fun_matches = m@Ghc.MG{ Ghc.mg_alts = alts } }
= b { Ghc.fun_matches =
m { Ghc.mg_alts = (fmap . fmap . fmap) updateMatch alts }
}
updateBind b = b
updateMatch m@Ghc.Match{Ghc.m_grhss = g@Ghc.GRHSs{Ghc.grhssGRHSs = grhss}}
= m{Ghc.m_grhss =
g{Ghc.grhssGRHSs = fmap (updateDebugIPInGRHS varName) <$> grhss }
}
updateDebugIPInGRHS
:: Ghc.Name
-> Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
updateDebugIPInGRHS varName (Ghc.GRHS x guards body)
= Ghc.GRHS x guards (updateDebugIPInExpr varName body)
-- | Given the name of the variable to assign to the debug IP, create a let
-- expression that updates the IP in that scope.
updateDebugIPInExpr
:: Ghc.Name
-> Ghc.LHsExpr Ghc.GhcRn
-> Ghc.LHsExpr Ghc.GhcRn
updateDebugIPInExpr varName
= Ghc.noLoc
. Ghc.HsLet Ghc.NoExtField
( Ghc.noLoc $ Ghc.HsIPBinds
Ghc.NoExtField
( Ghc.IPBinds Ghc.NoExtField
[ Ghc.noLoc $ Ghc.IPBind
Ghc.NoExtField
(Left . Ghc.noLoc $ Ghc.HsIPName "_debug_ip")
(Ghc.noLoc $ Ghc.HsVar
Ghc.NoExtField
(Ghc.noLoc varName)
)
]
)
)
-- typeCheckResultAction :: Ghc.ModSummary -> Ghc.TcGblEnv -> Ghc.TcM Ghc.TcGblEnv
-- typeCheckResultAction _modSummary tcGblEnv = do
-- x <- mkM test `everywhereM` Ghc.tcg_binds tcGblEnv
-- pure tcGblEnv
--
-- test :: Ghc.LHsExpr Ghc.GhcTc -> Ghc.TcM ( Ghc.LHsExpr Ghc.GhcTc )
-- test = undefined
tcPlugin :: Ghc.TcPlugin
tcPlugin =
Ghc.TcPlugin
{ Ghc.tcPluginInit = Ghc.tcPluginIO $ newIORef False
{ Ghc.tcPluginInit = pure () -- Ghc.tcPluginIO $ newIORef False
, Ghc.tcPluginStop = \_ -> pure ()
, Ghc.tcPluginSolve = tcPluginSolver
, Ghc.tcPluginSolve = const tcPluginSolver
}
ppr :: Ghc.Outputable a => a -> String
@ -80,72 +322,88 @@ isDebuggerIpCt ct@Ghc.CDictCan{}
-- Actually will have some knowledge of which function it is occurring for
-- because there will also be a wanted for the debug label constraint (or tf)
tcPluginSolver :: IORef Bool -> Ghc.TcPluginSolver
tcPluginSolver givenHandledRef given derived wanted = do
firstGivenHandled <- Ghc.tcPluginIO $ readIORef givenHandledRef
tcPluginSolver :: Ghc.TcPluginSolver
tcPluginSolver given derived wanted = do
--Ghc.tcPluginIO . putStrLn $ ppr (wanted, given, derived)
case filter isDebuggerIpCt wanted of
[w]
| Ghc.IPOccOrigin _ <- Ghc.ctl_origin . Ghc.ctev_loc $ Ghc.cc_ev w
-> do
--Ghc.tcPluginIO . putStrLn . ppr $ Ghc.ctl_origin . Ghc.ctev_loc $ Ghc.cc_ev w
pure $ Ghc.TcPluginOk [] []
| otherwise
-> do
--Ghc.tcPluginIO . putStrLn . ppr $ Ghc.ctl_origin . Ghc.ctev_loc $ Ghc.cc_ev w
str <- Ghc.unsafeTcPluginTcM $ Ghc.mkStringExpr "inserted"
pure $ Ghc.TcPluginOk [(Ghc.EvExpr str, w)] []
_ -> pure $ Ghc.TcPluginOk [] []
case ( filter isDebuggerIpCt given
, filter isDebuggerIpCt wanted
) of
([g], []) -> do
Ghc.tcPluginIO $ putStrLn "case 1"
let ev = Ghc.ctEvTerm $ Ghc.cc_ev g
Ghc.tcPluginIO $ writeIORef givenHandledRef True
pure $ if firstGivenHandled
then Ghc.TcPluginOk [] []
else Ghc.TcPluginOk [(ev, g)] [g] -- this can also be [] []!
([g], [w]) -> do
Ghc.tcPluginIO $ putStrLn "case 2"
let ev = Ghc.cc_ev g
prevExpr = Ghc.ctEvExpr ev
tupFstUniq <- Ghc.unsafeTcPluginTcM Ghc.getUniqueM
let tupFstName = Ghc.mkSystemVarName tupFstUniq "a"
tupFstTy = Ghc.mkTyConApp Ghc.maybeTyCon [Ghc.stringTy]
tupFstId = Ghc.mkLocalId tupFstName Ghc.Many tupFstTy
tupSndUniq <- Ghc.unsafeTcPluginTcM Ghc.getUniqueM
let tupSndName = Ghc.mkSystemVarName tupSndUniq "b"
tupSndTy = Ghc.stringTy
tupSndId = Ghc.mkLocalId tupSndName Ghc.Many tupSndTy
tupUniq <- Ghc.unsafeTcPluginTcM Ghc.getUniqueM
let tupName = Ghc.mkSystemVarName tupUniq "c"
tupTy = Ghc.mkTupleTy Ghc.Boxed [tupFstTy, tupSndTy]
tupId = Ghc.mkLocalId tupName Ghc.Many tupTy
let x = case prevExpr of
Ghc.Var i ->
let n = Ghc.mkClonedInternalName tupUniq $ Ghc.varName i
in Ghc.Var $ Ghc.setVarName i n
let ip_co = Ghc.unwrapIP (Ghc.exprType prevExpr)
castedPrevExpr = Ghc.Cast prevExpr ip_co
let mPrevStr = Ghc.mkJustExpr Ghc.stringTy
. Ghc.mkTupleSelector [tupFstId, tupSndId] tupSndId tupId
$ castedPrevExpr
newStr <- Ghc.unsafeTcPluginTcM $ Ghc.mkStringExpr "inserted2"
let newTup = Ghc.mkCoreTup [mPrevStr, newStr]
pure $ Ghc.TcPluginOk [(Ghc.EvExpr newTup, w)] []
([], [w]) -> do
Ghc.tcPluginIO $ putStrLn "case 3"
str <- Ghc.unsafeTcPluginTcM $ Ghc.mkStringExpr "inserted"
let tuple = Ghc.mkCoreTup [Ghc.mkNothingExpr Ghc.stringTy, str]
pure $ Ghc.TcPluginOk [(Ghc.EvExpr tuple, w)] []
([], []) -> do
Ghc.tcPluginIO $ putStrLn "case 4"
pure $ Ghc.TcPluginOk [] []
_ -> do
Ghc.tcPluginIO $ putStrLn "unexpected givens/wanteds"
pure $ Ghc.TcPluginOk [] []
-- tcPluginSolver :: IORef Bool -> Ghc.TcPluginSolver
-- tcPluginSolver givenHandledRef given derived wanted = do
-- firstGivenHandled <- Ghc.tcPluginIO $ readIORef givenHandledRef
--
-- case ( filter isDebuggerIpCt given
-- , filter isDebuggerIpCt wanted
-- ) of
-- ([g], []) -> do
-- Ghc.tcPluginIO $ putStrLn "case 1"
-- let ev = Ghc.ctEvTerm $ Ghc.cc_ev g
-- Ghc.tcPluginIO $ writeIORef givenHandledRef True
-- pure $ if firstGivenHandled
-- then Ghc.TcPluginOk [] []
-- else Ghc.TcPluginOk [(ev, g)] [g] -- this can also be [] []!
--
-- ([g], [w]) -> do
-- Ghc.tcPluginIO $ putStrLn "case 2"
--
-- let ev = Ghc.cc_ev g
-- prevExpr = Ghc.ctEvExpr ev
--
-- tupFstUniq <- Ghc.unsafeTcPluginTcM Ghc.getUniqueM
-- let tupFstName = Ghc.mkSystemVarName tupFstUniq "a"
-- tupFstTy = Ghc.mkTyConApp Ghc.maybeTyCon [Ghc.stringTy]
-- tupFstId = Ghc.mkLocalId tupFstName Ghc.Many tupFstTy
--
-- tupSndUniq <- Ghc.unsafeTcPluginTcM Ghc.getUniqueM
-- let tupSndName = Ghc.mkSystemVarName tupSndUniq "b"
-- tupSndTy = Ghc.stringTy
-- tupSndId = Ghc.mkLocalId tupSndName Ghc.Many tupSndTy
--
-- tupUniq <- Ghc.unsafeTcPluginTcM Ghc.getUniqueM
-- let tupName = Ghc.mkSystemVarName tupUniq "c"
-- tupTy = Ghc.mkTupleTy Ghc.Boxed [tupFstTy, tupSndTy]
-- tupId = Ghc.mkLocalId tupName Ghc.Many tupTy
--
-- let x = case prevExpr of
-- Ghc.Var i ->
-- let n = Ghc.mkClonedInternalName tupUniq $ Ghc.varName i
-- in Ghc.Var $ Ghc.setVarName i n
--
-- let ip_co = Ghc.unwrapIP (Ghc.exprType prevExpr)
-- castedPrevExpr = Ghc.Cast prevExpr ip_co
--
-- let mPrevStr = Ghc.mkJustExpr Ghc.stringTy
-- . Ghc.mkTupleSelector [tupFstId, tupSndId] tupSndId tupId
-- $ castedPrevExpr
--
-- newStr <- Ghc.unsafeTcPluginTcM $ Ghc.mkStringExpr "inserted2"
-- let newTup = Ghc.mkCoreTup [mPrevStr, newStr]
--
-- pure $ Ghc.TcPluginOk [(Ghc.EvExpr newTup, w)] []
--
-- ([], [w]) -> do
-- Ghc.tcPluginIO $ putStrLn "case 3"
-- str <- Ghc.unsafeTcPluginTcM $ Ghc.mkStringExpr "inserted"
-- let tuple = Ghc.mkCoreTup [Ghc.mkNothingExpr Ghc.stringTy, str]
-- pure $ Ghc.TcPluginOk [(Ghc.EvExpr tuple, w)] []
--
-- ([], []) -> do
-- Ghc.tcPluginIO $ putStrLn "case 4"
-- pure $ Ghc.TcPluginOk [] []
--
-- _ -> do
-- Ghc.tcPluginIO $ putStrLn "unexpected givens/wanteds"
-- pure $ Ghc.TcPluginOk [] []
-- ys <- fmap catMaybes . for given $ \ct -> do
-- let ev = Ghc.cc_ev ct