将具有类型类约束的函数转换为具有显式类型类字典的函数

为了记录在案,我想我会解释一下我已经知道的“黑客”解决方案。我将用一系列的例子来说明它。因此,让我们想象一下,我们正在尝试将类、实例和函数具体化为以下内容(它主要由漂亮的标准类型类组成,通常为了说明而有所简化):

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module Src where

import Data.List (intercalate)

class SimpleShow a where
  sshow :: a -> String

class SimpleMonoid a where
  mempty  :: a
  mappend :: a -> a -> a

class SimpleFunctor f where
  sfmap :: (a -> b) -> f a -> f b

instance SimpleShow Int where
  sshow = show

instance SimpleMonoid [a] where
  mempty  = []
  mappend = (++)

instance SimpleMonoid ([a], [b]) where
  mempty  = ([], [])
  mappend (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2)

instance SimpleFunctor [] where
  sfmap = map

在这些例子中有一些普遍性:

• “a”在类成员中处于正位置
• “a”在类成员中处于负位置
• 需要灵活实例的实例
• 更善良的类型

我们将多参数类型族作为练习!注意,我确实相信我所呈现的是一个完全通用的语法过程;我只是觉得用例子说明比正式描述转换更容易。无论如何,假设我们要处理以下函数:

show_2lists :: (SimpleShow a) => [a] -> [a] -> String
show_2lists as1 as2 = "[" ++ intercalate ", " (map sshow as1) ++ "]/["
                      ++ intercalate ", " (map sshow as2) ++ "]"

mconcat :: (SimpleMonoid a) => [a] -> a
mconcat = foldr mappend mempty

example :: (SimpleMonoid (x, y)) => [(x, y)] -> (x, y)
example = foldr mappend mempty

lift_all :: (SimpleFunctor f) => [a -> b] -> [f a -> f b]
lift_all = map sfmap

那么实际的具体化看起来像:

{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE FlexibleInstances #-}

module Main where

import Unsafe.Coerce
import Src

data Proxy k = Proxy

class Reifies s a | s -> a where
  reflect :: proxy s -> a

newtype Magic a r = Magic (forall (s :: *). Reifies s a => Proxy s -> r)

reify :: forall a r. a -> (forall (s :: *). Reifies s a => Proxy s -> r) -> r
reify a k = unsafeCoerce (Magic k :: Magic a r) (const a) Proxy
{-# INLINE reify #-}


data SimpleShow_    a = SimpleShow_    {sshow_  :: a -> String}
data SimpleMonoid_  a = SimpleMonoid_  {mempty_ :: a,
                                        mappend_ :: a -> a -> a}
data SimpleFunctor_ f = SimpleFunctor_ {
  sfmap_  :: forall a b. (a -> b) -> (f a -> f b)
  }

instance_SimpleShow_Int :: SimpleShow_ Int
instance_SimpleShow_Int = SimpleShow_ sshow

instance_SimpleMonoid_lista :: SimpleMonoid_ [a]
instance_SimpleMonoid_lista =  SimpleMonoid_ mempty mappend

instance_SimpleMonoid_listpair :: SimpleMonoid_ ([a], [b])
instance_SimpleMonoid_listpair =  SimpleMonoid_ mempty mappend

instance_SimpleFunctor_list :: SimpleFunctor_ []
instance_SimpleFunctor_list = SimpleFunctor_ sfmap

---------------------------------------------------------------------
--code to reify show_2lists :: (SimpleShow a) => [a] -> [a] -> String

-- for each type variable that occurs in the constraints, we must
-- create a newtype. Here there is only one tpye variable ('a') so we
-- create one newtype.
newtype Wrap_a a s  = Wrap_a { extract_a :: a }

-- for each constraint, we must create an instance of the
-- corresponding typeclass where the instance variables have been
-- replaced by the newtypes we just made, as follows.
instance Reifies s (SimpleShow_ a) => SimpleShow (Wrap_a a s) where
  --sshow :: (Wrap_ a s) -> String
  sshow = unsafeCoerce sshow__
    where sshow__ :: a -> String
          sshow__ = sshow_ $ reflect (undefined :: [] s)

-- now we can reify the main function
show_2lists_ :: forall a. SimpleShow_ a -> [a] -> [a] -> String
show_2lists_ dict = let
  magic :: forall s. ([Wrap_a a s] -> [Wrap_a a s] -> String)
           -> Proxy s -> ([a] -> [a] -> String)
  magic v _ arg1 arg2 = let
    w_arg1 :: [Wrap_a a s]
    w_arg1 =  unsafeCoerce (arg1 :: [a])

    w_arg2 :: [Wrap_a a s]
    w_arg2 =  unsafeCoerce (arg2 :: [a])

    w_ans :: String
    w_ans = v w_arg1 w_arg2

    ans   :: String
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic show_2lists)

---------------------------------------------------------------------
--code to reify mconcat :: (SimpleMonoid a) => [a] -> a

-- Here the newtypes begin with Wrap1 to avoid name collisions with
-- the ones above
newtype Wrap1_a a s  = Wrap1_a { extract1_a :: a }
instance Reifies s (SimpleMonoid_ a) => SimpleMonoid (Wrap1_a a s) where
  --mappend :: (Wrap1_a a s) -> (Wrap1_a a s) -> (Wrap1_a a s)
  mappend = unsafeCoerce mappend__
    where mappend__ :: a -> a -> a
          mappend__ =  (mappend_ $ reflect (undefined :: [] s))
  --mempty  :: (Wrap1_a a s)
  mempty = unsafeCoerce mempty__
    where mempty__  :: a
          mempty__  =  (mempty_  $ reflect (undefined :: [] s))

mconcat_ :: forall a. SimpleMonoid_ a -> [a] -> a
mconcat_ dict = let
  magic :: forall s. ([Wrap1_a a s] -> (Wrap1_a a s)) -> Proxy s -> ([a] -> a)
  magic v _ arg1 = let
    w_arg1 :: [Wrap1_a a s]
    w_arg1 =  unsafeCoerce (arg1 :: [a])

    w_ans :: Wrap1_a a s
    w_ans = v w_arg1

    ans   :: a
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic mconcat)

---------------------------------------------------------------------
--code to reify example :: (SimpleMonoid (x, y)) => [(x, y)] -> (x, y)

newtype Wrap2_x x s  = Wrap2_x { extract2_x :: x }
newtype Wrap2_y y s  = Wrap2_y { extract2_y :: y }
instance Reifies s (SimpleMonoid_ (x, y))
         => SimpleMonoid (Wrap2_x x s, Wrap2_y y s) where
  --mappend :: (Wrap2_x x s, Wrap2_y y s) -> (Wrap2_x x s, Wrap2_y y s)
  --                 -> (Wrap2_x x s, Wrap2_y y s)
  mappend = unsafeCoerce mappend__
    where mappend__ :: (x, y) -> (x, y) -> (x, y)
          mappend__ =  (mappend_ $ reflect (undefined :: [] s))
  --mempty  :: (Wrap2_x x s, Wrap2_y y s)
  mempty = unsafeCoerce mempty__
    where mempty__  :: (x, y)
          mempty__  =  (mempty_  $ reflect (undefined :: [] s))

example_ :: forall x y. SimpleMonoid_ (x, y) -> [(x, y)] -> (x, y)
example_ dict = let
  magic :: forall s. ([(Wrap2_x x s, Wrap2_y y s)] -> (Wrap2_x x s, Wrap2_y y s))
           -> Proxy s -> ([(x, y)] -> (x, y))
  magic v _ arg1 = let
    w_arg1 :: [(Wrap2_x x s, Wrap2_y y s)]
    w_arg1 =  unsafeCoerce (arg1 :: [(x, y)])

    w_ans :: (Wrap2_x x s, Wrap2_y y s)
    w_ans = v w_arg1

    ans   :: a
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic mconcat)

---------------------------------------------------------------------
--code to reify lift_all :: (SimpleFunctor f) => [a -> b] -> [f a -> f b]

newtype Wrap_f f s d = Wrap_f { extract_fd :: f d}
instance Reifies s (SimpleFunctor_ f) => SimpleFunctor (Wrap_f f s) where
  --sfmap :: (a -> b) -> (Wrap_f f s a -> Wrap_f f s b)
  sfmap = unsafeCoerce sfmap__
    where sfmap__ :: (a -> b) -> (f a -> f b)
          sfmap__ = sfmap_ $ reflect (undefined :: [] s)

lift_all_ :: forall a b f. SimpleFunctor_ f -> [a -> b] -> [f a -> f b]
lift_all_ dict = let
  magic :: forall s. ([a -> b] -> [Wrap_f f s a -> Wrap_f f s b])
           -> Proxy s -> ([a -> b] -> [f a -> f b])
  magic v _ arg1 = let
    w_arg1 :: [a -> b]
    w_arg1 =  unsafeCoerce (arg1 :: [a -> b])

    w_ans :: [Wrap_f f s a -> Wrap_f f s b]
    w_ans = v w_arg1

    ans   :: [f a -> f b]
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic lift_all)

main :: IO ()
main = do
  print (show_2lists_ instance_SimpleShow_Int     [3, 4] [6, 9])
  print (mconcat_     instance_SimpleMonoid_lista [[1, 2], [3], [4, 5]])
  print (example_     instance_SimpleMonoid_listpair
                                     [([1, 2], ["a", "b"]), ([4], ["q"])])
  let fns' :: [[Int] -> [Int]]
      fns' = lift_all_ instance_SimpleFunctor_list [\ x -> x+1, \x -> x - 1]
  print (map ($ [5, 7]) fns')


{- output:

"[3, 4]/[6, 9]"
[1,2,3,4,5]
([1,2,4],["a","b","q"])
[[6,8],[4,6]]

-}

注意,我们使用了大量 unsafeCoerce ,但始终关联仅在存在新类型时不同的两种类型。因为运行时表示是相同的,所以这是可以的。

您似乎要求的是“本地实例”。这意味着你可以写一些东西,比如:

my_fn_ :: forall t. Foo_ t -> t -> t
my_fn_ fooDict = let instance fooDict :: Foo t
                 in my_fn

本地实例是类型类的自然扩展。它们甚至在Wadler和Blott的论文“如何使特殊多态性变得不那么特殊”的形式主义中成为标准。然而,它们有问题,因为它们破坏了称为主体类型的属性。此外,它们还可能打破特定类型的某个约束只有一个实例的假设(例如Data.Map关于Ord实例的假设)。第一个问题可以通过在本地实例中需要额外的类型注释来解决,后者与引起类似问题的有争议的“孤立实例”有关。

另一篇相关的论文是Kiselyov和Shan的“Functional pearl:隐式配置”,其中包含各种类型系统技巧来模拟本地类型实例,尽管它并不真正适用于您的情况(预先存在的类型类)IIRC。

这不是一般的解决方案,但仅适用于某些特殊情况。

对于 class C t 具有类型参数的 t 在他们的类型中以否定的位置出现。例如。, example1 :: Foo t => t -> t -> t 可以,但不行 example2 :: Foo t => t .

诀窍是创建包装数据类型 Wrapper t 它包括上的显式字典方法 吨 与 吨 值,并且具有 Foo 利用适当的包装字典方法的实例,例如。

 data Wrapper x = Wrap {example1__ :: (x -> x -> x), val :: x}

 instance Foo (Wrapper x) where
     example1 (Wrap example1__ x) (Wrap _ y) = Wrap example1__ (example1__ x y) 

 my_fn_ :: Foo_ t -> t -> t
 my_fn_ (Foo_ example1_ example2_) x = val $ my_fn (Wrap example1_ x)

告诉我,这可能不是你正在寻找的解决方案——它不是通用的。在这里的示例中,我们不能使用 example2 因为它没有 吨 用它来“潜入”内部的功能。例如,这意味着 my_fn 模块内 M 只能使用 example1 .