为了实现 type 的函数FunType -> SplitFun
,我们将使用标准类型类机制来解构函数类型。
现在,直接实现这个功能变得相当困难。要从递归案例中获取inputTypes
和outputType
退出,您必须应用您的函数;但是您只能在dynamic
字段内应用该函数,这使您无法填充其他字段。相反,我们将任务分成两部分:一个函数将向我们提供Ty
信息,另一个将构造[Dynamic] -> Dynamic
函数。
data Proxy a = Proxy
class Split r where
dynFun :: r -> [Dynamic] -> Dynamic
tyInfo :: Proxy r -> ([Ty], Ty)
split :: r -> SplitFun
split f = let (i, o) = tyInfo (Proxy :: Proxy r)
in SF (dynFun f) i o
现在,tyInfo
实际上不需要函数,我们Proxy
只是用来传递类型信息而不需要undefined
到处使用。请注意,我们需要ScopedTypeVariables
能够r
从实例声明中引用类型变量。巧妙地使用asTypeOf
可能也有效。
我们有两个基本情况:Bool
和Int
:
instance Split Int where
dynFun i _ = forget (Tagged Num i)
tyInfo _ = ([], TNum)
instance Split Bool where
dynFun b _ = forget (Tagged Bool b)
tyInfo _ = ([], TBool)
没有输入类型,因为我们已经有了一个值,所以我们不需要请求更多的Dynamic
值,我们只需返回Dynamic
那个特定的值。
接下来,我们有两个递归案例:Bool -> r
和Int -> r
instance (Split r) => Split (Int -> r) where
dynFun f (d:ds) = case remember d :: Maybe (Tagged Int) of
Just (Tagged _ i) -> dynFun (f i) ds
Nothing -> error "dynFun: wrong dynamic type"
dynFun f [] = error "dynFun: not enough arguments"
tyInfo _ = case tyInfo (Proxy :: Proxy r) of
(i, o) -> (TNum:i, o)
instance (Split r) => Split (Bool -> r) where
dynFun f (d:ds) = case remember d :: Maybe (Tagged Bool) of
Just (Tagged _ b) -> dynFun (f b) ds
Nothing -> error "dynFun: wrong dynamic type"
dynFun f [] = error "dynFun: not enough arguments"
tyInfo _ = case tyInfo (Proxy :: Proxy r) of
(i, o) -> (TBool:i, o)
这两个需要FlexibleInstances
。dynFun
检查第一个Dynamic
参数,如果没问题,我们可以安全地将函数f
应用于它并从那里继续。我们也可以做dynFun :: r -> [Dynamic] -> Maybe Dynamic
,但这是相当微不足道的改变。
现在,有一些重复。我们可以引入另一个类,例如:
class Concrete r where
getTy :: Proxy r -> Ty
getType :: Proxy r -> Type r
然后写:
instance (Typeable r, Concrete r) => Split r where
dynFun r _ = forget (Tagged (getType (Proxy :: Proxy r)) r)
tyInfo _ = ([], getTy (Proxy :: Proxy r))
instance (Typeable r, Concrete r, Split s) => Split (r -> s) where
dynFun f (d:ds) = case remember d :: Maybe (Tagged r) of
Just (Tagged _ v) -> dynFun (f v) ds
-- ...
tyInfo _ = case tyInfo (Proxy :: Proxy s) of
(i, o) -> (getTy (Proxy :: Proxy r):i, o)
但这需要OverlappingInstances
和UndecidableInstances
。