haskell - IO を使用した Haskell 多変量関数

Question

外部関数の引数の一部が 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数値型でこれを行う方法を見つけました。ただし、文字列変換を可能にする方法がわかりません。

newCString や withCString などの CString に変換されるものはすべて IO であるため、この問題は IO 関数に当てはまるようです。

double の変換のみを処理するコードは次のようになります。

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

外部関数の引数の一部が CString である外部関数呼び出しを受け取り、代わりに String を受け入れる関数を返す関数を持つことは可能ですか?

可能ですか？

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

Ok。解決できて良かったです。

いくつかの面倒な手順でウォームアップします。

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

あ、悪くないですけどね。ほら、お母さん、重ならないで！

newCString や withCString などの CString に変換されるものはすべて IO であるため、この問題は IO 関数に当てはまるようです。

右。ここで注意すべきことは、私たち自身が関心を持っている 2 つのやや相互に関連した問題があるということです。および変換を実行することによって導入された余分なコンテキスト。これに完全に対処するために、両方の部分を明示的にして、適切にシャッフルします。分散にも注意する必要があります。関数全体を持ち上げるには、共変と反変の両方の位置で型を操作する必要があるため、両方向の変換が必要になります。

ここで、翻訳したい関数が与えられると、計画は次のようになります。

• 関数の引数を変換し、新しい型とコンテキストを受け取ります。
• コンテキストを関数の結果に任せて、必要な方法で引数を取得します。
• 可能であれば冗長なコンテキストを折りたたむ
• 関数の結果を再帰的に変換して、複数引数の関数を処理します

まあ、それはそれほど難しくないように聞こえます。まず、明示的なコンテキスト:

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

これは、 context と、その 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... -}

十分に単純です。コンテキストのさまざまな組み合わせを処理するのは少し面倒ですが、インスタンスは明白で簡単に記述できます。

また、変換する型を指定してコンテキストを決定する方法も必要です。現在、どちらの方向にもコンテキストは同じですが、そうでない場合も確かに考えられるので、それらを別々に扱いました。したがって、インポート/エクスポート変換の新しい最も外側のコンテキストを提供する 2 つの型ファミリがあります。

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

これは、2 つの型extとintが互いに一意に変換可能であることを示しています。タイプごとに常に 1 つのマッピングしか持たないことが望ましいとは限らないことは理解していますが、これ以上複雑にする気はありませんでした (少なくとも、現時点ではそうではありません)。

前述のとおり、ここでは再帰変換の処理も延期しました。おそらくそれらは組み合わせることができますが、この方法でより明確になると感じました。非再帰的な変換には、対応するコンテキストを導入する単純で明確に定義されたマッピングがありますが、再帰的な変換では、コンテキストを伝播およびマージし、再帰的なステップを基本ケースと区別して処理する必要があります。

ああ、もうお気づきかもしれませんが、クラスのコンテキストで面白い波状のチルダ ビジネスが行われています。これは、2 つの型が等しくなければならないという制約を示しています。この場合、各型関数を反対の型パラメーターに結び付け、上記の双方向性を提供します。ええと、あなたはおそらくかなり最近の 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

ここで問題の核心に迫り、関数全体を再帰的に変換します。さらに別の型クラスを導入したことは驚くべきことではありません。今回はインポート/エクスポートの変換を分離したので、実際には 2 つです。

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

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

ここには何も興味深いものはありません。ここまでで、共通のパターンに気付いているかもしれません。用語と型の両方のレベルでほぼ同じ量の計算を行っており、名前と式の構造を模倣するところまで、それらを並行して行っています。実数値を含むものに対して型レベルの計算を行っている場合、これはかなり一般的です。なぜなら、GHC は何をしているのか理解できないと面倒になるからです。このように並べると、頭痛が大幅に軽減されます。

とにかく、これらのクラスごとに、考えられる基本ケースごとに 1 つのインスタンスと、再帰ケース用に 1 つのインスタンスが必要です。残念ながら、オーバーラップに関する通常の厄介なナンセンスのために、一般的な基本ケースを簡単に作成することはできません。これは、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ここでも、 type functionと 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 にアップロードしました。

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

または do 表記に翻訳:

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

Answer 3

これは恐ろしい 2 つの型クラスのソリューションです。最初の部分 (役に立たない名前foo) は、 のような型のものを取り、Double -> Double -> CString -> IO ()それらを のようなものに変換しますIO (Double -> IO (Double -> IO (String -> IO ())))。そのため、物事を完全に均一に保つために、各変換は IO に強制されます。

2 番目の部分 ( 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 ()
-}

一般的にひどいことをすることは別として、2 つの特定の制限があります。1 つ目は、 のキャッチオール インスタンスをFoo記述できないことです。したがって、変換するすべての型について、たとえ変換が単なるidであっても、 のインスタンスが必要ですFoo。2 番目の制限は、すべてのラッパーCIOが原因で、包括的な基本ケースを記述できないことです。IOしたがって、これは を返すものに対してのみ機能しIO ()ます。何かを返すためにそれを機能させたい場合はIO Int、そのインスタンスも追加する必要があります。

十分な作業といくつかの typeCast の策略により、これらの制限を克服できると思います。しかし、コードはそのままでは十分にひどいので、お勧めしません。

Answer 4

それは間違いなく可能です。通常のアプローチは、に渡すラムダを作成することwithCStringです。あなたの例を使用して：

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

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

内部関数の型は、C関数にCString -> IO aaを適用した後の型とまったく同じです。スコープもあるので、必要なのはそれだけです。CDoublefuncCDouble

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