对于hxt的工作,我实现了以下功能:
-- | Construction of a 8 argument arrow from a 8-ary function. Same
-- implementation as in @Control.Arrow.ArrowList.arr4@.
arr8 :: ArrowList a => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> b8 -> c)
-> a (b1, (b2, (b3, (b4, (b5, (b6, (b7, b8))))))) c
arr8 f = arr ( \ ~(x1, ~(x2, ~(x3, ~(x4, ~(x5, ~(x6, ~(x7, x8)))))))
-> f x1 x2 x3 x4 x5 x6 x7 x8 )
如同haddock注释中所述,上面的函数arr8
采用8-ary函数并返回8参数箭头。我使用这样的函数:(x1 &&& x2 &&& ... x8) >>> arr8 f
x1
到x8
是箭头。
我的问题:有没有办法避免大元组定义?是否有更优雅的arr8
实现?
信息:我使用了与函数arr4中相同的代码架构(请参阅source code of arr4)
答案 0 :(得分:8)
这有效,但它取决于一些相当深刻和脆弱的类型类魔法。它还要求我们将元组结构更改为更加规则。特别是,它应该是一个类型级链表,更喜欢(a, (b, (c, ())))
到(a, (b, c))
。
{-# LANGUAGE TypeFamilies #-}
import Control.Arrow
-- We need to be able to refer to functions presented as tuples, generically.
-- This is not possible in any straightforward method, so we introduce a type
-- family which recursively computes the desired function type. In particular,
-- we can see that
--
-- Fun (a, (b, ())) r ~ a -> b -> r
type family Fun h r :: *
type instance Fun () r = r
type instance Fun (a, h) r = a -> Fun h r
-- Then, given our newfound function specification syntax we're now in
-- the proper form to give a recursive typeclass definition of what we're
-- after.
class Zup tup where
zup :: Fun tup r -> tup -> r
instance Zup () where
zup r () = r
-- Note that this recursive instance is simple enough to not require
-- UndecidableInstances, but normally techniques like this do. That isn't
-- a terrible thing, but if UI is used it's up to the author of the typeclass
-- and its instances to ensure that typechecking terminates.
instance Zup b => Zup (a, b) where
zup f ~(a, b) = zup (f a) b
arrTup :: (Arrow a, Zup b) => Fun b c -> a b c
arrTup = arr . zup
现在我们可以做到
> zup (+) (1, (2, ()))
3
> :t arrTup (+)
arrTup (+)
:: (Num a1, Arrow a, Zup b n, Fun n b c ~ (a1 -> a1 -> a1)) =>
a b c
> arrTup (+) (1, (2, ()))
3
如果您想定义特定的变体,它们都只是arrTup
。
arr8
:: Arrow arr
=> (a -> b -> c -> d -> e -> f -> g -> h -> r)
-> arr (a, (b, (c, (d, (e, (f, (g, (h, ())))))))) r
arr8 = arrTup
最后值得注意的是,如果我们定义一个懒惰的uncurry
uncurryL :: (a -> b -> c) -> (a, b) -> c
uncurryL f ~(a, b) = f a b
然后我们可以用一种说明这里发生的事情的方式编写Zup
的递归分支
instance Zup b => Zup (a, b) where
zup f = uncurryL (zup . f)
答案 1 :(得分:2)
我的方法是写作
arr8 f = arr (uncurry8 f)
我不知道我们是否可以编写通用uncurryN n f
函数(可能不是),但我可以系统地为每个uncurry_n
提供一个免费的n
像这样:
uncurry3 f = uncurry ($) . cross (uncurry . f) id
uncurry4 f = uncurry ($) . cross (uncurry3 . f) id
...
uncurry8 f = uncurry ($) . cross (uncurry7 . f) id
,其中
cross f g = pair (f . fst) (g . snd)
pair f g x = (f x, g x)