众所周知,实现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上。)
答案 0 :(得分:2)
为了记录,我想我会解释我已经知道的'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
这些例子中有一些普遍性:我们有
我们将多参数类型的家庭作为练习!请注意,我确实相信我所呈现的是一个完全通用的句法程序;我只是认为通过实例说明比通过正式描述转换更容易。无论如何,我们假设我们有以下功能要处理:
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时有所不同。由于运行时表示相同,所以没问题。
答案 1 :(得分:1)
您似乎要求的内容称为“本地实例”。这意味着您可以编写如下内容:
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
答案 2 :(得分:0)
这不是一般的解决方案,只适用于某些特殊情况。
对于类型参数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
。