ForeignObj across C calls

Marcin 'Qrczak' Kowalczyk qrczak@knm.org.pl
12 Nov 2000 11:20:49 GMT


Weren't foreign objects supposed to be kept alive across C calls?
They are not (before-ghci-branch).

[qrczak ~/haskell]$ cat Obj.hsc
#include <stdio.h>

import Char
import Foreign
import CTypes

type Callback = Ptr CChar -> IO ()
foreign export dynamic exportCallback :: Callback -> IO (FunPtr Callback)

foreign import loop :: ForeignObj -> FunPtr Callback -> IO ()
#def void loop (void *obj, void (*callback) (char *)) \
{
    int i;
    char s[20];
    for (i = 0; i < 300; ++i)
    {
        sprintf (s, "Callback %d", i);
        callback (s);
    }
}

peekArray0:: (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 marker ptr = do
    val <- peek ptr
    if val == marker then return [] else do
        rest <- peekArray0 marker (ptr `indexPtr` 1)
        return (val:rest)

peekCString:: Ptr CChar -> IO String
peekCString ptr = do
    str <- peekArray0 0 ptr
    return (map (chr . fromIntegral) str)

main:: IO ()
main = do
    obj  <- newForeignObj nullPtr (putStrLn "Finalized")
    fPtr <- exportCallback (\ptr -> peekCString ptr >>= putStrLn)
    loop obj fPtr
[qrczak ~/haskell]$ hsc2hs Obj.hsc
[qrczak ~/haskell]$ ghc -fglasgow-exts Obj.hs Obj.hs.c -o Obj
[qrczak ~/haskell]$ ./Obj | grep -1 Finalized
Callback 73
Finalized
Callback 74
[qrczak ~/haskell]$

-- 
 __("<  Marcin Kowalczyk * qrczak@knm.org.pl http://qrczak.ids.net.pl/
 \__/
  ^^                      SYGNATURA ZASTĘPCZA
QRCZAK