I'm trying to use libSDL. Sometimes the program crashes immediately, other times it will run for minutes before dying. I have no problem until I use SDL_AddTimer which is making a callback to a Haskell function asynchronously.

The error message is:
Code:
test: schedule: re-entered unsafely.
   Perhaps a 'foreign import unsafe' should be 'safe'?
To answer the obvious questions:
- none of my foreign import statements are marked unsafe.
- The libSDL wrapper on Hackage doesn't support SDL_AddTimer

Apologies for the large code dump, the FFI needs a lot of boilerplate. I'm compiling with "ghc --make test.hs \path\to\libsdl\SDL.lib"
haskell Code:
{-# LANGUAGE ForeignFunctionInterface #-}
 
module Main where
 
import Foreign
import Foreign.Ptr
 
data SDL_EventType = SDL_QUIT | SDL_TODOEVENT | SDL_USEREVENT Int8
    deriving Show
 
toEventType :: Int8 -> SDL_EventType
toEventType 12 = SDL_QUIT
toEventType t
    | t < 24    = SDL_TODOEVENT
    | otherwise = SDL_USEREVENT t
 
fromEventType :: SDL_EventType -> Int8
fromEventType (SDL_USEREVENT t) = t
 
data SDL_Surface =
    SDL_Surface {
        pitch     :: Int16,
        pixels    :: Ptr Int8
    }
 
data SDL_Event =
    GenericEvent {
        eventType :: SDL_EventType
    }
    deriving Show
 
sdl_INIT_VIDEO = 0x20 :: Int32
sdl_INIT_TIMER = 0x01 :: Int32
sdl_SWSURFACE = 0 :: Int32
 
instance Storable SDL_Surface where
    alignment _ = 4
    sizeOf _ = 60
    peek ptr = do
        pitch' <- peek $ plusPtr ptr 16
        pixels' <- peek $ plusPtr ptr 20
        return $ SDL_Surface {
            pitch = pitch',
            pixels = pixels'
        }
    poke ptr _ = return ()
 
 
instance Storable SDL_Event where
    alignment _ = 4
    sizeOf _ = 20
    peek ptr = do
            eventType' <- peek eventTypePtr >>= return . toEventType
            return $ GenericEvent { eventType = eventType' }
        where eventTypePtr = (castPtr ptr) :: (Ptr Int8)
    poke ptr evt@GenericEvent{} = do
            poke eventTypePtr (fromEventType $ eventType evt)
        where eventTypePtr = (castPtr ptr) :: (Ptr Int8)
 
foreign import stdcall "GetModuleHandleA"
    getModuleHandle :: Ptr Int32 -> IO Int32
 
foreign import ccall "SDL_SetModuleHandle"
    sdl_setModuleHandle :: Int32 -> IO ()
 
foreign import ccall "SDL_Init"
    sdl_init :: Int32 -> IO Int32
 
foreign import ccall "SDL_Quit"
    sdl_quit :: IO Int32
 
foreign import ccall "SDL_SetVideoMode"
    sdl_setVideoMode :: Int32 -> Int32 -> Int32 -> Int32 -> IO (Ptr SDL_Surface)
 
foreign import ccall "SDL_WaitEvent"
    sdl_waitEvent :: Ptr SDL_Event -> IO Int32
 
foreign import ccall "SDL_LockSurface"
    sdl_lockSurface :: Ptr SDL_Surface -> IO Int32
 
foreign import ccall "SDL_UnlockSurface"
    sdl_unlockSurface :: Ptr SDL_Surface -> IO Int32
 
foreign import ccall "SDL_UpdateRect"
    sdl_updateRect :: Ptr SDL_Surface -> Int32 -> Int32 -> Int32 -> Int32 -> IO Int32
 
foreign import ccall "SDL_AddTimer"
    sdl_addTimer :: Word32 -> FunPtr (Word32 -> Ptr() -> IO Word32) -> Ptr () -> IO Word32
 
foreign import ccall "SDL_PushEvent"
    sdl_pushEvent :: Ptr SDL_Event -> IO Int32
 
foreign import ccall "SDL_FillRect"
    sdl_fillRect :: Ptr SDL_Surface -> Ptr () -> Word32 -> IO Int32
 
foreign import ccall "wrapper"
    wrapCallback :: (Word32 -> Ptr () -> IO Word32) -> IO (FunPtr (Word32 -> Ptr () -> IO Word32))
 
-- Pokes a 32-bit 0RGB value into a surface's pixel data
setPixel32 :: Ptr SDL_Surface -> Int -> Int -> Int32 -> IO ()
setPixel32 ps x y c = do
        s <- peek ps
        let offset = (x * 4) + y * (fromIntegral $ pitch s) in
            poke (plusPtr (pixels s) offset) c
 
-- Runs an action surrounding it with SDL_LockSurface / SDL_UnlockSurface
withLockedSurface :: Ptr SDL_Surface -> IO b -> IO b
withLockedSurface s f = do
    sdl_lockSurface s
    result <- f
    sdl_unlockSurface s
    return result
 
-- Initialize SDL
-- Schedule a timer event @ 20ms intervals
-- Start the event loop
main = do
    getModuleHandle nullPtr >>= sdl_setModuleHandle
    sdl_init $ sdl_INIT_VIDEO .|. sdl_INIT_TIMER
 
    screen <- sdl_setVideoMode 640 480 32 sdl_SWSURFACE
 
    ticker <- malloc >>= wrapCallback . makeTicker
    sdl_addTimer 20 ticker nullPtr
 
    alloca $ eventLoop screen 0
    sdl_quit
 
-- Create a timer that queues up an SDL_USEREVENT
-- and then schedules itself w/ the same time interval
makeTicker :: Ptr SDL_Event -> (Word32 -> Ptr () -> IO Word32)
makeTicker evt = \i _ -> do
                    poke evt $ GenericEvent { eventType = SDL_USEREVENT 24 }
                    sdl_pushEvent evt
                    return i
 
drawSine ofst s = mapM_ drawPoint [0..639]
    where drawPoint x =
            let theta = (fromIntegral $ x + ofst) * 2 * pi / 640
                y = round $ 240 + 100 * sin theta
            in  setPixel32 s x y 0xFFFFFF
 
-- Handle SDL Events
--  SDL_QUIT        -> exit event loop
--  SDL_USEREVENT   -> draw sinewave & increment frame
--  otherwise       -> ignore
eventLoop :: Ptr SDL_Surface -> Int -> Ptr SDL_Event -> IO ()
eventLoop screen frame event = do
    sdl_waitEvent event
    evt <- peek event
    case evt of
        GenericEvent SDL_QUIT -> return ()
 
        GenericEvent (SDL_USEREVENT et)
            | et == 24 -> do
                withLockedSurface screen $ do
                    sdl_fillRect screen nullPtr 0
                    drawSine frame screen
                sdl_updateRect screen 0 0 0 0
                eventLoop screen (frame+1) event
            | otherwise -> eventLoop screen frame event
 
        _ -> eventLoop screen frame event