使用 generics-sop 删除特定类型的字段
Delete fields of certain type with generics-sop
我目前正在评估 Generics.SOP 一个涉及从给定数据类型定义派生新的相关数据类型的用例。
我想首先定义表示 lambda 项的数据类型的“de Bruijinized”版本：
-- The reproducer needs only some of the LANGUAGE pragmas and imports,
-- but it might be convenient for your (or my) solutions
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
module SOP where
import Data.SOP.NS
import Generics.SOP
import Generics.SOP.TH
import Data.Kind
newtype Var = V String
deriving (Eq, Ord, Show)
newtype BindingOcc = B Var
deriving (Eq, Ord, Show)
data Expr
= Var Var
| App Expr Expr
| Lam BindingOcc Expr
deriveGeneric ''Expr -- Code Expr = '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
要导出 Expr 的 de Bruijinized 版本，我必须删除所有 BindingOcc（然后添加一个新的 '[Int] 替代方案，但一个接一个）。 我该怎么做？也许有一个功能
-- Let's be absolutely explicit about it and inline `Code`
-- Also don't want to confuse the type-checker with a type
-- family that removes the field just yet
deleteBindingOcc_SOP :: SOP I '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
-> SOP I '[ '[Var], '[Expr, Expr], '[Expr]]
deleteBindingOcc_SOP arg = SOP $ trans_NS Proxy {- will be filled in below -} deleteBindingOcc_NP (unSOP arg)
deleteBindingOcc_NP :: NP I xs -> NP I (WithoutBindingOccs xs)
deleteBindingOcc_NP Nil = Nil
deleteBindingOcc_NP (x :* xs)
| B _ <- x = deleteBindingOcc_NP xs
| otherwise = x :* deleteBindingOcc_NP xs
-- I guess I expected to write the following type family
type family WithoutBindingOcc (xs :: [Type]) :: [Type] where
WithoutBindingOcc '[] = '[]
WithoutBindingOcc (BindingOcc ': xs) = WithoutBindingOcc xs
WithoutBindingOcc (x ': xs) = x ': WithoutBindingOcc xs
但是，唉，这没有类型检查；一方面，我在 deleteBindingOcc_NP 的定义中在运行时匹配 xs 的参数多态头，所以我需要一个单例 encoding/derive 类型 class 只是为了这个目的定义我的小辅助函数 deleteBindingOcc_NP.
这里是：
-- Now we know the full type of the proxy, carrying the constraint that `deleteBindingOcc_NP` wants
deleteBindingOcc_SOP arg = SOP $ trans_NS (Proxy :: Proxy MyC) deleteBindingOcc_NP (unSOP arg)
class b ~ WithoutBindingOcc a => MyC a b where -- welp
deleteBindingOcc_NP :: NP I a -> NP I b
instance MyC '[] '[] where
deleteBindingOcc_NP Nil = Nil
instance {-# OVERLAPPING #-} MyC a b => MyC (BindingOcc ': a) b where
deleteBindingOcc_NP (_ :* xs) = deleteBindingOcc_NP xs
instance {-# OVERLAPPABLE #-} MyC a b => MyC (x ': a) (x ': b) where
deleteBindingOcc_NP (x :* xs) = x :* deleteBindingOcc_NP xs
但即使这样也行不通，因为重叠的实例不会进行类型检查：
• Could not deduce: WithoutBindingOcc (x : a) ~ (x : b)
arising from the superclasses of an instance declaration
from the context: MyC a b
bound by the instance declaration at SOP2.hs:52:31-62
• In the instance declaration for ‘MyC (x : a) (x : b)’
|
52 | instance {-# OVERLAPPABLE #-} MyC a b => MyC (x ': a) (x ': b) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
稍微考虑一下，这并不奇怪：没有 保证 后一种类型 class 永远不会用 [=16= 实例化] 在它的头部 x，我们的类型族应该删除它。所以看起来基于类型 class 的方法不是我想要的。
我的问题是：如何使用给定的类型签名编写 deleteBindingOcc_SOP，使其与不同但相似相关的 Code 一起工作？
我担心 Code 作为 元语言 Type 结构列表的表示可能不适合实现我想要的。不知何故，我们无法知道所有 Type 实际上都已关闭并且不会被进一步替换。
我不知道你在做什么是不是个好主意...
但除此之外，这里有至少适用于您的简单用例的东西。
type family Equal (a :: k) (b :: k) :: Bool where
Equal a a = True
Equal _ _ = False
type family IfThenElse (b :: Bool) (t :: a) (e :: a) where
IfThenElse True t _ = t
IfThenElse False _ e = e
class CanDecide (b :: Bool) where
ifthenelse :: Proxy b -> ((b ~ True) => r) -> ((b ~ False) => r) -> r
instance CanDecide True where ifthenelse _ x _ = x
instance CanDecide False where ifthenelse _ _ y = y
class CanDecide (Equal a BindingOcc) => IsBindingOcc a
instance CanDecide (Equal a BindingOcc) => IsBindingOcc a
type family DeleteBindingOcc (xs :: [Type]) :: [Type] where
DeleteBindingOcc '[] = '[]
DeleteBindingOcc (x : xs) = IfThenElse (Equal x BindingOcc) (DeleteBindingOcc xs) (x : DeleteBindingOcc xs)
class (All IsBindingOcc xs, DeleteBindingOcc xs ~ ys) => RelDeleteBindingOcc xs ys
instance (All IsBindingOcc xs, DeleteBindingOcc xs ~ ys) => RelDeleteBindingOcc xs ys
deleteBindingOcc_NP :: RelDeleteBindingOcc xs ys => NP f xs -> NP f ys
deleteBindingOcc_NP Nil = Nil
deleteBindingOcc_NP ((x :: f x) :* xs) =
let
ys = deleteBindingOcc_NP xs
in
ifthenelse (Proxy @(Equal x BindingOcc)) ys (x :* ys)
deleteBindingOcc_SOP :: SOP I '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
-> SOP I '[ '[Var], '[Expr, Expr], '[Expr]]
deleteBindingOcc_SOP arg = SOP $ trans_NS (Proxy @RelDeleteBindingOcc) deleteBindingOcc_NP (unSOP arg)
顺便说一句，有一个名为 generic-data-surgery 的漂亮库（不幸的是我自己从未使用过）声称擅长这类事情。
也许我们可以依赖函数依赖，而不是使用类型族来关联原始类型和剥离类型：
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-} -- required by some of the magic below
{-# LANGUAGE TypeApplications #-}
class MyC a b | a -> b where
deleteBindingOcc_NP :: NP I a -> NP I b
instance MyC '[] '[] where
deleteBindingOcc_NP Nil = Nil
instance {-# OVERLAPPING #-} MyC a b => MyC (BindingOcc ': a) b where
deleteBindingOcc_NP (_ :* xs) = deleteBindingOcc_NP xs
instance {-# OVERLAPPABLE #-} MyC a b => MyC (x ': a) (x ': b) where
deleteBindingOcc_NP (x :* xs) = x :* deleteBindingOcc_NP xs
这似乎有效：
deleteBindingOcc_SOP :: SOP I '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
-> SOP I '[ '[Var], '[Expr, Expr], '[Expr]]
deleteBindingOcc_SOP arg = SOP $ trans_NS (Proxy @MyC) deleteBindingOcc_NP (unSOP arg)
具有辅助 MyC' class 而不是重叠实例的替代版本：
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
import Data.Kind
import GHC.TypeLits
import Data.Type.Equality
class MyC a b | a -> b where
deleteBindingOcc_NP :: NP I a -> NP I b
class MyC' (isocc :: Bool) a b | a -> b where
deleteBindingOcc_NP' :: NP I a -> NP I b
instance MyC '[] '[] where
deleteBindingOcc_NP Nil = Nil
instance MyC' (x == BindingOcc) (x ': xs) ys => MyC (x ': xs) ys where
deleteBindingOcc_NP = deleteBindingOcc_NP' @(x == BindingOcc)
instance MyC a b => MyC' True (BindingOcc ': a) b where
deleteBindingOcc_NP' (_ :* xs) = deleteBindingOcc_NP xs
instance MyC a b => MyC' False (x ': a) (x ': b) where
deleteBindingOcc_NP' (x :* xs) = x :* deleteBindingOcc_NP xs
我目前正在评估 Generics.SOP 一个涉及从给定数据类型定义派生新的相关数据类型的用例。
我想首先定义表示 lambda 项的数据类型的“de Bruijinized”版本：
-- The reproducer needs only some of the LANGUAGE pragmas and imports,
-- but it might be convenient for your (or my) solutions
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
module SOP where
import Data.SOP.NS
import Generics.SOP
import Generics.SOP.TH
import Data.Kind
newtype Var = V String
deriving (Eq, Ord, Show)
newtype BindingOcc = B Var
deriving (Eq, Ord, Show)
data Expr
= Var Var
| App Expr Expr
| Lam BindingOcc Expr
deriveGeneric ''Expr -- Code Expr = '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
要导出 Expr 的 de Bruijinized 版本，我必须删除所有 BindingOcc（然后添加一个新的 '[Int] 替代方案，但一个接一个）。 我该怎么做？也许有一个功能
-- Let's be absolutely explicit about it and inline `Code`
-- Also don't want to confuse the type-checker with a type
-- family that removes the field just yet
deleteBindingOcc_SOP :: SOP I '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
-> SOP I '[ '[Var], '[Expr, Expr], '[Expr]]
deleteBindingOcc_SOP arg = SOP $ trans_NS Proxy {- will be filled in below -} deleteBindingOcc_NP (unSOP arg)
deleteBindingOcc_NP :: NP I xs -> NP I (WithoutBindingOccs xs)
deleteBindingOcc_NP Nil = Nil
deleteBindingOcc_NP (x :* xs)
| B _ <- x = deleteBindingOcc_NP xs
| otherwise = x :* deleteBindingOcc_NP xs
-- I guess I expected to write the following type family
type family WithoutBindingOcc (xs :: [Type]) :: [Type] where
WithoutBindingOcc '[] = '[]
WithoutBindingOcc (BindingOcc ': xs) = WithoutBindingOcc xs
WithoutBindingOcc (x ': xs) = x ': WithoutBindingOcc xs
但是，唉，这没有类型检查；一方面，我在 deleteBindingOcc_NP 的定义中在运行时匹配 xs 的参数多态头，所以我需要一个单例 encoding/derive 类型 class 只是为了这个目的定义我的小辅助函数 deleteBindingOcc_NP.
这里是：
-- Now we know the full type of the proxy, carrying the constraint that `deleteBindingOcc_NP` wants
deleteBindingOcc_SOP arg = SOP $ trans_NS (Proxy :: Proxy MyC) deleteBindingOcc_NP (unSOP arg)
class b ~ WithoutBindingOcc a => MyC a b where -- welp
deleteBindingOcc_NP :: NP I a -> NP I b
instance MyC '[] '[] where
deleteBindingOcc_NP Nil = Nil
instance {-# OVERLAPPING #-} MyC a b => MyC (BindingOcc ': a) b where
deleteBindingOcc_NP (_ :* xs) = deleteBindingOcc_NP xs
instance {-# OVERLAPPABLE #-} MyC a b => MyC (x ': a) (x ': b) where
deleteBindingOcc_NP (x :* xs) = x :* deleteBindingOcc_NP xs
但即使这样也行不通，因为重叠的实例不会进行类型检查：
• Could not deduce: WithoutBindingOcc (x : a) ~ (x : b)
arising from the superclasses of an instance declaration
from the context: MyC a b
bound by the instance declaration at SOP2.hs:52:31-62
• In the instance declaration for ‘MyC (x : a) (x : b)’
|
52 | instance {-# OVERLAPPABLE #-} MyC a b => MyC (x ': a) (x ': b) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
稍微考虑一下，这并不奇怪：没有 保证 后一种类型 class 永远不会用 [=16= 实例化] 在它的头部 x，我们的类型族应该删除它。所以看起来基于类型 class 的方法不是我想要的。
我的问题是：如何使用给定的类型签名编写 deleteBindingOcc_SOP，使其与不同但相似相关的 Code 一起工作？
我担心 Code 作为 元语言 Type 结构列表的表示可能不适合实现我想要的。不知何故，我们无法知道所有 Type 实际上都已关闭并且不会被进一步替换。
我不知道你在做什么是不是个好主意...
但除此之外，这里有至少适用于您的简单用例的东西。
type family Equal (a :: k) (b :: k) :: Bool where
Equal a a = True
Equal _ _ = False
type family IfThenElse (b :: Bool) (t :: a) (e :: a) where
IfThenElse True t _ = t
IfThenElse False _ e = e
class CanDecide (b :: Bool) where
ifthenelse :: Proxy b -> ((b ~ True) => r) -> ((b ~ False) => r) -> r
instance CanDecide True where ifthenelse _ x _ = x
instance CanDecide False where ifthenelse _ _ y = y
class CanDecide (Equal a BindingOcc) => IsBindingOcc a
instance CanDecide (Equal a BindingOcc) => IsBindingOcc a
type family DeleteBindingOcc (xs :: [Type]) :: [Type] where
DeleteBindingOcc '[] = '[]
DeleteBindingOcc (x : xs) = IfThenElse (Equal x BindingOcc) (DeleteBindingOcc xs) (x : DeleteBindingOcc xs)
class (All IsBindingOcc xs, DeleteBindingOcc xs ~ ys) => RelDeleteBindingOcc xs ys
instance (All IsBindingOcc xs, DeleteBindingOcc xs ~ ys) => RelDeleteBindingOcc xs ys
deleteBindingOcc_NP :: RelDeleteBindingOcc xs ys => NP f xs -> NP f ys
deleteBindingOcc_NP Nil = Nil
deleteBindingOcc_NP ((x :: f x) :* xs) =
let
ys = deleteBindingOcc_NP xs
in
ifthenelse (Proxy @(Equal x BindingOcc)) ys (x :* ys)
deleteBindingOcc_SOP :: SOP I '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
-> SOP I '[ '[Var], '[Expr, Expr], '[Expr]]
deleteBindingOcc_SOP arg = SOP $ trans_NS (Proxy @RelDeleteBindingOcc) deleteBindingOcc_NP (unSOP arg)
顺便说一句，有一个名为 generic-data-surgery 的漂亮库（不幸的是我自己从未使用过）声称擅长这类事情。
也许我们可以依赖函数依赖，而不是使用类型族来关联原始类型和剥离类型：
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-} -- required by some of the magic below
{-# LANGUAGE TypeApplications #-}
class MyC a b | a -> b where
deleteBindingOcc_NP :: NP I a -> NP I b
instance MyC '[] '[] where
deleteBindingOcc_NP Nil = Nil
instance {-# OVERLAPPING #-} MyC a b => MyC (BindingOcc ': a) b where
deleteBindingOcc_NP (_ :* xs) = deleteBindingOcc_NP xs
instance {-# OVERLAPPABLE #-} MyC a b => MyC (x ': a) (x ': b) where
deleteBindingOcc_NP (x :* xs) = x :* deleteBindingOcc_NP xs
这似乎有效：
deleteBindingOcc_SOP :: SOP I '[ '[Var], '[Expr, Expr], '[BindingOcc, Expr]]
-> SOP I '[ '[Var], '[Expr, Expr], '[Expr]]
deleteBindingOcc_SOP arg = SOP $ trans_NS (Proxy @MyC) deleteBindingOcc_NP (unSOP arg)
具有辅助 MyC' class 而不是重叠实例的替代版本：
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
import Data.Kind
import GHC.TypeLits
import Data.Type.Equality
class MyC a b | a -> b where
deleteBindingOcc_NP :: NP I a -> NP I b
class MyC' (isocc :: Bool) a b | a -> b where
deleteBindingOcc_NP' :: NP I a -> NP I b
instance MyC '[] '[] where
deleteBindingOcc_NP Nil = Nil
instance MyC' (x == BindingOcc) (x ': xs) ys => MyC (x ': xs) ys where
deleteBindingOcc_NP = deleteBindingOcc_NP' @(x == BindingOcc)
instance MyC a b => MyC' True (BindingOcc ': a) b where
deleteBindingOcc_NP' (_ :* xs) = deleteBindingOcc_NP xs
instance MyC a b => MyC' False (x ': a) (x ': b) where
deleteBindingOcc_NP' (x :* xs) = x :* deleteBindingOcc_NP xs