ric*_*ree 9 haskell ffi polyvariadic
是否有可能有一个函数接受外部函数调用,其中一些外部函数的参数是CString并返回一个接受String的函数？
这是我正在寻找的一个例子:
foreign_func_1 :: (CDouble -> CString -> IO())
foreign_func_2 :: (CDouble -> CDouble -> CString -> IO ())
externalFunc1 :: (Double -> String -> IO())
externalFunc1 = myFunc foreign_func_1
externalFunc2 :: (Double -> Double -> String -> IO())
externalFunc2 = myFunc foreign_func_2
我想出了如何使用C数字类型执行此操作.但是,我无法找到一种可以允许字符串转换的方法.
这个问题似乎适合IO函数,因为转换为CStrings的所有内容(如newCString或withCString)都是IO.
以下是处理转换双精度的代码.
class CConvertable interiorArgs exteriorArgs where
convertArgs :: (Ptr OtherIrrelevantType -> interiorArgs) -> exteriorArgs
instance CConvertable (IO ()) (Ptr OtherIrrelevantType -> IO ()) where
convertArgs = doSomeOtherThingsThatArentCausingProblems
instance (Real b, Fractional a, CConvertable intArgs extArgs) => CConvertable (a->intArgs) (b->extArgs) where
convertArgs op x= convertArgs (\ctx -> op ctx (realToFrac x))
C. *_*ann 16
是否有可能有一个函数接受外部函数调用,其中一些外部函数的参数是CString并返回一个接受String的函数？
你问,有可能吗？
<lambdabot> The answer is: Yes! Haskell can do that.
好.我们得到了解决的好事.
通过一些繁琐的手续升温:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
啊,虽然不是那么糟糕.看,马,没有重叠!
这个问题似乎适合IO函数,因为转换为CStrings的所有内容(如newCString或withCString)都是IO.
对.这里要注意的是,有两个相互关联的问题需要关注我们:两种类型之间的对应关系,允许转换; 以及通过执行转换引入的任何额外上下文.为了完全解决这个问题,我们将使这两个部分明确并适当地改变它们.我们还需要注意差异 ; 提升整个函数需要处理协变和逆变位置中的类型,因此我们需要在两个方向上进行转换.
现在,考虑到我们希望翻译的功能,该计划如下:
嗯,这听起来并不太难.首先,明确的上下文:
class (Functor f, Cxt t ~ f) => Context (f :: * -> *) t where
type Collapse t :: *
type Cxt t :: * -> *
collapse :: t -> Collapse t
这表示我们有一个上下文f,有些类型t具有该上下文.的Cxt类型函数提取从普通上下文t,并Collapse试图如果可能的上下文相结合.该collapse函数让我们使用类型函数的结果.
目前,我们有纯粹的背景,并且IO:
newtype PureCxt a = PureCxt { unwrapPure :: a }
instance Context IO (IO (PureCxt a)) where
type Collapse (IO (PureCxt a)) = IO a
type Cxt (IO (PureCxt a)) = IO
collapse = fmap unwrapPure
{- more instances here... -}
很简单.处理各种上下文组合有点单调乏味,但实例很明显且易于编写.
我们还需要一种方法来确定给定转换类型的上下文.目前上下文在任何一个方向都是相同的,但是当然可以想象它是不同的,所以我已经分开对待它们了.因此,我们有两个类型系列,为导入/导出转换提供新的最外层上下文:
type family ExpCxt int :: * -> *
type family ImpCxt ext :: * -> *
一些示例实例:
type instance ExpCxt () = PureCxt
type instance ImpCxt () = PureCxt
type instance ExpCxt String = IO
type instance ImpCxt CString = IO
接下来,转换单个类型.我们稍后会担心递归.另一个类型的时间:
class (Foreign int ~ ext, Native ext ~ int) => Convert ext int where
type Foreign int :: *
type Native ext :: *
toForeign :: int -> ExpCxt int ext
toNative :: ext -> ImpCxt ext int
这表示两种类型ext并且int可以彼此唯一地转换.我意识到可能不希望每种类型总是只有一个映射,但我不想让事情进一步复杂化(至少现在不是这样).
如上所述,我也推迟了处理递归转换; 可能他们可以合并,但我觉得这样会更清楚.非递归转换具有引入相应上下文的简单,定义良好的映射,而递归转换需要传播和合并上下文并处理与基本情况区分的递归步骤.
哦,你现在可能已经注意到在课堂上下文中有趣的摇摆波浪形业务正在进行中.这表明两种类型必须相等的约束; 在这种情况下,它将每个类型函数绑定到相反的类型参数,这给出了上面提到的双向性质.呃,你可能想要一个相当新的GHC.在较老的GHC上,这需要功能依赖,而且会被写成类似的东西class Convert ext int | ext -> int, int -> ext.
术语级转换函数非常简单 - 在结果中注意类型函数应用程序; 应用程序一如既往地保持左关联,因此只应用早期类型族的上下文.还要注意名称中的交叉,因为导出上下文来自使用本机类型的查找.
所以,我们可以转换不需要的类型IO:
instance Convert CDouble Double where
type Foreign Double = CDouble
type Native CDouble = Double
toForeign = pure . realToFrac
toNative = pure . realToFrac
......以及做的类型:
instance Convert CString String where
type Foreign String = CString
type Native CString = String
toForeign = newCString
toNative = peekCString
现在要触及问题的核心,并递归地翻译整个函数.我引入另一种类型应该不足为奇.实际上,有两个,因为我这次分离了导入/导出转换.
class FFImport ext where
type Import ext :: *
ffImport :: ext -> Import ext
class FFExport int where
type Export int :: *
ffExport :: int -> Export int
这里没什么有趣的.你可能现在注意到一个共同的模式 - 我们在术语和类型级别上进行大致相同的计算量,并且我们正在同时进行它们,甚至模仿名称和表达式结构.如果你正在为涉及实际值的事物进行类型级计算,这是很常见的,因为GHC如果不理解你正在做什么就会变得挑剔.像这样的内容可以显着减少头痛.
无论如何,对于每个类,我们需要一个实例用于每个可能的基本情况,一个用于递归情况.唉,我们不能轻易拥有一个通用的基础案例,因为通常麻烦的废话有重叠.它可以使用fundeps和类型相等条件来完成,但是......呃.也许以后.另一种选择是通过类型级数来参数化转换函数,该类型级数给出所需的转换深度,其具有不太自动的缺点,但是也可以通过显式获得一些好处,例如不太可能偶然发现多态或模棱两可的类型.
现在,我将假设每个函数都以某些内容结束IO,因为IO a可以区分a -> b而不重叠.
一,基本情况:
instance ( Context IO (IO (ImpCxt a (Native a)))
, Convert a (Native a)
) => FFImport (IO a) where
type Import (IO a) = Collapse (IO (ImpCxt a (Native a)))
ffImport x = collapse $ toNative <$> x
这里的约束使用已知实例断言特定上下文,并且我们有一些带转换的基类型.再次,请注意类型函数Import和术语函数共享的并行结构ffImport.这里的实际想法应该非常明显 - 我们将转换函数映射IO,创建某种嵌套上下文,然后使用Collapse/ collapse来清理.
递归情况类似,但更详细:
instance ( FFImport b, Convert a (Native a)
, Context (ExpCxt (Native a)) (ExpCxt (Native a) (Import b))
) => FFImport (a -> b) where
type Import (a -> b) = Native a -> Collapse (ExpCxt (Native a) (Import b))
ffImport f x = collapse $ ffImport . f <$> toForeign x
我们FFImport为递归调用添加了一个约束,并且上下文争用变得更加尴尬,因为我们不确切地知道它是什么,只是指定足以确保我们可以处理它.还要注意这里的逆变,因为我们将函数转换为本机类型,但将参数转换为外部类型.除此之外,它仍然非常简单.
现在,我已经省略了一些实例,但其他一切都遵循与上面相同的模式,所以让我们跳到最后并确定货物的范围.一些虚构的外国函数:
foreign_1 :: (CDouble -> CString -> CString -> IO ())
foreign_1 = undefined
foreign_2 :: (CDouble -> SizedArray a -> IO CString)
foreign_2 = undefined
和转换:
imported1 = ffImport foreign_1
imported2 = ffImport foreign_2
什么,没有类型签名？它有用吗？
> :t imported1
imported1 :: Double -> String -> [Char] -> IO ()
> :t imported2
imported2 :: Foreign.Storable.Storable a => Double -> AsArray a -> IO [Char]
是的,这是推断类型.啊,这就是我喜欢看到的.
编辑:对于任何想要尝试这一点的人,我已经在这里完成了演示的完整代码,清理了一下,并将其上传到github.
小智 7
这可以使用模板haskell完成.在许多方面,它比涉及类的替代方法更简单,因为在Language.Haskell.TH.Type上的模式匹配比在实例中做同样的事情更容易.
{-# LANGUAGE TemplateHaskell #-}
-- test.hs
import FFiImport
import Foreign.C
foreign_1 :: CDouble -> CString -> CString -> IO CString
foreign_2 :: CDouble -> CString -> CString -> IO (Int,CString)
foreign_3 :: CString -> IO ()
foreign_1 = undefined; foreign_2 = undefined; foreign_3 = undefined
fmap concat (mapM ffimport ['foreign_1, 'foreign_2, 'foreign_3])
生成的函数的推断类型是:
imported_foreign_1 :: Double -> String -> String -> IO String
imported_foreign_2 :: Double -> String -> String -> IO (Int, String)
imported_foreign_3 :: String -> IO ()
通过使用-ddump-splices加载test.hs来检查生成的代码(注意,ghc似乎仍然错过了漂亮打印中的一些括号),表明foreign_2写了一个定义,经过一些调整之后看起来像:
imported_foreign_2 w x y
= (\ (a, b) -> ((return (,) `ap` return a) `ap` peekCString b) =<<
join
(((return foreign_2 `ap`
(return . (realToFrac :: Double -> CDouble)) w) `ap`
newCString x) `ap`
newCString y))
或翻译成符号:
imported_foreign_2 w x y = do
w2 <- return . (realToFrac :: Double -> CDouble) w
x2 <- newCString x
y2 <- newCString y
(a,b) <- foreign_2 w2 x2 y2
a2 <- return a
b2 <- peekCString b
return (a2,b2)
以第一种方式生成代码更简单,因为要跟踪的变量更少.虽然foldl($)f [x,y,z]不会检查何时表示((f $ x)$ y $ z)= fxyz,但在模板haskell中它是可接受的,它只涉及少数几种不同的类型.
现在为实际实施这些想法:
{-# LANGUAGE TemplateHaskell #-}
-- FFiImport.hs
module FFiImport(ffimport) where
import Language.Haskell.TH; import Foreign.C; import Control.Monad
-- a couple utility definitions
-- args (a -> b -> c -> d) = [a,b,c]
args (AppT (AppT ArrowT x) y) = x : args y
args _ = []
-- result (a -> b -> c -> d) = d
result (AppT (AppT ArrowT _) y) = result y
result y = y
-- con (IO a) = IO
-- con (a,b,c,d) = TupleT 4
con (AppT x _) = con x
con x = x
-- conArgs (a,b,c,d) = [a,b,c,d]
-- conArgs (Either a b) = [a,b]
conArgs ty = go ty [] where
go (AppT x y) acc = go x (y:acc)
go _ acc = acc
splice $(ffimport'external_2)通过reify查看foreign_2的类型,以决定应用于参数或结果的函数.
-- Possibly useful to parameterize based on conv'
ffimport :: Name -> Q [Dec]
ffimport n = do
VarI _ ntype _ _ <- reify n
let ty :: [Type]
ty = args ntype
let -- these define conversions
-- (ffiType, (hsType -> IO ffiType, ffiType -> IO hsType))
conv' :: [(TypeQ, (ExpQ, ExpQ))]
conv' = [
([t| CString |], ([| newCString |],
[| peekCString |])),
([t| CDouble |], ([| return . (realToFrac :: Double -> CDouble) |],
[| return . (realToFrac :: CDouble -> Double) |]))
]
sequenceFst :: Monad m => [(m a, b)] -> m [(a,b)]
sequenceFst x = liftM (`zip` map snd x) (mapM fst x)
conv' <- sequenceFst conv'
-- now conv' :: [(Type, (ExpQ, ExpQ))]
鉴于上面的转换,在类型匹配时应用这些函数有点简单.如果返回元组的转换组件并不重要,则后壳会更短.
let conv :: Type -- ^ type of v
-> Name -- ^ variable to be converted
-> ExpQ
conv t v
| Just (to,from) <- lookup t conv' =
[| $to $(varE v) |]
| otherwise = [| return $(varE v) |]
-- | function to convert result types back, either
-- occuring as IO a, IO (a,b,c) (for any tuple size)
back :: ExpQ
back
| AppT _ rty <- result ntype,
TupleT n <- con rty,
n > 0, -- for whatever reason $(conE (tupleDataName 0))
-- doesn't work when it could just be $(conE '())
convTup <- map (maybe [| return |] snd .
flip lookup conv')
(conArgs rty)
= do
rs <- replicateM n (newName "r")
lamE [tupP (map varP rs)]
[| $(foldl (\f x -> [| $f `ap` $x |])
[| return $(conE (tupleDataName n)) |]
(zipWith (\c r -> [| $c $(varE r)|]) convTup rs))
|]
| AppT _ nty <- result ntype,
Just (_,from) <- nty `lookup` conv' = from
| otherwise = [| return |]
最后,将两个部分放在一个函数定义中:
vs <- replicateM (length ty) (newName "v")
liftM (:[]) $
funD (mkName $ "imported_"++nameBase n)
[clause
(map varP vs)
(normalB [| $back =<< join
$(foldl (\x y -> [| $x `ap` $y |])
[| return $(varE n) |]
(zipWith conv ty vs))
|])
[]]