使用类型类约束将函数转换为采用显式类型类字典的函数-Java 学习之路

众所周知，实现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 是'opaque';我可以看到它导出的内容（相当于.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_ = ???

我的问题是 what on earth I can put in place of the ??? . 换句话说，我可以编写什么来从原始函数中提取函数 my_fn 的'explicit typeclass'版本？它看起来相当棘手，并且它在引擎盖下'模块M基本上已经输出了像我想要创建的 my_fn_ 这样的东西 . （或者至少，它是在GHC上 . ）

3 回答

为了记录，我想我会解释我已经知道的“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'在 class 成员中处于负面位置
需要灵活实例的实例
更高级的类型

我们将多参数类型的家庭作为练习！请注意，我确实相信我所呈现的是一个完全通用的句法程序;我只是认为通过实例说明比通过正式描述转换更容易 . 无论如何，我们假设我们有以下功能要处理：

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时有所不同 . 由于运行时表示是相同的，这是可以的 .

回复于 2024-04-29T22:35:30+08:00

0
你似乎要求的东西被称为“本地实例” . 这意味着你可以写下这样的东西：
```
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 .
回复于 2024-04-29T22:35:30+08:00
2
This isn't a solution in general, but only for some special cases.

对于类型参数 t 出现在其类型中的负位置的 class C 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 的负面出现，"sneak"函数在里面 . 对于您的示例，这意味着模块 M 中的 my_fn 只能使用 example1 .
回复于 2024-04-29T22:35:30+08:00

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

3 回答

相关问题