定义 arity-generic lift
Defining arity-generic lift
我正在尝试为 Haskell 定义 liftN
。动态类型语言(如 JS)中的值级实现相当简单,我只是在 Haskell.
中表达时遇到了麻烦
经过反复试验,我得出了以下结果,其中进行了类型检查(注意 liftN
的整个实现是 undefined
):
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
import Data.Proxy
import GHC.TypeLits
type family Fn x (y :: [*]) where
Fn x '[] = x
Fn x (y:ys) = x -> Fn y ys
type family Map (f :: * -> *) (x :: [*]) where
Map f '[] = '[]
Map f (x:xs) = (f x):(Map f xs)
type family LiftN (f :: * -> *) (x :: [*]) where
LiftN f (x:xs) = (Fn x xs) -> (Fn (f x) (Map f xs))
liftN :: Proxy x -> LiftN f x
liftN = undefined
这给了我在 ghci 中所需的行为:
*Main> :t liftN (Proxy :: Proxy '[a])
liftN (Proxy :: Proxy '[a]) :: a -> f a
*Main> :t liftN (Proxy :: Proxy '[a, b])
liftN (Proxy :: Proxy '[a, b]) :: (a -> b) -> f a -> f b
等等。
我难过的部分是如何实际实施它。我在想也许最简单的方法是将类型级别列表交换为表示其长度的类型级别编号,使用 natVal
获取相应的值级别编号,然后将 1
分派到 pure
, 2
to map
and n
to (finally), liftN
.
的实际递归实现
不幸的是,我什至无法对 pure
和 map
案例进行类型检查。这是我添加的内容(注意 go
仍然是 undefined
):
type family Length (x :: [*]) where
Length '[] = 0
Length (x:xs) = 1 + (Length xs)
liftN :: (KnownNat (Length x)) => Proxy x -> LiftN f x
liftN (Proxy :: Proxy x) = go (natVal (Proxy :: Proxy (Length x))) where
go = undefined
到目前为止一切顺利。但是然后:
liftN :: (Applicative f, KnownNat (Length x)) => Proxy x -> LiftN f x
liftN (Proxy :: Proxy x) = go (natVal (Proxy :: Proxy (Length x))) where
go 1 = pure
go 2 = fmap
go n = undefined
...灾难袭来:
Prelude> :l liftn.hs
[1 of 1] Compiling Main ( liftn.hs, interpreted )
liftn.hs:22:28: error:
* Couldn't match expected type `LiftN f x'
with actual type `(a0 -> b0) -> (a0 -> a0) -> a0 -> b0'
The type variables `a0', `b0' are ambiguous
* In the expression: go (natVal (Proxy :: Proxy (Length x)))
In an equation for `liftN':
liftN (Proxy :: Proxy x)
= go (natVal (Proxy :: Proxy (Length x)))
where
go 1 = pure
go 2 = fmap
go n = undefined
* Relevant bindings include
liftN :: Proxy x -> LiftN f x (bound at liftn.hs:22:1)
|
22 | liftN (Proxy :: Proxy x) = go (natVal (Proxy :: Proxy (Length x))) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.
在这一点上,我不清楚到底什么是歧义或如何消除歧义。
有没有办法优雅地(或者如果不那么优雅,以一种将不优雅限制在函数实现上的方式)在这里实现 liftN
的主体?
这里有两个问题:
- 您需要的不仅仅是类型级数字的
natVal
来确保整个函数类型检查:您还需要证明您正在递归的结构对应于类型级数字你指的是Integer
自身会丢失所有类型级别的信息。
- 相反,您需要的不仅仅是类型的运行时信息:在 Haskell 中,类型没有运行时表示,因此传入
Proxy a
与传入 ()
相同.您需要在某处获取运行时信息。
这两个问题都可以使用单例或 类:
来解决
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
data Nat = Z | S Nat
type family AppFunc f (n :: Nat) arrows where
AppFunc f Z a = f a
AppFunc f (S n) (a -> b) = f a -> AppFunc f n b
type family CountArgs f where
CountArgs (a -> b) = S (CountArgs b)
CountArgs result = Z
class (CountArgs a ~ n) => Applyable a n where
apply :: Applicative f => f a -> AppFunc f (CountArgs a) a
instance (CountArgs a ~ Z) => Applyable a Z where
apply = id
{-# INLINE apply #-}
instance Applyable b n => Applyable (a -> b) (S n) where
apply f x = apply (f <*> x)
{-# INLINE apply #-}
-- | >>> lift (\x y z -> x ++ y ++ z) (Just "a") (Just "b") (Just "c")
-- Just "abc"
lift :: (Applyable a n, Applicative f) => (b -> a) -> (f b -> AppFunc f n a)
lift f x = apply (fmap f x)
{-# INLINE lift #-}
此示例改编自 Richard Eisenberg's thesis。
我正在尝试为 Haskell 定义 liftN
。动态类型语言(如 JS)中的值级实现相当简单,我只是在 Haskell.
经过反复试验,我得出了以下结果,其中进行了类型检查(注意 liftN
的整个实现是 undefined
):
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
import Data.Proxy
import GHC.TypeLits
type family Fn x (y :: [*]) where
Fn x '[] = x
Fn x (y:ys) = x -> Fn y ys
type family Map (f :: * -> *) (x :: [*]) where
Map f '[] = '[]
Map f (x:xs) = (f x):(Map f xs)
type family LiftN (f :: * -> *) (x :: [*]) where
LiftN f (x:xs) = (Fn x xs) -> (Fn (f x) (Map f xs))
liftN :: Proxy x -> LiftN f x
liftN = undefined
这给了我在 ghci 中所需的行为:
*Main> :t liftN (Proxy :: Proxy '[a])
liftN (Proxy :: Proxy '[a]) :: a -> f a
*Main> :t liftN (Proxy :: Proxy '[a, b])
liftN (Proxy :: Proxy '[a, b]) :: (a -> b) -> f a -> f b
等等。
我难过的部分是如何实际实施它。我在想也许最简单的方法是将类型级别列表交换为表示其长度的类型级别编号,使用 natVal
获取相应的值级别编号,然后将 1
分派到 pure
, 2
to map
and n
to (finally), liftN
.
不幸的是,我什至无法对 pure
和 map
案例进行类型检查。这是我添加的内容(注意 go
仍然是 undefined
):
type family Length (x :: [*]) where
Length '[] = 0
Length (x:xs) = 1 + (Length xs)
liftN :: (KnownNat (Length x)) => Proxy x -> LiftN f x
liftN (Proxy :: Proxy x) = go (natVal (Proxy :: Proxy (Length x))) where
go = undefined
到目前为止一切顺利。但是然后:
liftN :: (Applicative f, KnownNat (Length x)) => Proxy x -> LiftN f x
liftN (Proxy :: Proxy x) = go (natVal (Proxy :: Proxy (Length x))) where
go 1 = pure
go 2 = fmap
go n = undefined
...灾难袭来:
Prelude> :l liftn.hs
[1 of 1] Compiling Main ( liftn.hs, interpreted )
liftn.hs:22:28: error:
* Couldn't match expected type `LiftN f x'
with actual type `(a0 -> b0) -> (a0 -> a0) -> a0 -> b0'
The type variables `a0', `b0' are ambiguous
* In the expression: go (natVal (Proxy :: Proxy (Length x)))
In an equation for `liftN':
liftN (Proxy :: Proxy x)
= go (natVal (Proxy :: Proxy (Length x)))
where
go 1 = pure
go 2 = fmap
go n = undefined
* Relevant bindings include
liftN :: Proxy x -> LiftN f x (bound at liftn.hs:22:1)
|
22 | liftN (Proxy :: Proxy x) = go (natVal (Proxy :: Proxy (Length x))) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.
在这一点上,我不清楚到底什么是歧义或如何消除歧义。
有没有办法优雅地(或者如果不那么优雅,以一种将不优雅限制在函数实现上的方式)在这里实现 liftN
的主体?
这里有两个问题:
- 您需要的不仅仅是类型级数字的
natVal
来确保整个函数类型检查:您还需要证明您正在递归的结构对应于类型级数字你指的是Integer
自身会丢失所有类型级别的信息。 - 相反,您需要的不仅仅是类型的运行时信息:在 Haskell 中,类型没有运行时表示,因此传入
Proxy a
与传入()
相同.您需要在某处获取运行时信息。
这两个问题都可以使用单例或 类:
来解决{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
data Nat = Z | S Nat
type family AppFunc f (n :: Nat) arrows where
AppFunc f Z a = f a
AppFunc f (S n) (a -> b) = f a -> AppFunc f n b
type family CountArgs f where
CountArgs (a -> b) = S (CountArgs b)
CountArgs result = Z
class (CountArgs a ~ n) => Applyable a n where
apply :: Applicative f => f a -> AppFunc f (CountArgs a) a
instance (CountArgs a ~ Z) => Applyable a Z where
apply = id
{-# INLINE apply #-}
instance Applyable b n => Applyable (a -> b) (S n) where
apply f x = apply (f <*> x)
{-# INLINE apply #-}
-- | >>> lift (\x y z -> x ++ y ++ z) (Just "a") (Just "b") (Just "c")
-- Just "abc"
lift :: (Applyable a n, Applicative f) => (b -> a) -> (f b -> AppFunc f n a)
lift f x = apply (fmap f x)
{-# INLINE lift #-}
此示例改编自 Richard Eisenberg's thesis。