定义arity-generic lift

时间:2018-05-28 23:00:33

标签: haskell dependent-type applicative type-families

我正在尝试为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发送到{{1} },pure2map到(最后),n的实际递归实现。

不幸的是,我甚至无法将liftNpure个案件用于类型检查。这是我添加的内容(注意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. 的主体?

1 个答案:

答案 0 :(得分:3)

这里有两个问题:

  • 您需要的不仅仅是类型级别编号的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