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)

关键是，只要编译器知道如何填写这些隐藏的参数（这并非完全无关紧要），那么您可以将使用类和实例的代码转换为仅使用该语言的更多基本功能的代码。 / p>

有了这样的背景，这是我的问题。我有一个模块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'在班级成员中处于积极地位
'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，但始终关联两种类型，这些类型仅在存在newtype时有所不同。由于运行时表示相同，所以没问题。

Answer 2

您似乎要求的内容称为“本地实例”。这意味着您可以编写如下内容：

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

本地实例是类型类的自然扩展。它们甚至是Wadler和Blott的论文“如何使ad hoc多态性不那么特别”的形式主义的标准。但是，它们存在问题，因为它们破坏了称为主要类型的属性。此外，它们还可以打破以下假设：对于特定类型，只有一个特定约束的实例（例如，Data.Map关于Ord实例的假设）。第一个问题可以通过在本地实例中要求额外的类型注释来解决，后者与有争议的“孤立实例”相关，这会导致类似的问题。

另一篇相关论文是Kiselyov和Shan的“功能珍珠：隐式配置”，其中包含各种类型系统技巧来模拟本地类型实例，尽管它并不真正适用于您的情况（预先存在的类型类），IIRC

Answer 3

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

对于类型参数class C t出现在其类型中的负位置的t类方法，有一种hacky方法。例如，example1 :: Foo t => t -> t -> t可以，但不是example2 :: Foo t => t。

诀窍是创建一个包装器数据类型Wrapper t，它包含t上与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执行任何操作，因为它没有t的负面出现，可以在其中“隐藏”函数。对于您的示例，这意味着模块my_fn中的M只能使用example1。

使用类型类约束将函数转换为采用显式类型类字典的函数

3 个答案: