7. Расширение GHC и использование его в качестве библиотеки

7.1.1. Аннотирование значений

Любое выражение, для которого есть экземпляры Typeable и Data, можно прикрепить к объявлению привязки верхнего уровня с помощью прагмы ANN. В частности, это означает, что можно использовать ANN для аннотирования конструкторов данных (например, Just), а также обычных значений (например, take). Например, чтобы аннотировать функцию foo аннотацией Just "Hello", нужно сделать следующее:

{-# ANN foo (Just "Hello") #-}
foo = ...

При использовании аннотаций действуют следующие ограничения:

• Аннотируемый связыватель должен находиться на верхнем уровне (то есть вложенные связыватели не допускаются)
• Аннотируемый связыватель должен быть объявлен в текущем модуле
• Тип выражения, используемого для аннотирования, должен иметь экземпляры Typeable и Data

• На выражение, используемое для аннотирования, распространяются ограничения на этапы Template Haskell; например, нельзя выполнить функцию из компилируемого модуля.

  Точнее говоря, аннотация {-# ANN x e #-} корректно размещена по этапам тогда и только тогда, когда корректно размещён по этапам $(e) (без учёта обычных ограничений по типам для синтаксиса сплайсов и обычного ограничения на использование сплайса внутри сплайса — $([|1|]) допустима в качестве аннотации, хотя и избыточна).

Если вы считаете, что какие-либо из этих ограничений слишком строги, свяжитесь с командой GHC.

Однако за исключением этих ограничений разрешено многое, включая выражения, которые не вычислены полностью! Выражения аннотаций вычисляются компилятором так же, как сплайсы Template Haskell. Поэтому такая аннотация допустима:

{-# ANN f SillyAnnotation { foo = (id 10) + $([| 20 |]), bar = 'f } #-}
f = ...

7.1.2. Аннотирование типов

Типы можно аннотировать прагмой ANN, используя ключевое слово type. Например:

{-# ANN type Foo (Just "A `Maybe String' annotation") #-}
data Foo = ...

7.1.3. Аннотирование модулей

Модули можно аннотировать прагмой ANN, используя ключевое слово module. Например:

{-# ANN module (Just "A `Maybe String' annotation") #-}

7.3.1. Использование плагинов компилятора

Плагины можно добавить в командной строке с помощью параметра -fplugin=⟨module⟩, где ⟨module⟩ — модуль зарегистрированного пакета, экспортирующий плагин. Плагины загружаются по порядку: сначала указанные в командной строке и флагах Cabal, а затем указанные в прагмах OPTIONS, обрабатываемых в порядке следования в файле. Аргументы плагинам можно передать с помощью параметра -fplugin-opt=⟨module⟩:⟨args⟩. Список включённых плагинов можно сбросить с помощью параметра -fclear-plugins.

-fplugin=⟨module⟩

Загрузить плагин из указанного модуля. Модуль должен входить в пакет, зарегистрированный в базе данных пакетов GHC.

-fplugin-opt=⟨module⟩:⟨args⟩

Передать аргументы модулю плагина; модуль должен быть указан с помощью -fplugin=⟨module⟩. Порядок прагм плагинов имеет значение, а порядок прагм аргументов — нет. Один и тот же набор аргументов передаётся всем плагинам из одного модуля.

-- Two Echo plugins will both get args A and B.
{-# OPTIONS -fplugin Echo -fplugin-opt Echo:A #-}
{-# OPTIONS -fplugin Echo -fplugin-opt Echo:B #-}

-- While order of the plugins matters, arg order does not.
{-# OPTIONS -fplugin-opt Echo2:B #-}

{-# OPTIONS -fplugin Echo1 #-}
{-# OPTIONS -fplugin-opt Echo1:A #-}

{-# OPTIONS -fplugin Echo2 #-}

Если требуется использовать один и тот же плагин с разными аргументами, повторно экспортируйте его из нескольких небольших модулей.

-- Echo1 and Echo2 as lightweight modules re-exporting Echo.plugin.
module Echo1 (plugin) where import Echo (plugin)
module Echo2 (plugin) where import Echo (plugin)

-- Echo1 gets arg A while Echo2 gets arg B.
{-# OPTIONS -fplugin Echo1 -fplugin-opt Echo1:A #-}
{-# OPTIONS -fplugin Echo2 -fplugin-opt Echo2:B #-}

-fplugin-trustworthy

По умолчанию модуль, скомпилированный с плагинами, помечается как небезопасный. Если передать этот флаг, все плагины будут считаться заслуживающими доверия, и вывод о безопасности больше не будет зависеть от них.

-fclear-plugins

Очистить список плагинов, ранее указанных с помощью -fplugin. Это полезно в GHCi, где нельзя просто удалить параметры -fplugin из командной строки. Вместо этого можно использовать :set -fclear-plugins.

Например, чтобы загрузить плагин, экспортируемый Foo.Plugin из пакета foo-ghc-plugin, и передать ему параметр «baz», нужно вызвать GHC следующим образом:

$ ghc -fplugin Foo.Plugin -fplugin-opt Foo.Plugin:baz Test.hs
[1 of 1] Compiling Main             ( Test.hs, Test.o )
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
Loading package foo-ghc-plugin-0.1 ... linking ... done.
...
Linking Test ...
$

Плагины также можно загружать непосредственно из библиотек. Это позволяет загружать плагины в кросс-компиляторах (как обходное решение для #14335).

-fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩

Аргументы задаются в виде списка, поэтому плагин, указанный с помощью -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩, будет выглядеть так: 'path/to/plugin;package-123;Plugin.Module;["Argument","List"]'.

В качестве альтернативы плагины Core можно задавать с помощью Template Haskell.

addCorePlugin "Foo.Plugin"

Это добавляет плагин в качестве прохода преобразования Core в Core. В отличие от -fplugin=(module), модуль плагина не может находиться в том же пакете, что и модуль, вызывающий Language.Haskell.TH.Syntax.addCorePlugin. Таким образом, можно рассчитывать, что реализация плагина будет собрана к моменту, когда он понадобится.

Модули плагинов находятся в отдельном пространстве имён, отличном от пространства имён пользовательских импортов. По умолчанию эти пространства имён совпадают, однако есть несколько параметров командной строки, предназначенных специально для управления пакетами плагинов:

-plugin-package ⟨pkg⟩

Этот параметр открывает установленный пакет ⟨pkg⟩ для плагинов, например для -fplugin=⟨module⟩. Пакет ⟨pkg⟩ можно указать полностью, вместе с номером версии (например, network-1.0), либо опустить номер версии, если установлена только одна версия пакета. Если установлено несколько версий ⟨pkg⟩ и параметр -hide-all-plugin-packages не указан, все остальные версии будут скрыты. Параметр -plugin-package ⟨pkg⟩ поддерживает исключение и переименование, описанные в разделе Исключение и переименование модулей.

В отличие от -package ⟨pkg⟩, этот параметр НЕ приводит к включению пакета ⟨pkg⟩ в конечный исполняемый файл или разделяемый объект.

-plugin-package-id ⟨pkg-id⟩

Открывает пакет в пространстве имён плагинов, как и -plugin-package ⟨pkg⟩, но указывает пакет по его идентификатору установленного пакета, а не по имени. Это более надёжный способ указания пакетов, который можно использовать для выбора пакетов, которые иначе были бы затенены. Cabal передаёт GHC флаги -plugin-package-id ⟨pkg-id⟩. Параметр -plugin-package-id ⟨pkg-id⟩ поддерживает исключение и переименование, описанные в разделе Исключение и переименование модулей.

-hide-all-plugin-packages

По умолчанию все открытые пакеты в обычном пространстве имён импорта исходного кода также доступны плагинам. Этот параметр скрывает эти пакеты по умолчанию. При использовании этого флага все необходимые пакеты с плагинами нужно явно открыть с помощью параметров -plugin-package ⟨pkg⟩.

В настоящее время в Cabal указать зависимость от плагина можно только добавив его в build-depends (где используется стандартный флаг -package-id ⟨unit-id⟩); в будущем для указания зависимостей от плагинов появится отдельное поле.

7.3.2. Написание плагинов компилятора

Плагины — это модули, экспортирующие как минимум один идентификатор, plugin, типа GHC.Plugins.Plugin. Все плагины должны import GHC.Plugins, поскольку именно он определяет интерфейс конвейера компиляции.

Значение Plugin фактически содержит функцию, которая устанавливает проход компиляции в конвейере компилятора. По умолчанию используется пустой плагин, который ничего не делает: GHC.Plugins.defaultPlugin. Его следует переопределить с помощью синтаксиса записи, указав функцию установки. Поскольку точный набор полей типа Plugin может измениться, это лучший способ обеспечить совместимость плагинов с будущими версиями при минимальных изменениях интерфейса.

Plugin экспортирует поле installCoreToDos, представляющее собой функцию типа [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]. Значение CommandLineOption — это, по сути, просто String, а CoreToDo — это, по существу, функция типа Core -> Core. Значение CoreToDo задаёт имя прохода и запускает его для каждого скомпилированного модуля при вызове GHC.

Вот простой пример плагина, который ничего не делает, возвращает исходный конвейер компиляции без изменений и выводит «Hello»:

module DoNothing.Plugin (plugin) where
import GHC.Plugins

plugin :: Plugin
plugin = defaultPlugin {
  installCoreToDos = install
  }

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do
  putMsgS "Hello!"
  return todo

После компиляции этого плагина и его регистрации в пакете (например, с помощью cabal) его можно использовать, просто указав -fplugin=DoNothing.Plugin в командной строке. Во время компиляции GHC должен вывести «Hello».

Поддерживается и запуск нескольких плагинов: для этого передайте несколько параметров -fplugin=.... GHC загрузит плагины в порядке их указания в командной строке и, если применимо, объединит их эффекты в том же порядке. То есть, если у нас есть два плагина Core — Plugin1 и Plugin2, — каждый из которых определяет функцию install, как в примере выше, GHC сначала запустит Plugin1.install для стандартного [CoreToDo], а затем передаст результат Plugin2.install. -fplugin=Plugin1 -fplugin=Plugin2 обновит конвейер Core, применив Plugin1.install opts1 >=> Plugin2.install opts2 (где opts1 и opts2 — параметры, переданные каждому плагину с помощью -fplugin-opt=...). Это относится не только к плагинам Core, но и ко всем типам плагинов, которые можно объединять или последовательно выполнять: первый плагин в командной строке GHC всегда выполняется первым.

7.3.3. Подробнее о плагинах Core

CoreToDo — это, по сути, тип данных, описывающий все виды проходов оптимизации Core, выполняемых GHC. Среди них есть проходы упрощения, CSE и другие. Для плагинов предусмотрен отдельный вариант — CoreDoPluginPass :: String -> PluginPass -> CoreToDo; именно его следует всегда использовать для добавления собственного прохода в конвейер. Первый параметр — имя плагина, второй — проход, который требуется добавить.

CoreM — это монада, в которой выполняются все оптимизации Core.

Функция установки плагина (install в примере выше) принимает список значений CoreToDo и возвращает список значений CoreToDo. Перед началом компиляции модулей GHC перечисляет все плагины, которые ему указано загрузить, и выполняет функции установки каждого из них, первоначально передавая список проходов, заданный самим GHC. После этого итоговый список проходов передаётся оптимизатору, который выполняет их по очереди.

Функцию установки следует использовать с осторожностью, поскольку на момент написания документации GHC не проверяет и не перепроверяет возвращаемый вами список проходов. Например, следующая функция установки:

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ _ = return []

безусловно допустима, но вряд ли кому-то действительно нужна.

module SayNames.Plugin (plugin) where
import GHC.Plugins

plugin :: Plugin
plugin = defaultPlugin {
  installCoreToDos = install
  }

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do
  return (CoreDoPluginPass "Say name" pass : todo)

pass :: ModGuts -> CoreM ModGuts
pass guts = do dflags <- getDynFlags
               bindsOnlyPass (mapM (printBind dflags)) guts
  where printBind :: DynFlags -> CoreBind -> CoreM CoreBind
        printBind dflags bndr@(NonRec b _) = do
          putMsgS $ "Non-recursive binding named " ++ showSDoc dflags (ppr b)
          return bndr
        printBind _ bndr = return bndr

plugin :: Plugin
plugin = defaultPlugin { latePlugin = lateP }

lateP :: LatePlugin
lateP _ _ (cg_guts, cc_state) = do
    binds' <- editCoreBinding (cg_binds cg_guts)
    return (cg_guts { cg_binds = binds' }, cc_state)

editCoreBinding :: CoreProgram -> IO CoreProgram
editCoreBinding pgm = pure . go
  where
    go :: [CoreBind] -> [CoreBind]
    go (b@(NonRec v e) : bs)
      | occNameString (getOccName v) == "testBinding" && exprType e `eqType` intTy =
          NonRec v (mkUncheckedIntExpr 111111) : bs
    go (b:bs) = b : go bs
    go [] = []

{-# LANGUAGE DeriveDataTypeable #-}
module SayAnnNames.Plugin (plugin, SomeAnn(..)) where
import GHC.Plugins
import Control.Monad (unless)
import Data.Data

data SomeAnn = SomeAnn deriving Data

plugin :: Plugin
plugin = defaultPlugin {
  installCoreToDos = install
  }

install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do
  return (CoreDoPluginPass "Say name" pass : todo)

pass :: ModGuts -> CoreM ModGuts
pass g = do
          dflags <- getDynFlags
          mapM_ (printAnn dflags g) (mg_binds g) >> return g
  where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind
        printAnn dflags guts bndr@(NonRec b _) = do
          anns <- annotationsOn guts b :: CoreM [SomeAnn]
          unless (null anns) $ putMsgS $ "Annotated binding found: " ++  showSDoc dflags (ppr b)
          return bndr
        printAnn _ _ bndr = return bndr

annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]
annotationsOn guts bndr = do
  (_, anns) <- getAnnotations deserializeWithData guts
  return $ lookupWithDefaultUFM_Directly anns [] (varUnique bndr)

7.3.4. Плагины проверки типов

Помимо плагинов Core, GHC экспериментально поддерживает плагины проверки типов, позволяющие изменять поведение решателя ограничений. Например, с их помощью можно подключить компилятор к SMT-решателю и поддержать более богатую теорию арифметических выражений на уровне типов, чем встроенная в GHC (см. раздел Вычисления с натуральными числами на уровне типов).

Тип Plugin содержит поле tcPlugin типа [CommandLineOption] -> Maybe TcPlugin, причём тип TcPlugin определяется следующим образом:

  data TcPlugin = forall s . TcPlugin
    { tcPluginInit    :: TcPluginM s
    , tcPluginSolve   :: s -> TcPluginSolver
    , tcPluginRewrite :: s -> UniqFM TyCon TcPluginRewriter
    , tcPluginStop    :: s -> TcPluginM ()
    }

  type TcPluginSolver = EvBindsVar -> [Ct] -> [Ct] -> TcPluginM TcPluginSolveResult

  type TcPluginRewriter = RewriteEnv -> [Ct] -> [Type] -> TcPluginM TcPluginRewriteResult

data TcPluginSolveResult
  = TcPluginSolveResult
      { tcPluginInsolubleCts :: [Ct]
      , tcPluginSolvedCts    :: [(EvTerm, Ct)]
      , tcPluginNewCts       :: [Ct]
      }

  data TcPluginRewriteResult
    = TcPluginNoRewrite
    | TcPluginRewriteTo
        { tcPluginRewriteTo    :: Reduction
        , tcRewriterNewWanteds :: [Ct]
        }

(Детали этого представления могут измениться по мере накопления опыта написания плагинов проверки типов. Не следует считать, что оно будет стабильным между выпусками GHC.)

Основная идея такова:

• При проверке типов модуля GHC один раз вызывает tcPluginInit до начала решения ограничений. Это позволяет плагину искать данные в контексте, инициализировать изменяемое состояние или открывать соединение с внешним процессом (например, внешним SMT-решателем). Плагин может вернуть результат любого выбранного им типа; этот результат будет передан другим полям записи TcPlugin.
• Во время решения ограничений GHC многократно вызывает tcPluginSolve. Этой функции передаётся текущий набор ограничений, и она должна вернуть TcPluginSolveResult, указывающий, найдено ли противоречие или достигнут ли прогресс. Если решатель плагина достигает прогресса, GHC перезапускает конвейер решения ограничений и повторяет его до достижения неподвижной точки.
• При переписывании применений семейств типов GHC вызывает tcPluginRewriter. Плагин предоставляет набор семейств типов, которые требуется переписывать. Для каждого из них переписыватель получает аргументы этого семейства типов и текущий набор ограничений Given. Затем плагин при необходимости может задать переписывание этого применения семейства типов.
• Наконец, после завершения решения ограничений GHC вызывает tcPluginStop, чтобы плагин мог освободить выделенные ресурсы (например, завершить процесс SMT-решателя).

Код плагина выполняется в монаде TcPluginM, которая предоставляет ограниченный интерфейс к функциям API GHC, необходимым плагинам проверки типов, включая IO и чтение окружения. Если необходимая функциональность не предоставлена модулем TcPluginM, можно использовать unsafeTcPluginTcM :: TcM a -> TcPluginM a, однако рекомендуется связаться с командой GHC и предложить расширить интерфейс. Обратите внимание, что TcPluginM может выполнять произвольные операции ввода-вывода через tcPluginIO :: IO a -> TcPluginM a, хотя с побочными эффектами (особенно в tcPluginSolve) нужно обращаться осторожно. В целом автор плагина сам отвечает за безопасность выполняемых им операций ввода-вывода.

solve :: EvBindsVar -> [Ct] -> [Ct] -> TcPluginM TcPluginSolveResult
solve binds givens wanteds = ...

UnivCo (PluginProv "my-plugin" gcvs) role t1 t2

tcPluginRewrite :: s -> UniqFM TyCon TcPluginRewriter

type TcPluginRewriter = [Ct] -> [Type] -> TcPluginM TcPluginRewriteResult

data TcPluginRewriteResult
  = TcPluginNoRewrite
  | TcPluginRewriteTo
      { tcPluginRewriteTo    :: Reduction
      , tcRewriterNewWanteds :: [Ct]
      }

data Reduction = Reduction Coercion !Type

co :: F orig_arg_1 ... orig_arg_n ~ rewritten_ty

7.3.5. Плагины исходного кода

Помимо плагинов ядра и проверяющего типы, можно устанавливать плагины, которые имеют доступ к различным представлениям исходного кода. Основная цель этих плагинов — упростить реализацию инструментов разработки.

Для определения плагинов, обращающихся к этим представлениям, предусмотрено несколько точек доступа. Все эти поля получают список строк CommandLineOption, передаваемых компилятору с помощью флагов -fplugin-opt=⟨module⟩:⟨args⟩.

plugin :: Plugin
plugin = defaultPlugin {
    parsedResultAction = parsed
  , typeCheckResultAction = typechecked
  , spliceRunAction = spliceRun
  , interfaceLoadAction = interfaceLoad
  , renamedResultAction = renamed
  }

parsed :: [CommandLineOption] -> ModSummary
            -> ParsedResult -> Hsc ParsedResult

typechecked :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
renamed :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)

spliceRun :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)

interfaceLoad :: forall lcl . [CommandLineOption] -> ModIface
                                -> IfM lcl ModIface

readIfaceField :: Binary a => FieldName -> ModIface -> IO (Maybe a)
writeIfaceField :: Binary a => FieldName -> a -> ModIface -> IO ModIface
deleteIfaceField :: FieldName -> ModIface -> ModIface

package/field
ghc-n.n.n/core
package/field-n

module SourcePlugin where

import Control.Monad.IO.Class
import GHC.Driver.Session (getDynFlags)
import GHC.Driver.Plugins
import GHC.Plugins
import GHC.Tc.Types
import Language.Haskell.Syntax.Extension
import GHC.Hs.Decls
import GHC.Hs.Expr
import GHC.Hs.ImpExp
import GHC.Types.Avail
import GHC.Utils.Outputable
import GHC.Hs.Doc
import GHC

plugin :: Plugin
plugin = defaultPlugin
  { parsedResultAction = parsedPlugin
  , renamedResultAction = renamedAction
  , typeCheckResultAction = typecheckPlugin
  , spliceRunAction = metaPlugin
  , interfaceLoadAction = interfaceLoadPlugin
  }

parsedPlugin :: [CommandLineOption] -> ModSummary
             -> ParsedResult -> Hsc ParsedResult
parsedPlugin _ _ parsed@(ParsedResult pm msgs)
     = do dflags <- getDynFlags
          liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm)
          liftIO $ putStrLn $ "parsePlugin warnings: \n" ++ (showSDoc dflags $ ppr $ psWarnings msgs)
          liftIO $ putStrLn $ "parsePlugin errors: \n" ++ (showSDoc dflags $ ppr $ psErrors msgs)
          return parsed

renamedAction :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedAction _ tc gr = do
  dflags <- getDynFlags
  liftIO $ putStrLn $ "typeCheckPlugin (rn): " ++ (showSDoc dflags $ ppr gr)
  return (tc, gr)

typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
typecheckPlugin _ _ tc
  = do dflags <- getDynFlags
       liftIO $ putStrLn $ "typeCheckPlugin (rn): \n" ++ (showSDoc dflags $ ppr $ tcg_rn_decls tc)
       liftIO $ putStrLn $ "typeCheckPlugin (tc): \n" ++ (showSDoc dflags $ ppr $ tcg_binds tc)
       return tc

metaPlugin :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
metaPlugin _ meta
  = do dflags <- getDynFlags
       liftIO $ putStrLn $ "meta: " ++ (showSDoc dflags $ ppr meta)
       return meta

interfaceLoadPlugin :: [CommandLineOption] -> ModIface -> IfM lcl ModIface
interfaceLoadPlugin _ iface
  = do dflags <- getDynFlags
       liftIO $ putStrLn $ "interface loaded: " ++ (showSDoc dflags $ ppr $ mi_module iface)
       return iface

{-# OPTIONS_GHC -fplugin SourcePlugin #-}
{-# LANGUAGE TemplateHaskell #-}
module A where

a = ()

$(return [])

parsePlugin:
module A where
a = ()
$(return [])
parsePlugin warnings:

parsePlugin errors:

typeCheckPlugin (rn): a = ()
interface loaded: Language.Haskell.TH.Lib.Internal
meta: return []
typeCheckPlugin (rn):
typeCheckPlugin (rn):
Nothing
typeCheckPlugin (tc):
{$trModule = Module (TrNameS "main"#) (TrNameS "A"#), a = ()}

7.3.6. Плагины вариантов заполнения типизированных дыр

Плагины вариантов заполнения типизированных дыр вызываются при формировании сообщения об ошибке типизированной дыры. Они позволяют получать сведения о типизированной дыре во время компиляции и настраивать предложения допустимых вариантов её заполнения.

С помощью таких плагинов можно расширить поведение предложений допустимых вариантов заполнения, например, используя Hoogle или другие внешние инструменты для поиска и/или синтеза допустимых вариантов с теми же сведениями о типизированной дыре, которые использует GHC.

Для определения плагинов вариантов заполнения предусмотрены две точки доступа: плагин кандидатов и плагин вариантов, которые изменяют соответственно проверяемых кандидатов и варианты.

type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate]

type FitPlugin =  TypedHole -> [HoleFit] -> TcM [HoleFit]

data HoleFitPlugin = HoleFitPlugin
  { candPlugin :: CandPlugin
     -- ^ A plugin for modifying hole fit candidates before they're checked
  , fitPlugin :: FitPlugin
     -- ^ A plugin for modifying valid hole fits after they've been found.
  }

Значение TypedHole содержит все сведения о дыре, доступные GHC при формировании ошибки.

data TypedHole = TyH { tyHRelevantCts :: Cts
                      -- ^ Any relevant Cts to the hole
                    , tyHImplics :: [Implication]
                      -- ^ The nested implications of the hole with the
                      --   innermost implication first.
                    , tyHCt :: Maybe Ct
                      -- ^ The hole constraint itself, if available.
                    }

Затем HoleFitPlugins определяются следующим образом

plugin :: Plugin
plugin = defaultPlugin {
    holeFitPlugin = (fmap . fmap) fromPureHFPlugin hfPlugin
  }


hfPlugin :: [CommandLineOption] -> Maybe HoleFitPlugin

Здесь fromPureHFPlugin :: HoleFitPlugin -> HoleFitPluginR — вспомогательная функция из модуля GHC.Tc.Errors.Hole для определения плагинов, которым не требуется внутреннее состояние.

-- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can
-- track internal state. Note the existential quantification, ensuring that
-- the state cannot be modified from outside the plugin.
data HoleFitPluginR = forall s. HoleFitPluginR
  { hfPluginInit :: TcM (TcRef s)
    -- ^ Initializes the TcRef to be passed to the plugin
  , hfPluginRun :: TcRef s -> HoleFitPlugin
    -- ^ The function defining the plugin itself
  , hfPluginStop :: TcRef s -> TcM ()
    -- ^ Cleanup of state, guaranteed to be called even on error
  }

{-# LANGUAGE TypeApplications, RecordWildCards #-}
module HolePlugin where

import GHC.Plugins hiding ((<>))

import GHC.Tc.Errors.Hole

import Data.List (stripPrefix, sortOn)

import GHC.Tc.Types

import GHC.Tc.Utils.Monad

import Data.Time (UTCTime, NominalDiffTime)
import qualified Data.Time as Time

import Text.Read


data HolePluginState = HPS { timeAlloted :: Maybe NominalDiffTime
                          , elapsedTime :: NominalDiffTime
                          , timeCurStarted :: UTCTime }

bumpElapsed :: NominalDiffTime -> HolePluginState -> HolePluginState
bumpElapsed ad (HPS a e t) = HPS a (e + ad) t

setAlloted :: Maybe NominalDiffTime -> HolePluginState -> HolePluginState
setAlloted a (HPS _ e t) = HPS a e t

setCurStarted :: UTCTime -> HolePluginState -> HolePluginState
setCurStarted nt (HPS a e _) = HPS a e nt

hpStartState :: HolePluginState
hpStartState = HPS Nothing zero undefined
  where zero = fromInteger @NominalDiffTime 0

initPlugin :: [CommandLineOption] -> TcM (TcRef HolePluginState)
initPlugin [msecs] = newTcRef $ hpStartState { timeAlloted = alloted }
  where
    errMsg = "Invalid amount of milliseconds given to plugin: " <> show msecs
    alloted = case readMaybe @Integer msecs of
      Just millisecs -> Just $ fromInteger @NominalDiffTime millisecs / 1000
      _ -> error errMsg
initPlugin _ = newTcRef hpStartState

fromModule :: HoleFitCandidate -> [String]
fromModule (GreHFCand gre) =
  map (moduleNameString . importSpecModule) $ gre_imp gre
fromModule _ = []

toHoleFitCommand :: TypedHole -> String -> Maybe String
toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h)} str
    = stripPrefix ("_" <> str) $ occNameString $ holeOcc h
toHoleFitCommand _ _ = Nothing

-- | This candidate plugin filters the candidates by module,
-- using the name of the hole as module to search in
modFilterTimeoutP :: [CommandLineOption] -> TcRef HolePluginState -> CandPlugin
modFilterTimeoutP _ ref hole cands = do
  curTime <- liftIO Time.getCurrentTime
  HPS {..} <- readTcRef ref
  updTcRef ref (setCurStarted curTime)
  return $ case timeAlloted of
    -- If we're out of time we remove all the candidates. Then nothing is checked.
    Just sofar | elapsedTime > sofar -> []
    _ -> case toHoleFitCommand hole "only_" of

          Just modName -> filter (inScopeVia modName) cands
          _ -> cands
  where inScopeVia modNameStr cand@(GreHFCand _) =
          elem (toModName modNameStr) $ fromModule cand
        inScopeVia _ _ = False
        toModName = replace '_' '.'
        replace :: Eq a => a -> a -> [a] -> [a]
        replace _ _ [] = []
        replace a b (x:xs) = (if x == a then b else x):replace a b xs

modSortP :: [CommandLineOption] -> TcRef HolePluginState -> FitPlugin
modSortP _ ref hole hfs = do
  curTime <- liftIO Time.getCurrentTime
  HPS {..} <- readTcRef ref
  updTcRef ref $ bumpElapsed (Time.diffUTCTime curTime timeCurStarted)
  return $ case timeAlloted of
    -- If we're out of time, remove any candidates, so nothing is checked.
    Just sofar | elapsedTime > sofar -> [RawHoleFit $ text msg]
    _ -> case toHoleFitCommand hole "sort_by_mod" of
            -- If only_ is on, the fits will all be from the same module.
            Just ('_':'d':'e':'s':'c':_) -> reverse hfs
            Just _ -> orderByModule hfs
            _ ->  hfs
  where orderByModule :: [HoleFit] -> [HoleFit]
        orderByModule = sortOn (fmap fromModule . mbHFCand)
        mbHFCand :: HoleFit -> Maybe HoleFitCandidate
        mbHFCand HoleFit {hfCand = c} = Just c
        mbHFCand _ = Nothing
        msg = hang (text "Error: The time ran out, and the search was aborted for this hole.")
               7 $ text "Try again with a longer timeout."

plugin :: Plugin
plugin = defaultPlugin { holeFitPlugin = holeFitP, pluginRecompile = purePlugin}

holeFitP :: [CommandLineOption] -> Maybe HoleFitPluginR
holeFitP opts = Just (HoleFitPluginR initP pluginDef stopP)
  where initP = initPlugin opts
        stopP = const $ return ()
        pluginDef ref = HoleFitPlugin { candPlugin = modFilterTimeoutP opts ref
                                      , fitPlugin  = modSortP opts ref }

{-# OPTIONS -fplugin=HolePlugin
            -fplugin-opt=HolePlugin:600
            -funclutter-valid-hole-fits #-}
module Main where

import Prelude hiding (head, last)

import Data.List (head, last)


f, g, h, i, j :: [Int] -> Int
f = _too_long
j = _
i = _sort_by_mod_desc
g = _only_Data_List
h = _only_Prelude

main :: IO ()
main = return ()

Main.hs:12:5: error:
    • Found hole: _too_long :: [Int] -> Int
      Or perhaps ‘_too_long’ is mis-spelled, or not in scope
    • In the expression: _too_long
      In an equation for ‘f’: f = _too_long
    • Relevant bindings include
        f :: [Int] -> Int (bound at Main.hs:12:1)
      Valid hole fits include
        Error: The time ran out, and the search was aborted for this hole.
               Try again with a longer timeout.
  |
12 | f = _too_long
  |     ^^^^^^^^^

Main.hs:13:5: error:
    • Found hole: _ :: [Int] -> Int
    • In the expression: _
      In an equation for ‘j’: j = _
    • Relevant bindings include
        j :: [Int] -> Int (bound at Main.hs:13:1)
      Valid hole fits include
        j :: [Int] -> Int
        f :: [Int] -> Int
        g :: [Int] -> Int
        h :: [Int] -> Int
        i :: [Int] -> Int
        head :: forall a. [a] -> a
        (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
  |
13 | j = _
  |     ^

Main.hs:14:5: error:
    • Found hole: _sort_by_mod_desc :: [Int] -> Int
      Or perhaps ‘_sort_by_mod_desc’ is mis-spelled, or not in scope
    • In the expression: _sort_by_mod_desc
      In an equation for ‘i’: i = _sort_by_mod_desc
    • Relevant bindings include
        i :: [Int] -> Int (bound at Main.hs:14:1)
      Valid hole fits include
        sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
        product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
        minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
        maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
        length :: forall (t :: * -> *) a. Foldable t => t a -> Int
        last :: forall a. [a] -> a
        (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
  |
14 | i = _sort_by_mod_desc
  |     ^^^^^^^^^^^^^^^^^

Main.hs:15:5: error:
    • Found hole: _only_Data_List :: [Int] -> Int
      Or perhaps ‘_only_Data_List’ is mis-spelled, or not in scope
    • In the expression: _only_Data_List
      In an equation for ‘g’: g = _only_Data_List
    • Relevant bindings include
        g :: [Int] -> Int (bound at Main.hs:15:1)
      Valid hole fits include
        head :: forall a. [a] -> a
        last :: forall a. [a] -> a
  |
15 | g = _only_Data_List
  |     ^^^^^^^^^^^^^^^

Main.hs:16:5: error:
    • Found hole: _only_Prelude :: [Int] -> Int
      Or perhaps ‘_only_Prelude’ is mis-spelled, or not in scope
    • In the expression: _only_Prelude
      In an equation for ‘h’: h = _only_Prelude
    • Relevant bindings include
        h :: [Int] -> Int (bound at Main.hs:16:1)
      Valid hole fits include
        length :: forall (t :: * -> *) a. Foldable t => t a -> Int
        maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
        minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
        product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
        sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
  |
16 | h = _only_Prelude
  |     ^^^^^^^^^^^^^

7.3.7. Плагины вывода значений по умолчанию

Плагины вывода значений по умолчанию вызываются, когда неоднозначные переменные иначе могли бы привести к ошибкам, как и встроенный механизм вывода значений по умолчанию.

Плагин вывода значений по умолчанию может предложить возможные способы разрешения неоднозначных переменных в соответствии с выбранными вами критериями. GHC проверит, не приведут ли эти предложения к ошибкам типов в заданном вами контексте.

У плагинов вывода значений по умолчанию есть одна точка доступа в модуле GHC.Tc.Types

-- | A collection of candidate default types for sets of type variables.
data DefaultingProposal
  = DefaultingProposal
    { deProposals :: [[(TcTyVar, Type)]]
      -- ^ The type variable assignments to try.
    , deProposalCts :: [Ct]
      -- ^ The constraints against which defaults are checked.
  }

type FillDefaulting = WantedConstraints -> TcPluginM [DefaultingProposal]

-- | A plugin for controlling defaulting.
data DefaultingPlugin = forall s. DefaultingPlugin
  { dePluginInit :: TcPluginM s
    -- ^ Initialize plugin, when entering type-checker.
  , dePluginRun :: s -> FillDefaulting
    -- ^ Default some types
  , dePluginStop :: s -> TcPluginM ()
   -- ^ Clean up after the plugin, when exiting the type-checker.
  }

Тип плагина — WantedConstraints -> [DefaultingProposal].

• Ему передаются текущие неразрешённые ограничения.
• Он возвращает список независимых «предложений по выводу значений по умолчанию».

• Каждое предложение типа DefaultingProposal задаёт:

  • deProposals: список наборов присваиваний переменным типов, упорядоченный по приоритету
  • deProposalCts :: [Ct] задаёт набор ограничений (всегда являющийся подмножеством входного WantedConstraints), используемый в качестве критерия принятия

После вызова плагина GHC последовательно выполняет каждое DefaultingProposal. Для «выполнения» предложения GHC по очереди проверяет предложенные присваивания типов в deProposals:

• Он присваивает переменным типов предложенные типы, а затем пытается разрешить deProposalCts
• Если эти ограничения полностью разрешены присваиванием, GHC принимает его и переходит к следующему DefaultingProposal
• В противном случае GHC пробует следующее присваивание в deProposals.

Плагин может считать, что входные ограничения полностью «приведены к нормальной форме» (см. страницу Wiki о приведении к нормальной форме).

Наиболее надёжный deProposalCts — предоставить список всех требуемых ограничений, в которых упоминается переменная, для которой выводится значение по умолчанию. Если опустить ограничение, значение по умолчанию может быть принято, а затем привести к ошибке проверяющего типы, если оно несовместимо с одним из опущенных ограничений. Это может быть полезным способом принудительно задать значение по умолчанию и сообщить об ошибках пользователю.

В тестовом наборе GHC есть пример вывода значений по умолчанию для типов с поднятым уровнем. В каталоге testsuite/tests/plugins/ см. defaulting-plugin/ с реализацией, test-defaulting-plugin.hs с примером случая, когда выполняется вывод значения по умолчанию, и test-defaulting-plugin-fail.hs с примером случая, когда значения по умолчанию не подходят и не применяются.

7.3.8. Управление повторной компиляцией

По умолчанию модули, скомпилированные с плагинами, всегда компилируются повторно, даже если исходный файл не изменился. Выбран этот наиболее консервативный вариант, поскольку плагины могут выполнять произвольные операции ввода-вывода. Чтобы управлять поведением при повторной компиляции, можно изменить поле pluginRecompile в Plugin.

plugin :: Plugin
plugin = defaultPlugin {
  installCoreToDos = install,
  pluginRecompile = purePlugin
  }

Изучив приведённый выше пример plugin, можно увидеть, что он является чистым. Это означает, что если у двух модулей одинаковый отпечаток, плагин всегда будет возвращать один и тот же результат. Объявление плагина чистым означает, что он никогда не приведёт к повторной компиляции модуля.

В общем случае поле pluginRecompile имеет следующий тип:

pluginRecompile :: [CommandLineOption] -> IO PluginRecompile

Тип данных PluginRecompile — перечисление, определяющее влияние плагина на повторную компиляцию.

data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint

Плагин, объявивший себя нечистым с помощью ForceRecompile, всегда будет вызывать повторную компиляцию текущего модуля. NoForceRecompile используется для «чистых» плагинов, которые не нужно запускать повторно, если только модуль не компилируется повторно по обычным причинам. MaybeRecompile вычисляет Fingerprint; если этот Fingerprint отличается от ранее вычисленного для плагина Fingerprint, модуль компилируется повторно.

Поэтому purePlugin определена как функция, всегда возвращающая NoForceRecompile.

purePlugin :: [CommandLineOption] -> IO PluginRecompile
purePlugin _ = return NoForceRecompile

Пользователи могут применять те же функции, что GHC использует внутри для вычисления отпечатков. Модуль GHC.Fingerprint предоставляет полезные функции для создания отпечатков. Например, объединение fingerprintFingerprints и fingerprintString позволяет простым способом наивно вычислить отпечаток аргументов плагина.

pluginFlagRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginFlagRecompile =
  return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort

defaultPlugin задаёт для pluginRecompile значение impurePlugin — самый консервативный и обратно совместимый вариант.

impurePlugin :: [CommandLineOption] -> IO PluginRecompile
impurePlugin _ = return ForceRecompile

7.3.9. Плагины внешнего интерфейса

Плагин внешнего интерфейса позволяет добавлять в GHC новые основные режимы работы. Это может быть предпочтительнее традиционной программы, вызывающей GHC API, поскольку GHC управляет множеством флагов разбора и административных деталей, которыми сложно управлять вручную. Чтобы загрузить плагин внешнего интерфейса, экспортированный Foo.FrontendPlugin, достаточно вызвать GHC со следующим флагом --frontend ⟨module⟩:

$ ghc --frontend Foo.FrontendPlugin ...other options...

Плагины внешнего интерфейса, как и плагины компилятора, экспортируются зарегистрированными плагинами. Однако, в отличие от модулей компилятора, плагины внешнего интерфейса — это модули, экспортирующие как минимум один идентификатор frontendPlugin типа GHC.Plugins.FrontendPlugin.

FrontendPlugin экспортирует поле frontend, представляющее собой функцию [String] -> [(String, Maybe Phase)] -> Ghc (). Первый аргумент — список дополнительных флагов, переданных внешнему интерфейсу с помощью -ffrontend-opt; второй — список аргументов, обычно исходных файлов и имён модулей для компиляции (Phase указывает, был ли задан флаг -x). Внешний интерфейс просто выполняет некоторую операцию в монаде Ghc, которая, помимо прочего, содержит Session.

Для краткого примера рассмотрим плагин внешнего интерфейса, который выводит переданные ему аргументы, а затем завершает работу.

module DoNothing.FrontendPlugin (frontendPlugin) where
import GHC.Plugins

frontendPlugin :: FrontendPlugin
frontendPlugin = defaultFrontendPlugin {
  frontend = doNothing
  }

doNothing :: [String] -> [(String, Maybe Phase)] -> Ghc ()
doNothing flags args = do
    liftIO $ print flags
    liftIO $ print args

Скомпилировав этот плагин и зарегистрировав его в пакете, его можно использовать, указав в командной строке GHC --frontend DoNothing.FrontendPlugin.

7.3.10. Плагины DynFlags

Плагин DynFlags позволяет изменять DynFlags, которые GHC будет использовать при обработке заданного файла или набора файлов. DynFlags — это запись, содержащая самые разные настройки и данные командной строки: от уровня подробности вывода до используемой библиотеки целых чисел, включая хуки компилятора, плагины и параметры форматирования. Плагины DynFlags позволяют авторам плагинов обновлять любые из этих значений до начала фактической работы GHC. Таким образом, указанные плагином изменения учитываются и влияют на поведение GHC.

Одним из примеров, послуживших мотивацией, была возможность регистрировать хуки компилятора из плагина. Например, может потребоваться изменить способ выполнения кода Template Haskell. Это можно сделать, обновив поле hooks типа DynFlags и записав наш собственный «метахук» в нужное место. Ниже показан простой пример такого подхода:

module DynFlagsPlugin (plugin) where

import BasicTypes
import GHC.Plugins
import GHC.Hs.Expr
import Language.Haskell.Syntax.Extension
import GHC.Hs.Lit
import Hooks
import GHC.Tc.Utils.Monad

plugin :: Plugin
plugin = driverPlugin { driverPlugin = hooksP }

hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv
hooksP opts hsc_env = do
    let hooks'   = (hsc_hooks hsc_env)
                    { runMetaHook = Just (fakeRunMeta opts) }
        hsc_env' = hsc_env { hsc_hooks = hooks' }
    return hsc_env'

-- This meta hook doesn't actually care running code in splices,
-- it just replaces any expression splice with the "0"
-- integer literal, and errors out on all other types of
-- meta requests.
fakeRunMeta :: [CommandLineOption] -> MetaHook TcM
fakeRunMeta opts (MetaE r) _ = do
  liftIO . putStrLn $ "Options = " ++ show opts
  pure $ r zero

  where zero :: LHsExpr GhcPs
        zero = L noSrcSpan $ HsLit NoExtField $
          HsInt NoExtField (mkIntegralLit (0 :: Int))

fakeRunMeta _ _ _ = error "fakeRunMeta: unimplemented"

Этот простой плагин перехватывает выполнение кода Template Haskell, заменяя каждую встреченную вставку выражения на 0 (типа Int), и выдаёт ошибку при любом другом типе вставки.

Поэтому, если запустить GHC со следующим кодом и плагином, показанным выше:

{-# OPTIONS -fplugin=DynFlagsPlugin #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where

main :: IO ()
main = print $( [|1|] )

[|1|] фактически не будет вычислено, а вместо него будет подставлен литерал 0 :: Int.

Как и для других типов плагинов, можно писать плагины DynFlags, которые принимают параметры и используют их; эти параметры можно задавать с помощью флага -fplugin-opt. В коде DynFlagsPlugin, приведённом выше, указанные параметры будут доступны в аргументе opts функции hooksP.

Наконец, поскольку эти обновления DynFlags происходят после загрузки плагинов, из плагина DynFlags нельзя зарегистрировать другие плагины, просто добавив их в поле plugins типа DynFlags. Для этого их необходимо загрузить самостоятельно и сохранить результат в поле cachedPlugins типа DynFlags.

7.4.1. Клиентский код, который только задаёт имена бэкендов

Предположим, что ваш клиентский код использует Backend только для указания бэкендов по имени, то есть никогда не различает бэкенды в выражении case, определении функции или сравнении на равенство. В этом случае проще всего перенести код, заменив каждый конструктор значения из версии 9.4 соответствующим значением из версии 9.6:

7.4.2. Клиентский код, различающий бэкенды

Предположим, ваш код принимает решения на основе значения выражения типа Backend. Тогда простейший способ перенести код принятия решений зависит от его формы.

• Если решение принимается с помощью предиката равенства или неравенства, в модуле GHC.Driver.Backend уже может быть определён эквивалентный предикат. Например, если клиенту нужно убедиться, что разрешены уровни оптимизации выше -O0, изначально он мог сравнивать с backend /= Interpreter. Теперь для этого есть предикат: not (backendForcesOptimization0 backend).

  Если нужный предикат ещё не определён, придётся воспользоваться более общим подходом, описанным ниже.

• Если решение по-прежнему принимается с помощью предиката, но его реализация проверяет форму Backend, возможно, вам повезло. Например, если клиенту нужно узнать, записывает ли Backend файлы на диск, он может запросить backendWritesFiles backend. В версии 9.4 этот предикат выполняется для бэкендов NCG, LLVM и Via-C, но не для интерпретатора или NoBackend.
• В общем случае для любого определения функции, выражения case или проверки на равенство, различающих бэкенды, можно воспользоваться описанным ниже общим подходом к переносу.

7.4.3. Общий подход к переносу клиентского кода

Начиная с версии 9.6 можно запросить имя каждого бэкенда:

backendName :: Backend -> BackendName

Тип BackendName необходимо импортировать из модуля GHC.Driver.Backend.Internal. Он определён так, чтобы выглядеть как старый тип Backend:

data BackendName
   = NCG
   | LLVM
   | ViaC
   | Interpreter
   | NoBackend

Этот тип также является экземпляром классов Eq и Show.

Если существующий код различает бэкенды с помощью выражения case, к проверяемому выражению нужно применить backendName.

case backend dflags of  -- code using the 9.4 interface
  NCG -> ...
  LLVM -> ...
  ...

можно заменить на

case backendName $ backend dflags of  -- code using the 9.6 interface
  NCG -> ...
  LLVM -> ...
  ...

Меняется только проверяемое выражение, а не сопоставления с образцами. Если раньше сопоставления с образцами были полными, они останутся полными и после изменения.