如何定义多态的Tagless Final列表？

我在阅读Oleg Kiselyov的《Typed Tagless-Final Interpretations: Introductory Course》后，尝试将普通Haskell列表转为Tagless Final列表时遇到了问题。

可正常运行的Int类型Tagless Final列表 #

以下代码实现了仅支持Int元素的Tagless Final列表，运行正常：

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module TList

where

class TList repr  where
  tnil :: repr
  tcons :: Int -> repr -> repr

tlist0 :: TList repr => repr
tlist0 = tnil

tlist1 :: TList repr => repr
tlist1 = tcons 1 $ tcons 2 $ tcons 3 tnil

instance TList String where
  tnil = "tnil"
  tcons hd tail = "tcons " ++ show hd ++ " $ " ++ tail

view :: String -> String
view = id

执行view tlist1会得到字符串："tcons 1 $ tcons 2 $ tcons 3 $ tnil"。

尝试定义多态列表遇到的问题 #

为了支持任意元素类型，我定义了多态版本的PList类：

class PList repr a where
  pnil :: repr a
  pcons :: a -> repr a -> repr a

plist0 :: forall (repr :: * -> *) a. PList repr a => repr a
plist0 = pnil

plist1 :: PList repr Int => repr Int
plist1 = pcons 1 $ pcons 2 $ pcons 3 pnil

这段代码可以编译，但尝试为String定义实例时失败：

错误的实例代码 #

instance PList String where
  pnil = "pnil"
  pcons hd tail = "pcons " ++ show hd ++ " $ " ++ tail

报错信息 #

[1 of 1] Compiling TList            ( List/List.hs, interpreted ) [Source file changed]

List/List.hs:30:10: error:
    • Expecting one more argument to ‘PList String’
      Expected a constraint,
        but ‘PList String’ has kind ‘* -> Constraint’
    • In the instance declaration for ‘PList String’
   |
30 | instance PList String where
   |          ^^^^^^^^^^^^

List/List.hs:30:16: error:
    • Expected kind ‘* -> *’, but ‘String’ has kind ‘*’
    • In the first argument of ‘PList’, namely ‘String’
      In the instance declaration for ‘PList String’
   |
30 | instance PList String where
   |                ^^^^^^

改为instance PList String Int where仍报错：

List/List.hs:30:16: error:
    • Expected kind ‘* -> *’, but ‘String’ has kind ‘*’
    • In the first argument of ‘PList’, namely ‘String’
      In the instance declaration for ‘PList String Int’
   |
30 | instance PList String Int where
   |                ^^^^^^

核心问题是：PList类要求第一个参数是* -> *种类的类型（即接受类型参数的构造器），但String是*种类的具体类型，无法直接匹配。

解决方案：包装String为* -> *种类的类型 #

我们可以定义一个新的包装类型，将String提升为带类型参数的构造器，满足PList的种类要求：

完整修正代码 #

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module TList

where

class PList repr a where
  pnil :: repr a
  pcons :: a -> repr a -> repr a

plist0 :: forall (repr :: * -> *) a. PList repr a => repr a
plist0 = pnil

plist1 :: PList repr Int => repr Int
plist1 = pcons 1 $ pcons 2 $ pcons 3 pnil

-- 定义包装类型，将String转为* -> *种类
newtype ShowList a = ShowList String

-- 为包装类型实现PList实例
instance Show a => PList ShowList a where
  pnil = ShowList "pnil"
  pcons hd (ShowList tail) = ShowList $ "pcons " ++ show hd ++ " $ " ++ tail

-- 提取包装后的字符串
viewShow :: ShowList a -> String
viewShow (ShowList s) = s

现在执行viewShow plist1就能得到预期结果："pcons 1 $ pcons 2 $ pcons 3 $ pnil"。

原理说明 #

ShowList a是一个带类型参数的新类型，虽然内部只存储String，但它的种类是* -> *，完全符合PList对repr参数的要求。同时我们添加了Show a约束，确保列表元素可以被转换为字符串输出。

内容的提问来源于stack exchange，提问作者Jogger