<div dir="ltr"><div>Another option is to use a constraint solver plugin to "tag" the locations with a coercion, and then use a CorePlugin [1] to replace the corresponding cast by a call to liftIO.</div><div>I've created a constraint solver plugin to tag all the locations here: <a href="https://gist.github.com/christiaanb/5e2412bffce0fefb076d05198f94f2d8">https://gist.github.com/christiaanb/5e2412bffce0fefb076d05198f94f2d8</a></div><div><br></div><div>As you can see, for:<br><br>> {-# OPTIONS_GHC -fplugin=LiftIOPlugin -ddump-ds -ddump-tc -ddump-to-file #-}<br>> module Test where<br>> <br>> import Control.Monad.IO.Class<br>> <br>> program :: MonadIO m => m ()<br>> program = putStrLn "Hello world!"</div><div><br></div><div>it results in the following desugar output</div><div><br></div><div>> program<br>>   = \ (@(m_a9Ky :: * -> *)) _ [Occ=Dead] -><br>>       (break<0>() putStrLn (GHC.CString.unpackCString# "Hello world!"#))<br>>       `cast` (Univ(representational plugin "tag_lift_io"<br>>                    :: IO, m_a9Ky) <()>_N<br>>               :: IO () ~R# m_a9Ky ())<br><br></div><div>So now you'll need to make a CorePlugin to recognize that cast and replace it with an application with `liftIO`.</div><div>Hopefully someone else can help you with suggestions on how to conjure a proper `liftIO` out of thin air at that point in the compiler pipeline.<br></div><div><br></div><div>[1] <a href="https://downloads.haskell.org/ghc/9.0.1/docs/html/libraries/ghc-9.0.1/GHC-Driver-Plugins.html#t:CorePlugin">https://downloads.haskell.org/ghc/9.0.1/docs/html/libraries/ghc-9.0.1/GHC-Driver-Plugins.html#t:CorePlugin</a></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Thu, 1 Jul 2021 at 10:24, Zubin Duggal <<a href="mailto:zubin@well-typed.com">zubin@well-typed.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">You could set `-fdefer-type-errors` on the file, possibly using<br>
`dynflagsPlugin`. This will give your `typeCheckResultAction` an AST<br>
with all nodes containing type errors wrapped in an `evDelayedError`<br>
term. See Note [Deferring coercion errors to runtime] for more details.<br>
You can walk through the AST and replace these wrappers with `liftIO`<br>
(with the correct type and dictionary arguments) and things should<br>
work as you want.<br>
<br>
Of course, this will defer all type errors in the program, not just the<br>
ones that your plugin can solve. You could work around this by setting<br>
`log_action` to "upgrade" any type error warnings you didn't handle and<br>
arose as a result of `Reason Opt_DeferTypeErrors :: WarnReason` back to<br>
proper errors.<br>
_______________________________________________<br>
ghc-devs mailing list<br>
<a href="mailto:ghc-devs@haskell.org" target="_blank">ghc-devs@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br>
</blockquote></div>