折叠递归型系列

mb1*_*b14 4 haskell type-families data-kinds

我正在尝试使用幻像类型[*]折叠数据.这是我的代码的简化版本

{-# LANGUAGE DataKinds, KindSignatures #-}

module Stack where
import Data.HList
import Data.Foldable as F

data T (a :: [*]) = T (Tagged a String)
(!++!) :: T a -> T b -> T (HAppendList a b)
(T a) !++! (T b) = T (Tagged (untag a ++ untag b))


a = T (Tagged "1") :: T '[Int]
b = T (Tagged "-- ") :: T '[]
ab = a !++! b :: T '[Int]
Run Code Online (Sandbox Code Playgroud)

我想要一个折叠操作员

(!++*) :: (Foldable t ) =>  T a -> t (T '[]) -> T a
a !++* t = F.foldl (!++!) a t
Run Code Online (Sandbox Code Playgroud)

但这不起作用.编译器aHAppendList a '[]它们不同,即使它们不是.

为什么不能编译统一HAppendList a '[]a

(虽然我不能在ghci中手动完成折叠 :t a !++! b !++! b !++! b => T '[Int]

use*_*038 5

注意定义HAppendList:

type family HAppendList (l1 :: [k]) (l2 :: [k]) :: [k]
type instance HAppendList '[] l = l
type instance HAppendList (e ': l) l' = e ': HAppendList l l'
Run Code Online (Sandbox Code Playgroud)

你和我知道这[]是左右身份++,但编译器只知道左侧身份:

happend' :: T a -> T b -> T (HAppendList a b)
happend' (T (Tagged a)) (T (Tagged b)) = (T (Tagged (a++b)))

-- Doesn't typecheck 
leftIdentity' :: T a -> T '[] -> T a 
leftIdentity' x y = happend' x y 

rightIdentity' :: T '[] -> T a -> T a 
rightIdentity' x y = happend' x y 
Run Code Online (Sandbox Code Playgroud)

你需要

type instance HAppendList '[] l = l
type instance HAppendList l '[] = l
type instance HAppendList (e ': l) l' = e ': HAppendList l l'
Run Code Online (Sandbox Code Playgroud)

让编译器知道左右身份; 但这些会重叠,所以它不会打字.但是,你可以翻开争论:

(!+++!) :: T a -> T b -> T (HAppendList a b) 
(!+++!) (T (Tagged x)) (T (Tagged y)) = T (Tagged (y ++ x))

(!++*) :: Foldable t => T a -> t (T '[]) -> T a
a !++* t = F.foldl (flip (!+++!)) a t
Run Code Online (Sandbox Code Playgroud)

对于ghc 7.8中引入的封闭类型系列,您可以解决此问题:

type family (++) (a :: [k]) (b :: [k]) :: [k] where 
  '[] ++ x = x
  x ++ '[] = x
  (x ': xs) ++ ys = x ': (xs ++ ys)

happend :: T a -> T b -> T (a ++ b)
happend (T (Tagged a)) (T (Tagged b)) = (T (Tagged (a++b)))

leftIdentity :: T a -> T '[] -> T a 
leftIdentity x y = happend x y 

rightIdentity :: T '[] -> T a -> T a 
rightIdentity x y = happend x y 
Run Code Online (Sandbox Code Playgroud)