Haskell 多變量 Function 與 IO

Question

Is it possible to have a function that takes a foreign function call where some of the foreign function's arguments are CString and return a function that accepts String instead?

這是我正在尋找的示例：

 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))

Answer 1

Is it possible to have a function that takes a foreign function call where some of the foreign function's arguments are CString and return a function that accepts String instead?

請問有可能嗎？

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

好的。 還好我們搞清楚了。

通過一些繁瑣的手續熱身：

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

啊，不過也沒那么糟。 看，媽，沒有重疊！

這個問題似乎適合 IO 函數，因為所有轉換為 CString 的東西，例如 newCString 或 withCString 都是 IO。

正確的。 這里要注意的是，有兩個相互關聯的問題需要我們自己關注： 兩種類型之間的對應，允許轉換； 以及通過執行轉換引入的任何額外上下文。 為了完全處理這個問題，我們將明確這兩個部分並適當地打亂它們。 我們還需要注意差異； 提升整個 function 需要使用協變和逆變 position 中的類型，因此我們需要雙向轉換。

現在，給定我們希望翻譯的 function，計划如下：

• 轉換函數的參數，接收新類型和一些上下文。
• 將上下文延遲到函數的結果中，以獲取我們想要的參數。
• 盡可能折疊冗余上下文
• 遞歸翻譯函數的結果，以處理多參數函數

嗯，這聽起來並不難。 首先，明確的上下文：

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

這表示我們有一個上下文f ，以及帶有該上下文的一些類型t 。 Cxt類型 function 從t中提取純上下文，並且Collapse盡可能嘗試組合上下文。 collapse function 讓我們使用 function 類型的結果。

現在，我們有純上下文和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 的時間：

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可以唯一地相互轉換。 我意識到對於每種類型始終只有一個映射可能並不可取，但我不想讓事情進一步復雜化（至少，現在不是）。

如前所述，我在這里也推遲了處理遞歸轉換。 也許它們可以結合起來，但我覺得這樣會更清楚。 非遞歸轉換具有簡單、定義明確的映射，可以引入相應的上下文，而遞歸轉換需要傳播和合並上下文，並處理將遞歸步驟與基本情況區分開來。

哦，您現在可能已經注意到在 class 上下文中正在進行的有趣的波浪形波浪線業務。 這表明兩種類型必須相等的約束； 在這種情況下，它將每個類型 function 與相反的類型參數聯系起來，這給出了上面提到的雙向性質。 呃，不過，你可能想要一個相當新的 GHC。 在較舊的 GHC 上，這將需要函數依賴，並且會寫成class Convert ext int | ext -> int, int -> ext class Convert ext int | ext -> int, int -> ext 。

術語級轉換函數非常簡單——注意其結果中的類型 function 應用程序； 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。 實際上，兩個，因為我這次分離了導入/導出轉換。

class FFImport ext where
    type Import ext :: *
    ffImport :: ext -> Import ext

class FFExport int where
    type Export int :: *
    ffExport :: int -> Export int

這里沒什么有趣的。 您現在可能已經注意到一個常見模式——我們在術語和類型級別上進行大致相同數量的計算，並且我們正在串聯進行，甚至到了模仿名稱和表達式結構的地步。 如果您正在對涉及實際值的事物進行類型級計算，這很常見，因為如果 GHC 不了解您在做什么，它就會變得很挑剔。 像這樣排列起來可以顯着減少頭痛。

無論如何，對於這些類中的每一個，我們都需要為每個可能的基本情況提供一個實例，並為遞歸情況提供一個實例。 唉，我們不能輕易地擁有一個通用的基本情況，因為重疊通常是令人討厭的廢話。 它可以使用fundeps和類型相等條件來完成，但是......呃。 也許以后。 另一種選擇是通過類型級數參數化轉換 function 以提供所需的轉換深度，這具有不太自動化的缺點，但也從顯式中獲得一些好處，例如不太可能偶然發現多態或模棱兩可的類型。

現在，我假設每個 function 都以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

這里的約束使用已知實例斷言特定上下文，並且我們有一些帶有轉換的基本類型。 同樣，請注意類型 function Import和術語 function ffImport共享的並行結構。 這里的實際想法應該很明顯 - 我們 map 轉換 function 超過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約束，並且上下文爭吵變得更加尷尬，因為我們不確切知道它是什么，只是指定了足夠的內容以確保我們可以處理它。 還要注意這里的逆變，因為我們將function轉換為本地類型，但將參數轉換為外部類型。 除此之外，它仍然很簡單。

現在，我在這一點上省略了一些實例，但其他一切都遵循與上述相同的模式，所以讓我們跳到最后，scope 出貨。 一些假想的外來函數：

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 。

Answer 2

這可以通過模板 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 的類型，以決定將哪些函數應用於 arguments 或結果。

-- 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 |]

最后，將兩個部分放在一起在 function 定義中：

    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))
                |])
            []]

Answer 3

這是一個可怕的兩個類型類解決方案。 The first part (named, unhelpfully, foo ) will take things of types like Double -> Double -> CString -> IO () and turn them into things like 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實例。 第二個限制是，由於IO圍繞所有內容的包裝器，無法編寫CIO的全面基本案例。 所以這只適用於返回IO ()的東西。 如果您希望它適用於返回IO Int的東西，您也需要添加該實例。

我懷疑通過足夠的工作和一些 typeCast 技巧可以克服這些限制。 但是代碼本身就足夠可怕，所以我不推薦它。

Answer 4

這絕對是可能的。 通常的方法是創建 lambdas 以傳遞給withCString 。 使用您的示例：

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

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

The inner function has type CString -> IO a , which is exactly the type after applying a CDouble to the C function func . 您在 scope 中也有一個CDouble ，這就是您所需要的一切。

myMarshaller func cdouble string =
  withCString string (\cstring -> func cdouble cstring)