Función polivalente de Haskell con IO

Question

¿Es posible tener una función que toma una llamada de función externa donde algunos de los argumentos de la función externa son CString y devuelve una función que acepta String en su lugar?

He aquí un ejemplo de lo que estoy buscando:

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 

me di cuenta de cómo hacer esto con los tipos numéricos C. Sin embargo, no puedo encontrar una manera de hacerlo que permita la conversión de cadenas.

El problema parece encajar en las funciones IO, ya que todo lo que se convierte en CStrings como newCString o withCString son IO.

Esto es lo que parece que el código maneja la conversión de dobles.

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

¿Es posible tener una función que toma una llamada a una función extraña donde algunos de los argumentos de la función ajena son CString y devuelve una función que acepta String en su lugar?

¿Es posible, usted pregunta?

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

Ok. Lo bueno es que lo aclaramos.

calentamiento con unos trámites tediosos:

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

Ah, que no es tan mala. Mira, mamá, ¡no hay superposiciones!

El problema parece encajar en las funciones IO, ya que todo lo que se convierte en CStrings como newCString o withCString son IO.

Derecha. Lo que hay que observar aquí es que hay dos asuntos interrelacionados con los que preocuparnos: una correspondencia entre dos tipos, que permite conversiones; y cualquier contexto adicional introducido al realizar una conversión. Para lidiar con esto por completo, haremos que ambas partes sean explícitas y las mezclaremos de forma adecuada. También tenemos que prestar atención a varianza; levantar una función completa requiere trabajar con tipos tanto en posición covariante como contravariante, por lo que necesitaremos conversiones en ambas direcciones.

Ahora, dada una función que deseamos traducir, el plan es algo como esto:

• Convierte el argumento de la función, recibiendo un nuevo tipo y un poco de contexto.
• Deferir el contexto al resultado de la función, para obtener el argumento como lo queremos.
• Collapse contextos redundantes cuando sea posible
• recursiva traducen resultado de la función, para hacer frente a las funciones múltiples de argumentos

Bueno, eso no suena demasiado difícil. En primer lugar, los contextos explícitos:

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

Este dice que tenemos un contexto f, y algún tipo t con ese contexto. La función de tipo Cxt extrae el contexto simple de t y Collapse intenta combinar contextos si es posible. La función collapse nos permite usar el resultado de la función tipo.

Por ahora, tenemos contextos puros y 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... -} 

bastante simple. Manejar varias combinaciones de contextos es un poco tedioso, pero las instancias son obvias y fáciles de escribir.

También necesitaremos una forma de determinar el contexto dado un tipo para convertir. Actualmente, el contexto es el mismo yendo en cualquier dirección, pero ciertamente es concebible que sea de otra manera, así que los he tratado por separado. Por lo tanto, tenemos dos familias tipo, suministrando el nuevo contexto más externa para una conversión de importación/exportación:

type family ExpCxt int :: * -> * 
type family ImpCxt ext :: * -> * 

Algunos casos de ejemplo:

type instance ExpCxt() = PureCxt 
type instance ImpCxt() = PureCxt 

type instance ExpCxt String = IO 
type instance ImpCxt CString = IO 

El siguiente, la conversión de tipos individuales. Nos preocuparemos por la recursión más tarde.Es hora de otra clase de tipo:

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 

Esto dice que dos tipos ext y int son únicamente convertibles entre sí. Me doy cuenta de que podría no ser deseable tener siempre solo un mapeo para cada tipo, pero no tenía ganas de complicar más las cosas (al menos, no ahora).

Como se mencionó, también pospuse el manejo de conversiones recursivas aquí; probablemente podrían combinarse, pero sentí que sería más claro de esta manera. Las conversiones no recursivas tienen asignaciones simples y bien definidas que introducen un contexto correspondiente, mientras que las conversiones recursivas necesitan propagarse y fusionar contextos y ocuparse de distinguir los pasos recursivos del caso base.

Ah, y es posible que ya hayas notado el divertido negocio de tigres contoneantes en los contextos de clase. Eso indica una restricción de que los dos tipos deben ser iguales; en este caso, relaciona cada función de tipo con el parámetro de tipo opuesto, que da la naturaleza bidireccional mencionada anteriormente. Er, es probable que quieras tener un GHC bastante reciente. En los GHC más antiguos, esto necesitaría dependencias funcionales en su lugar, y se escribiría como algo como class Convert ext int | ext -> int, int -> ext.

Las funciones de conversión de nivel de término son bastante simples: tenga en cuenta la aplicación de función de tipo en su resultado; la aplicación se asocia de izquierda como siempre, de modo que eso solo aplica el contexto de las familias de tipos anteriores. También tenga en cuenta el cruce en los nombres, en que el exportación contexto proviene de una búsqueda utilizando el tipo nativo.

Por lo tanto, podemos convertir los tipos que no necesitan IO:

instance Convert CDouble Double where 
    type Foreign Double = CDouble 
    type Native CDouble = Double 
    toForeign = pure . realToFrac 
    toNative = pure . realToFrac 

... así como los tipos que hacen:

instance Convert CString String where 
    type Foreign String = CString 
    type Native CString = String 
    toForeign = newCString 
    toNative = peekCString 

ahora a atacar el corazón de la materia y traducir funciones completas recursivamente. No debería sorprender que haya introducido otra clase de tipo. En realidad, dos, ya que he separado las conversiones de importación/exportación esta vez.

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

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

Nada interesante aquí. A estas alturas, puede estar notando un patrón común: estamos haciendo cantidades aproximadamente iguales de computación tanto a nivel de término como de tipo, y las estamos haciendo en tándem, incluso hasta el punto de imitar nombres y estructura de expresiones. Esto es bastante común si está haciendo un cálculo de tipo de letra para cosas que involucran valores reales, ya que GHC se pone quisquilloso si no entiende lo que está haciendo. Alinear las cosas de esta manera reduce los dolores de cabeza significativamente.

De todos modos, para cada una de estas clases, necesitamos una instancia para cada caso base posible, y una para el caso recursivo. Por desgracia, no podemos tener fácilmente un caso base genérico, debido a las habituales tonterías molestas con la superposición. Podría hacerse usando fundeps y escribir condicionales de igualdad, pero ... ugh. Quizas mas tarde. Otra opción sería parametrizar la función de conversión mediante un número de nivel de tipo que proporcione la profundidad de conversión deseada, que tiene la desventaja de ser menos automática, pero también se beneficia al ser explícita, como la menor probabilidad de tropezar con polimorfismo o tipos ambiguos.

Por ahora, voy a asumir que cada función termina con algo en IO, ya que es distinguible de IO aa -> b sin solapamiento.

En primer lugar, el caso base:

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 

Las limitaciones aquí valer un contexto específico utilizando un caso conocido, y que tenemos algún tipo de base con una conversión. De nuevo, observe la estructura paralela compartida por la función de tipo Import y la función de término ffImport. La idea real aquí debería ser bastante obvia: asignamos la función de conversión sobre IO, creando un contexto anidado de algún tipo, luego usamos Collapse/collapse para limpiarlo después.

El caso recursivo es similar, pero más elaborado:

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 

Hemos añadido una restricción FFImport para la llamada recursiva, y la disputa contexto se ha vuelto más incómodo porque no sabemos exactamente lo que se es, simplemente, especificar lo suficiente para asegurarnos de que podamos manejarlo. Tenga en cuenta también la contradicción aquí, en el sentido de que estamos convirtiendo la función en tipos nativos, pero convirtiendo el argumento en un tipo foráneo. Aparte de eso, sigue siendo bastante simple.

Ahora, he omitido algunas instancias en este punto, pero todo lo demás sigue los mismos patrones que el anterior, así que saltemos hasta el final y analicemos los productos. Algunas funciones imaginarias extranjeros:

foreign_1 :: (CDouble -> CString -> CString -> IO()) 
foreign_1 = undefined 

foreign_2 :: (CDouble -> SizedArray a -> IO CString) 
foreign_2 = undefined 

y conversiones:

imported1 = ffImport foreign_1 
imported2 = ffImport foreign_2 

Qué, no hay firmas de tipos? ¿Funcionó?

> :t imported1 
imported1 :: Double -> String -> [Char] -> IO() 
> :t imported2 
imported2 :: Foreign.Storable.Storable a => Double -> AsArray a -> IO [Char] 

Sí, esa es la inferido tipo. Ah, eso es lo que me gusta ver.

Editar: Para cualquier persona que quiera probar esto, yo he tomado el código completo para la demostración aquí, lo limpió un poco, y uploaded it to github.

Answer 2

Definitivamente es posible. El enfoque habitual es crear lambdas para pasar al withCString. Usando su ejemplo:

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

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

la función interna ha escriba CString -> IO a, que es exactamente el tipo después de aplicar un CDouble a la función C func. También tiene un alcance de CDouble, así que eso es todo lo que necesita.

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

Answer 3

Aquí hay una horrible solución de dos tipos de clases. La primera parte (llamada, inútilmente, foo) tomará cosas de tipos como Double -> Double -> CString -> IO() y las convertirá en cosas como IO (Double -> IO (Double -> IO (String -> IO()))). Por lo tanto, cada conversión se fuerza a IO solo para mantener las cosas completamente uniformes.

La segunda parte, (llamado cio para "io colapso) se llevará a esas cosas y empujar todos los IO bits para el final.

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

Aparte de ser una cosa general terribles que ver, hay dos limitaciones específicas. La primera es que no se puede escribir una instancia catchall de Foo. Por lo tanto, para cada tipo que desee convertir, incluso si la conversión es solo id, necesita una instancia de Foo. La segunda limitación es que una base catchall El caso CIO no se puede escribir debido a las envolturas IO de todo En g. Así que esto solo funciona para cosas que devuelven IO(). Si desea que funcione para algo que devuelva IO Int, debe agregar esa instancia también.

Sospecho que con suficiente trabajo y algún tipo de engaño se pueden superar estas limitaciones. Pero el código es lo suficientemente horrible como es, así que no lo recomendaría.

Answer 4

Esto se puede hacer con template haskell. En muchos sentidos, es más simple que las alternativas que implican clases, ya que es más fácil emparejar patrones en Language.Haskell.TH.Type que hacer lo mismo con instancias.

{-# 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]) 

tipos inferidos de las funciones que se generan son:

imported_foreign_1 :: Double -> String -> String -> IO String 
imported_foreign_2 :: Double -> String -> String -> IO (Int, String) 
imported_foreign_3 :: String -> IO() 

Comprobación del código generado por test.hs de carga con -ddump-empalmes (tenga en cuenta que GHC todavía parece pasar por alto algunos paréntesis en el bonito impresión) muestra que foreign_2 escribe una definición que después de algunos embellecer el siguiente aspecto:

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

o traducido hacer la notación:

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) 

La generación de código de la primera manera es más simple en que hay menos variables a pista.Mientras foldl ($) f [x, y, z] no escriba check cuando significará ((f $ x) $ y $ z) = fxyz es aceptable en haskell de plantilla que involucra solo un puñado de diferentes tipos.

Ahora para la aplicación efectiva de esas ideas:

{-# 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 

El empalme $ (ffimport 'foreign_2) mira el tipo de foreign_2 con cosificar a decidir qué funciones para aplicar a los argumentos o resultado.

-- 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 Teniendo en cuenta lo indicado, es algo sencillo de aplicar esas funciones cuando los tipos de concordancia. La caja posterior sería más corta si la conversión de componentes de devolvió tuplas no era importante.

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

Por último, poner las dos partes juntas en una definición de función:

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