Поливариадная функция Хаскеля с IO
Возможно ли иметь функцию, которая принимает вызов внешней функции, где некоторые из аргументов сторонней функции являются 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
Я понял, как это сделать с числовыми типами Си. Тем не менее, я не могу найти способ сделать это, который может разрешить преобразование строк.
Кажется, что проблема заключается в подгонке функций 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 ответа
Возможно ли иметь функцию, которая принимает вызов внешней функции, где некоторые из аргументов сторонней функции являются 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 Функция type извлекает простой контекст из 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
Ограничения здесь утверждают конкретный контекст, используя известный экземпляр, и что у нас есть некоторый базовый тип с преобразованием. Опять же, обратите внимание на параллельную структуру, разделяемую функцией type 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.
Это можно сделать с помощью шаблона 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-splices (обратите внимание, что 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) = f x y z, это приемлемо в шаблоне 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 с reify, чтобы решить, какие функции применить к аргументам или результату.
-- 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))
|])
[]]
Вот ужасное решение двух типов. Первая часть (названа, бесполезно, foo) будет принимать такие вещи, как Double -> Double -> CString -> IO () и превратить их в такие вещи, как IO (Double -> IO (Double -> IO (String -> IO ()))), Таким образом, каждое преобразование вынуждается в IO только для того, чтобы все было полностью одинаково.
Вторая часть, (названа cio для "коллапса ио) возьму те вещи и засуну все 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 эти ограничения могут быть преодолены. Но код достаточно ужасен, так что я бы не стал его рекомендовать.
Это определенно возможно. Обычный подход заключается в создании лямбды для передачи 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)