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

Question

众所周知，实现 Haskell 类型类的一种方法是通过“类型类字典”。 (这当然是 ghc 中的实现，尽管我强制说明其他实现是可能的。)为了修正想法，我将简要描述它是如何工作的。像这样的类声明

class (MyClass t) where
  test1 :: t -> t -> t
  test2 :: t -> String
  test3 :: t

可以机械地转换为数据类型的定义，例如:

data MyClass_ t = MyClass_ {
  test1_ :: t -> t -> t,
  test2_ :: t -> String,
  test3_ :: t,
  }

然后我们可以将每个实例声明机械地转换为该类型的对象；例如:

instance (MyClass Int) where
  test1 = (+)
  test2 = show
  test3 = 3

变成

instance_MyClass_Int :: MyClass_ Int
instance_MyClass_Int =  MyClass_ (+) show 3

同样，具有类型类约束的函数可以转换为带有额外参数的函数；例如:

my_function :: (MyClass t) => t -> String
my_function val = test2 . test1 test3

变成

my_function_ :: MyClass_ t -> t -> String
my_function_ dict val = (test2_ dict) . (test1_ dict) (test3_ dict)

关键是，只要编译器知道如何填充这些隐藏的参数(这并非完全无关紧要)，那么您就可以将使用类和实例的代码翻译成只使用该语言的更多基本特性的代码。

在这样的背景下，这是我的问题。我有一个模块 M它定义了一堆具有类约束的类和函数。 M是“不透明的”；我可以看到它导出的内容(相当于 .hi 文件)，我可以从中导入，但我看不到它的源代码。我要构建一个新模块 N它基本上导出相同的东西，但应用了上述转换。例如，如果 M导出

class (Foo t) where
  example1 :: t -> t -> t
  example2 :: t             -- note names and type signatures visible here
                            -- because they form part of the interface...

instance (Foo String)       -- details of implementation invisible

instance (Foo Bool)         -- details of implementation invisible

my_fn :: (Foo t) => t -> t  -- exported polymorphic fn with class constraint
                            -- details of implementation invisible

N会开始像

module N where

import M

data Foo_ t = Foo_ {example1_ :: t-> t -> t, example2_ :: t}

instance_Foo_String :: Foo_ String
instance_Foo_String = Foo_ example1 example2
instance_Foo_Bool   :: Foo_ Bool
instance_Foo_Bool   = Foo_ example1 example2

my_fn_ :: Foo_ t -> t -> t
my_fn_ = ???

我的问题是 我到底能用什么代替？？？ .换句话说，我可以写什么来提取函数 my_fn 的“显式类型类”版本从原来的？这看起来相当棘手，而且令人愤怒，因为我们都知道模块 M 基本上已经在“底层”导出了类似 my_fn_ 的内容。我想创建的。 (或者至少，它在 GHC 上。)

Answer 1

作为记录，我想我会解释我已经知道的“hacky”解决方案。我将基本上使用一系列示例来说明它。所以让我们想象一下，我们正在尝试具体化以下中的类、实例和函数(它们主要由非常标准的类型类组成，通常为了说明而有所简化):

{-# 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' 在类(class)成员中的正位

'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 , 但总是关联两种仅在新类型存在时不同的类型。由于运行时表示是相同的，这没关系。