在 Haskell 中的外部 C 指针之后清理

Cleaning up after foreign C pointers in Haskell

我围绕 bindings-fluidsynth 库编写了一组实用函数:

module FSUtilities where

import Control.Monad
import System.Directory
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C.String
import Bindings.FluidSynth

newtype Settings = Settings (ForeignPtr C'fluid_settings_t)

newtype Synth = Synth (ForeignPtr C'fluid_synth_t)

type Channel = Int
type Key = Int
type Velocity = Int

initSynth :: IO Synth
initSynth = createSettings >>=
            changeSettingStr "audio.driver" "alsa" >>=
            changeSettingInt "synth.polyphony" 64 >>=
            (\s -> createSynth s >>= createDriver s) >>=
            loadSF "GS.sf2"

createSettings :: IO Settings
createSettings =
    c'new_fluid_settings >>=
    newForeignPtr p'delete_fluid_settings >>= (pure $!) . Settings

changeSettingStr :: String -> String -> Settings -> IO Settings
changeSettingStr k v (Settings s) =
    withForeignPtr s $ \ptr ->
          withCAString k $ \cstr ->
              withCAString v $ \cstr' ->
                  c'fluid_settings_setstr ptr cstr cstr' >>
    (pure $! Settings s)

changeSettingInt :: String -> Int -> Settings -> IO Settings
changeSettingInt k v (Settings s) =
    withForeignPtr s $ \ptr ->
          withCAString k $ \cstr ->
              c'fluid_settings_setint ptr cstr (fromIntegral v) >>
    (pure $! Settings s)

createSynth :: Settings -> IO Synth
createSynth (Settings s) =
    withForeignPtr s c'new_fluid_synth >>=
    newForeignPtr p'delete_fluid_synth >>= (pure $!) . Synth

createDriver :: Settings -> Synth -> IO Synth
createDriver (Settings set) (Synth syn) =
    withForeignPtr set $ \ptr ->
        withForeignPtr syn $ \ptr' ->
            c'new_fluid_audio_driver ptr ptr' >>=
    newForeignPtr p'delete_fluid_audio_driver >>
    (pure $! Synth syn)

loadSF :: String -> Synth -> IO Synth
loadSF path (Synth syn) =
    withForeignPtr syn $ \s ->
      makeAbsolute path >>= \p ->
        withCAString p $ \p' ->
          c'fluid_synth_sfload s p' 1 >>=
    \c -> if c == (-1) then error    "loadSF: Could not load SoundFont"
                       else putStrLn "loadSF: SoundFont loaded" >>
                            (pure $! Synth syn)

noteOn :: Channel -> Key -> Velocity -> Synth -> IO ()
noteOn c k v (Synth ptr) =
    withForeignPtr ptr $ \syn ->
        c'fluid_synth_noteon syn c' k' v' >> pure ()
            where c' = fromIntegral c
                  k' = fromIntegral k
                  v' = fromIntegral v

justPlay :: Channel -> Key -> IO ()
justPlay c k = initSynth >>= noteOn c k 127

justPlay' :: Channel -> Key -> IO Synth
justPlay' c k = initSynth >>= \s -> noteOn c k 127 s >> pure s

justPlayjustPlay' 函数可以说明这个问题。当我从 ghci 调用 justPlay 时,我得到随机段错误(不一致,大约 30% 的时间),而 justPlay' 从来没有这样做(但在一堆调用后迅速填满我的系统内存,由于悬挂 Synths。我认为这是因为当 Synth 不再被引用时我没有自己清理,但我认为调用 newForeignPtr 带有终结函数在创建 Synth 时应该会自动处理。

我是 Haskell 的新手,我不懂 C,所以我正在尝试摸索。处理这种情况的正确方法是什么?

很难说到底是什么导致了崩溃,但至少有一个明显的错误。发生在 documentation:

Other users of a synthesizer instance, such as audio and MIDI drivers, should be deleted prior to freeing the FluidSynth instance.

在您的情况下,终结器的顺序未定义,因此可以在驱动程序之前删除合成器。估计其他对象也有生命周期限制吧。

要明确确定外部指针,请使用 finalizeForeignPtr