问题描述
我正在编写一个代码生成器,其输出取决于存储在其类实例中的数据类型字段描述。但是,我找不到如何用TH生成的参数运行函数。
I am writing a code generator whose output depends on datatype fields description which is stored in their class instances. However, I cannot find how to run a function with a TH-generated argument.
{-# 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'] ]
当另一个模块尝试使用发电机
When another module tries to use Generator
{-# 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" []]
-}
出现错误
there appears an error
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中至关重要的事情,通过将一些函数移动到其他模块来解决。
When asking I thought that the issue appeared just because I just did not grasp something crucial in TH and it could be resolved with moving some functions to the other modules.
如果不可能像问题中的示例那样生成预先计算的数据,我想了解更多关于理论TH的限制。
If it is impossible to generate precomputed data as in example from the question, I would like to learn more about the theoretical restrictions of TH.
推荐答案
这确实是舞台限制的问题。 Hammar指出,问题在于调用 getDescription
。
This is indeed an issue with the stage restriction. The problem, as hammar pointed out, lies with the call to getDescription
.
let mkSubDesc t = ... getDescription (undefined :: $(return t)) ...
函数 getDescription
被重载,编译器根据它的参数类型选择实现。
The function getDescription
is overloaded, and the compiler chooses the implementation based on the type of its argument.
class HasDescription a where
getDescription :: a -> Description
类型类根据类型重载。将 t
转换为类型的唯一方法是编译它。但编译它会将类型放入已编译的程序中。对 getDescription
的调用在编译时运行 ,所以它无法访问该类型。
Type classes are overloaded based on types. The only way to convert t
to a type is to compile it. But compiling it puts the type in the compiled program. The call to getDescription
runs at compile time, so it has no access to that type.
如果你真的想在模板Haskell中评估 getDescription
,你必须编写你自己的 getDescription
的实现。读取模板Haskell在编译时可用的数据结构。
If you really want to evaluate getDescription
in Template Haskell, you have to write your own implementation of getDescription
that reads the Template Haskell data structure that is available at compile time.
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"
这篇关于如何规避GHC阶段限制?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!