Writing GHC plugin to modify AST despite failure to type-check
Zubin Duggal
zubin at well-typed.com
Thu Jul 1 12:37:27 UTC 2021
An issue with this approach is that it fails if you have a concrete
monad instead of an mtl-style function.
For example, with
newtype MyIO a = MyIO (IO a)
deriving newtype (Functor, Applicative, Monad, MonadIO)
program :: MyIO ()
program = putStrLn "Hello world!"
GHC will reject the program because it can't unify `IO` and `MyIO`
before it can even get to the constraint solver plugin.
In general, implementing a plugin like this is a nice way to understand
and familiarise yourself with plugins and the GHC API, but for practical
purposes it would be best to use something like the `lifted-base` or
`unliftio` libraries to access lifted version of common IO operations.
On 21/07/01 10:54, Christiaan Baaij wrote:
>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.
>I've created a constraint solver plugin to tag all the locations here:
>https://gist.github.com/christiaanb/5e2412bffce0fefb076d05198f94f2d8
>
>As you can see, for:
>
>> {-# OPTIONS_GHC -fplugin=LiftIOPlugin -ddump-ds -ddump-tc -ddump-to-file
>#-}
>> module Test where
>>
>> import Control.Monad.IO.Class
>>
>> program :: MonadIO m => m ()
>> program = putStrLn "Hello world!"
>
>it results in the following desugar output
>
>> program
>> = \ (@(m_a9Ky :: * -> *)) _ [Occ=Dead] ->
>> (break<0>() putStrLn (GHC.CString.unpackCString# "Hello world!"#))
>> `cast` (Univ(representational plugin "tag_lift_io"
>> :: IO, m_a9Ky) <()>_N
>> :: IO () ~R# m_a9Ky ())
>
>So now you'll need to make a CorePlugin to recognize that cast and replace
>it with an application with `liftIO`.
>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.
>
>[1]
>https://downloads.haskell.org/ghc/9.0.1/docs/html/libraries/ghc-9.0.1/GHC-Driver-Plugins.html#t:CorePlugin
>
>On Thu, 1 Jul 2021 at 10:24, Zubin Duggal <zubin at well-typed.com> wrote:
>
>> You could set `-fdefer-type-errors` on the file, possibly using
>> `dynflagsPlugin`. This will give your `typeCheckResultAction` an AST
>> with all nodes containing type errors wrapped in an `evDelayedError`
>> term. See Note [Deferring coercion errors to runtime] for more details.
>> You can walk through the AST and replace these wrappers with `liftIO`
>> (with the correct type and dictionary arguments) and things should
>> work as you want.
>>
>> Of course, this will defer all type errors in the program, not just the
>> ones that your plugin can solve. You could work around this by setting
>> `log_action` to "upgrade" any type error warnings you didn't handle and
>> arose as a result of `Reason Opt_DeferTypeErrors :: WarnReason` back to
>> proper errors.
>> _______________________________________________
>> ghc-devs mailing list
>> ghc-devs at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>>
>_______________________________________________
>ghc-devs mailing list
>ghc-devs at haskell.org
>http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
More information about the ghc-devs
mailing list