9

是否有可能有一个函数接受外部函数调用，其中一些外部函数的参数是 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 函数，因为所有转换为 CString 的东西，例如 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))
4

4 回答 4

16

是否有可能有一个函数接受外部函数调用，其中一些外部函数的参数是 CString 并返回一个接受 String 的函数？

请问有可能吗？

<lambdabot> The answer is: Yes! Haskell can do that.

行。还好我们搞清楚了。

通过一些繁琐的手续热身：

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

啊，不过也没那么糟。看，妈，没有重叠！

这个问题似乎适合 IO 函数，因为所有转换为 CString 的东西，例如 newCString 或 withCString 都是 IO。

对。这里要注意的是，有两个相互关联的问题需要我们自己关注： 两种类型之间的对应，允许转换；以及通过执行转换引入的任何额外上下文。为了完全处理这个问题，我们将明确这两个部分并适当地打乱它们。我们还需要注意差异；提升整个函数需要使用协变和逆变位置的类型，因此我们需要双向转换。

现在，给定一个我们希望翻译的函数，计划是这样的：

  • 转换函数的参数，接收新类型和一些上下文。
  • 将上下文延迟到函数的结果中，以获取我们想要的参数。
  • 尽可能折叠冗余上下文
  • 递归翻译函数的结果，以处理多参数函数

嗯，这听起来并不难。首先，明确的上下文：

class (Functor f, Cxt t ~ f) => Context (f :: * -> *) t where
    type Collapse t :: *
    type Cxt t :: * -> *
    collapse :: t -> Collapse t

这表示我们有一个 context f，以及具有该上下文的某种类型t。type 函数从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.

术语级转换函数非常简单——注意其结果中的类型函数应用；application 和往常一样是左关联的，所以这只是应用早期类型系列的上下文。还要注意名称中的交叉，因为导出上下文来自使用本机类型的查找。

所以，我们可以转换不需要的类型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和类型相等条件来完成，但是......呃。也许以后。另一种选择是通过类型级数对转换函数进行参数化，给出所需的转换深度，其缺点是自动化程度较低，但也可以从显式中获得一些好处，例如不太可能偶然发现多态或模棱两可的类型。

现在，我将假设每个函数都以 in 结尾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

这里的约束使用已知实例断言特定上下文，并且我们有一些带有转换的基本类型。再次注意 type functionImport和 term function共享的并行结构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。

于 2011-08-12T03:19:10.137 回答
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

拼接 $(ffimport 'foreign_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))]

鉴于上面的 conv'，当类型匹配时应用这些函数有点简单。如果转换返回的元组的组件不重要，则后面的情况会更短。

    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))
                |])
            []]
于 2011-08-12T07:05:20.693 回答
4

这是一个可怕的两个类型类解决方案。第一部分（命名为 . foo）将采用 like 类型的东西Double -> Double -> CString -> IO ()并将它们转换为IO (Double -> IO (Double -> IO (String -> IO ()))). 所以每次转换都被强制进入 IO 只是为了保持事情完全一致。

第二部分（以cio“collapse io”命名）将处理这些内容并将所有IO位推到最后。

class Foo a b | a -> b where
    foo :: a -> b
instance Foo (IO a) (IO a) where
    foo = id
instance Foo a (IO b) => Foo (CString -> a) (IO (String -> IO b)) where
    foo f = return $ \s -> withCString s $ \cs -> foo (f cs)
instance Foo a (IO b) => Foo (Double -> a) (IO (Double -> IO b)) where
    foo f = return $ \s -> foo (f s)

class CIO a b | a -> b where
    cio :: a -> b
instance CIO (IO ()) (IO ()) where
    cio = id
instance CIO (IO b) c => CIO (IO (a -> IO b)) (a -> c) where
    cio f = \a -> cio $ f >>= ($ a)

{-
*Main> let x = foo (undefined :: Double -> Double -> CString -> IO ())
*Main> :t x
x :: IO (Double -> IO (Double -> IO (String -> IO ())))
*Main> :t cio x
cio x :: Double -> Double -> String -> IO ()
-}

除了通常是一件糟糕的事情之外，还有两个特定的限制。首先是Foo不能编写一个包罗万象的实例。因此，对于您要转换的每种类型，即使转换只是id. ，您也需要Foo. 第二个限制是，由于所有内容的包装器，CIO无法编写一个包罗万象的基本案例。IO所以这只适用于返回的东西IO ()。如果你想让它为返回的东西工作，IO Int你也需要添加那个实例。

我怀疑通过足够的工作和一些 typeCast 技巧可以克服这些限制。但是代码本身就足够可怕，所以我不推荐它。

于 2011-08-11T19:45:05.117 回答
0

这绝对是可能的。通常的方法是创建 lambdas 以传递给withCString. 使用您的示例：

myMarshaller :: (CDouble -> CString -> IO ()) -> CDouble -> String -> IO ()
myMarshaller func cdouble string = ...

withCString :: String -> (CString -> IO a) -> IO a

内部函数具有类型CString -> IO a，这正是将 aCDouble应用于 C 函数之后的类型func。你也有一个CDouble范围，所以这就是你需要的一切。

myMarshaller func cdouble string =
  withCString string (\cstring -> func cdouble cstring)
于 2011-08-11T18:05:43.643 回答