2011-08-11 68 views
9

是否有可能具有一個外部函數調用的函數,其中一些外部函數的參數是CString並返回一個接受String的函數?Haskell多元函數與IO

這裏是什麼,我正在尋找一個例子:

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

你能告訴我們你是寫什麼? –

+0

這是一個相當混亂的工作:-)我想如果它的存在對於實際使用來說太痛苦了。你看過'hsc2hs'嗎?它非常強大,並且可以生成您想要作爲預處理步驟的各種簽名。 – sclv

+0

我一直在考慮的一個解決方案是製作一個類似convertNth的函數,它需要一個數字和一個函數,然後轉換到這個位置。我想我有點想知道如何工作,儘管我還沒有嘗試過,所以也許這會帶來一些我沒有想到的困難。好的一面是,我仍然可以使用我的現有函數的非字符串,只需要顯式調出字符串。理想的情況下,我或其他人只會想出如何自動處理字符串。 – ricree

回答

15

是否有可能具有一個外部函數調用的函數,其中一些外部函數的參數是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 

這是說我們有一個背景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 

這是說兩種extint具有獨特的敞篷對方。我意識到可能不需要每種類型都只有一個映射,但我不想讓事情進一步複雜化(至少現在不是)。

如前所述,我也推遲處理遞歸轉換;大概他們可以合併,但我覺得這樣會更清楚。非遞歸轉換具有引入相應上下文的簡單且定義明確的映射,而遞歸轉換需要傳播和合並上下文,並處理基本情況中的區分遞歸步驟。

哦,你現在可能已經注意到,在課堂上下文中有趣的滑動波浪形業務。這表明兩種類型必須相同的約束條件;在這種情況下,它將每個類型的函數與相反的類型參數聯繫起來,這就給出了上述的雙向性質。呃,你可能想要一個相當新的GHC。在較老的GHC上,這需要功能依賴性,而且會寫成類似class Convert ext int | ext -> int, int -> ext的東西。

術語級轉換函數非常簡單 - 在結果中記下類型函數應用程序;應用程序一直是左關聯的,所以這只是應用來自較早類型系列的上下文。還要注意名稱的交叉,因爲導出上下文來自使用本機類型的查找。

因此,我們可以將不需要0​​類型:

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不明白你在做什麼,GHC會變得模糊。像這樣排列起來會顯着減少頭痛。

無論如何,對於這些類中的每一個,我們都需要一個實例用於每個可能的基本情況,另一個用於遞歸情況。唉,我們不容易有一個通用的基本案例,由於通常煩人的廢話重疊。它可以使用fundeps和類型相等條件來完成,但是......呃。也許以後。另一種選擇是將轉換函數參數化爲具有所需轉換深度的類型級別的數字,其缺點是自動化程度較低,但也可以從明確獲益中獲益,例如不太可能在多態或模棱兩可的類型。

現在,我將假設每個函數都以IO中的某些內容結束,因爲IO aa -> 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和term函數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] 

沒錯,這就是推斷類型。啊,這就是我想看到的。

編輯:誰想要嘗試了這一點,我已經採取了完整的代碼爲示範這裏,洗乾淨了一下,和uploaded it to github

+0

不錯!但有兩個問題 - 因爲你只是使用'newCString'而不是'withCString',這將會像五角大樓的一個未命名的源一樣泄漏。其次,如果沒有不可判定的實例,我假設這段代碼也不能默認讓任意值(沒有convert實例)保持不變? – sclv

+0

@sclv:關於分配的好處 - 使用'withCString'實際上也是一個有趣的例子。至於默認實例,這隻有在一般情況下才有可能*重疊*實例,因此,fundeps。 「Import」等遞歸已經需要不可判定的實例。 –

+0

是的 - 混淆了我的不可判定和重疊。 – sclv

0

這絕對有可能。通常的做法是創建lambdas傳遞到withCString。使用例如:

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

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

內功能鍵入CString -> IO a,而這正是施加CDouble到C函數func後的類型。你也有範圍CDouble,所以這就是你需要的一切。

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

對不起,不清楚。我試圖得到一個函數,接受一個未指定數量的參數。我已經更新了這個問題,希望更清楚。 – ricree

+0

對不起,誤會。這很難,但並非不可能。 –

4

這是一個可怕的兩種類型類解決方案。第一部分(無名,foo)將採取像Double -> Double -> CString -> IO()類型的東西,把它們變成諸如IO (Double -> IO (Double -> IO (String -> IO())))之類的東西。所以每個轉換都被強制轉換爲IO來保持事物的完全一致。

第二部分(名爲cio爲「崩潰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的catchall實例不能被寫入,所以對於你想要轉換的每種類型,即使轉換隻是id,你需要一個Foo的實例。第二個限制是catchall base由於IO每隔一週的包裝,無法寫入CIO的情況ING。所以這隻適用於返回IO()的東西。如果你想讓它爲返回IO Int的東西工作,你也需要添加該實例。

我懷疑,有足夠的工作和一些類型的廣告欺騙這些限制可以克服。但代碼足夠糟糕,所以我不會推薦它。

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

檢查通過加載test.hs與-ddump-拼接生成的代碼(注意, GHC似乎仍然錯過一些括號中的漂亮打印)顯示, foreign_2寫了一個定義,經過一番prettying起來的樣子:

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)着眼於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)) 
       |]) 
      []] 
+0

不錯!很高興看到用TH做事的例子。從很多方面來說,我更喜歡類似這樣的類,在概念上,它確實是一個帶有術語的類型的函數,但正如您指出的那樣,TH使得某些部分更易於使用。 –