Как обойти ограничение стадии GHC?

Я пишу генератор кода, вывод которого зависит от описания полей типа данных, которое хранится в их экземплярах класса. Однако я не могу найти, как запустить функцию с аргументом, сгенерированным TH.

{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
module Generator where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax

data Description = Description String [Description] deriving Show

class HasDescription a where
  getDescription :: a -> Description

instance HasDescription Int where
  getDescription _ = Description "Int" []

instance (HasDescription a, HasDescription b) => HasDescription (a, b) where
  getDescription (_ :: (a, b)) = Description "Tuple2" [getDescription (undefined :: a), getDescription (undefined :: b)]

-- | creates instance of HasDescription for the passed datatype changing descriptions of its fields
mkHasDescription :: Name -> Q [Dec]
mkHasDescription dName = do
  reify dName >>= runIO . print
  TyConI (DataD cxt name tyVarBndr [NormalC cName types] derives) <- reify dName
  -- Attempt to get description of data to modify it.
  let mkSubDesc t = let Description desc ds = getDescription (undefined :: $(return t)) in [| Description $(lift $ desc ++ "Modified") $(lift ds) |]

  let body = [| Description $(lift $ nameBase dName) $(listE $ map (mkSubDesc . snd) types) |]
  getDescription' <- funD 'getDescription [clause [wildP] (normalB body) []]
  return [ InstanceD [] (AppT (ConT ''HasDescription) (ConT dName)) [getDescription'] ]

Когда другой модуль пытается использовать Генератор

{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
import Generator

data MyData = MyData Int Int

mkHasDescription ''MyData

{- the code I want to generate
instance HasDescription MyData where
  getDescription _ = Description "MyData" [Description "IntModified" [], Description "IntModified" []]
-}

появляется ошибка

Generator.hs:23:85:
GHC stage restriction: `t'
  is used in a top-level splice or annotation,
  and must be imported, not defined locally
In the first argument of `return', namely `t'
In the expression: return t
In an expression type signature: $(return t)

редактировать:

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

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


haskell template-haskell
person Boris    schedule 02.04.2012    source источник
comment
Я нахожу это... удивительным, что это не сработает. Возможно, вам тоже нужно включить QuasiQuotes?   -  person Louis Wasserman    schedule 02.04.2012

Ответы (2)


arrow_upward
4
arrow_downward

Это действительно проблема с ограничением сцены. Проблема, как указал Хаммар, заключается в вызове getDescription.

let mkSubDesc t = ... getDescription (undefined :: $(return t)) ...

Функция getDescription перегружена, и компилятор выбирает реализацию на основе типа своего аргумента.

class HasDescription a where
  getDescription :: a -> Description

Классы типов перегружаются на основе типов. Единственный способ преобразовать t в тип — это скомпилировать его. Но при его компиляции тип помещается в скомпилированную программу. Вызов getDescription выполняется во время компиляции, поэтому у него нет доступа к этому типу.

Если вы действительно хотите оценить getDescription в Template Haskell, вам нужно написать собственную реализацию getDescription, которая считывает структуру данных Template Haskell, доступную во время компиляции.

getDescription2 :: Type -> Q Description
getDescription2 t = cases con [ ([t| Int |], "Int")
                              , (return (TupleT 2), "Tuple")
                              ]
  where
    (con, ts) = fromApp t
    fromApp (AppT t1 t2) = let (c, ts) = fromApp t1 in (c, ts ++ [t2])
    fromApp t = (t, [])
    cases x ((make_y, name):ys) = do y <- make_y
                                     if x == y
                                       then do ds <- mapM getDescription2 ts
                                               return $ Description name ds
                                       else cases x ys
    cases x [] = error "getDescription: Unrecognized type"
person Heatsink    schedule 02.04.2012

arrow_upward
7
arrow_downward

Вы можете исправить это, переместив привязку let внутрь оксфордских скобок:

let mkSubDesc t = [| let Description desc ds = getDescription (undefined :: $(return t))
                     in Description (desc ++ "Modified") ds |]

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

person hammar    schedule 02.04.2012
comment
Спасибо за совет. Ранее я думал о перемещении let внутри квадратных скобок, но код будет вызываться часто, поэтому он должен быть быстрым. Бенчмарк Criterion показывает, что getDescription с let работает медленнее, чем с уже измененным описанием (на самом деле я пробовал его на других функциях и типах данных — HasDescription — это просто упрощение). - person Boris; 02.04.2012