Question

考虑以下类型（在Haskell中）：

data CType = CInt | CDouble | CProduct String [(String, CType)]

我想有一个函数可以生成相应的Haskell类型声明。构造函数CInt和CDouble应对应Int和Double类型，因此不会声明。 (CProduct t ts)应对应于t定义的名称和构造函数以及ts列表定义的字段的记录类型。例如：

ty :: CType
ty = CProduct "Type1" [("proj10", CDouble), ("proj11", CProduct "Type0" [("proj0", CInt)])]

应该产生两个定义：

data Type0 = Type0 {proj0 :: Int}
data Type1 = Type1 {proj10 :: Double, proj11 :: Type0}

要定义此功能，我使用Template Haskell：

genType :: CType -> Q Type
genType CInt = return (ConT ''Int)
genType CDouble = return (ConT ''Double)
genType (CProduct s t) =
    do
      l <- lookupTypeName s
      case l of
        Just sn -> return (ConT sn)
        Nothing ->
            do
              sn <- newName s
              return (ConT sn)

genField :: (String, CType) -> Q VarStrictType
genField (s , t) =
    do
      sn <- newName s
      tn <- genType t
      return (sn, NotStrict, tn)

genDecl :: CType -> Q [Dec]
genDecl CInt = return []
genDecl CDouble = return []
genDecl (CProduct s t) =
    do
      ts <- fmap join . mapM (genDecl . snd) $ t
      res <- lookupTypeName s
      case res of
        Just _ -> return ts
        Nothing ->
            do
              sn <- newName s
              sc <- newName s      
              fn <- mapM genField $ t
              let
                  dt = DataD [] sn [] [RecC sc fn] []
              return (dt : ts)

当我使用上面定义的$(genDecl ty) ty :: CType调用该函数时出现以下错误：

The exact Name ‘Type0_adN6’ is not in scope …
      Probable cause: you used a unique Template Haskell name (NameU), 
      perhaps via newName, but did not bind it

但是当我逐一生成定义时，一切都很好：

$(fmap (\[x, y] -> [y]) . genDecl $ ty)

$(genDecl $ ty)

所以问题是：如何在Q monad中正确添加类型声明以一次性生成它们？

Answer 1

这是我对发生的事情的评估......

考虑这个也失败的简化示例：

ty :: CType
ty = CProduct "Type1" [  ("proj11", CProduct "Type0" [("proj0", CInt)]) ]

genType

CProduct "Type1" ...
生成Type1字段的声明（进入ts
ts包含Type0的定义。这个宣言有效。
然后调用lookupTypName "Type1"，这将返回Nothing
因此，使用DataD

fn

但字段定义并未引用步骤2中创建的声明。

以某种方式为genField调用"proj11"时，您必须使用ts中返回的声明来创建字段。

<强>更新

以下是您需要执行的内联版本：

blah :: Q [Dec]
blah = do
  let ty_int = ConT ''Int
  t0_cname <- newName "Type0"
  proj0_name <-  newName "proj0"
  let t0_rec = RecC t0_cname [ (proj0_name, NotStrict, ty_int) ]
  t0_tname <- newName "Type0"
  let t0_decl = DataD [] t0_tname [] [t0_rec] []

  proj11_name <- newName "proj11"
  t1_cname <- newName "Type1"
  let t1_rec = RecC t1_cname [ (proj11_name, NotStrict, ConT t0_tname) ]
  t1_tname <- newName "Type1"
  let t1_decl = DataD [] t1_tname [] [t1_rec] []

  return [t0_decl, t1_decl]

如果您展开$(blah)它应该有效，而且您会看到：

*Main> :i Type0
data Type0 = Type0 {proj0 :: Int}   -- Defined at ...
*Main> :i Type1
data Type1 = Type1 {proj11 :: Type0}    -- Defined at ...

密钥位于t1_rec分配中。对于字段的类型，您必须使用{0}的t0_name构造函数中使用的相同名称（DataD）。

Answer 2

以下版本似乎按预期工作：

genType :: [(String, Name)] -> CType -> Q Type
genType db CInt = return (ConT ''Int)
genType db CDouble = return (ConT ''Double)
genType db (CProduct s t) =
    do
      let 
          res = lookup s db
      case res of
        Nothing -> return (TupleT 0)
        Just n -> return (ConT n)

genField :: [(String, Name)] -> (String, CType) -> Q VarStrictType
genField db (s , t) =
    do
      sn <- newName s
      tn <- genType db t
      return (sn, NotStrict, tn)

todb = map (\(x, _) -> (nameBase x, x))
crit (x, _) (y, _) = nameBase x == nameBase y 

genDecl :: CType -> Q [(Name, Dec)]
genDecl CInt = return []
genDecl CDouble = return []
genDecl (CProduct s t) =
    do
      ts <- fmap (nubBy crit . join) . mapM (genDecl . snd) $ t
      res0 <- lookupTypeName s
      let
          db = todb ts
          res1 = lookup s db       
      case (res0 , res1) of
        (Just _ , Just _) -> return ts
        (Just _ , Nothing) -> return ts
        (Nothing , Just _) -> return ts
        (Nothing , Nothing) ->
            do
              sn <- newName s
              sc <- newName s
              fs <- mapM (genField db) $ t
              let
                  dt = DataD [] sn [] [RecC sc fs] []
              return ((sn, dt) : ts)

在Template Haskell

2 个答案: