System.Plugins 加载器似乎在看到一次失败后假设失败

Question

我目前正在开发一个从文本框中获取用户输入的 haskell 程序，然后 使用System.Plugins 库编译并加载它，以便提取图片以绘制到屏幕上。用户可以在文本框中编辑代码，然后通过单击编译按钮重新加载他们的新图像。这是单击编译按钮时触发的代码：

compileText :: SourceView -> SOE.Window -> IO ()
compileText tview w = do 
    txtBuff <- textViewGetBuffer tview
    startIt <- textBufferGetStartIter txtBuff
    endIt <- textBufferGetEndIter txtBuff
    compTime <- getClockTime
    srcString <- textBufferGetByteString txtBuff startIt endIt False

    BS.writeFile "Test.hs" srcString
    mkStat <- make "Test.hs" []
    case mkStat of
        MakeSuccess cd fp -> print fp
        MakeFailure (er1:er2:errs) -> error er2

    loadResult <- getModule
    case loadResult of
        Right (md, pic) -> do
                runGraphics $ do
                    draw3 "gtk test" pic w
                unload md
        Left errors -> print errors
    return ()

getModule :: IO (Either [String] (Module, Picture))
getModule = do 
               mv <- load "Test.o" ["."] [] "pic"
               case mv of
                    LoadFailure messages -> return (Left messages)
                    LoadSuccess x y -> return (Right (x, y))

下面是用户在文本框中输入的一些示例代码：

module Test where
    import Picture

    r1,r2,r3,r4 :: Region
    r1 = Shape(Rectangle 2 1)
    r2 = Shape(Ellipse 2 1.5)
    r3 = Shape(RtTriangle 3 2)
    r4 = Shape(Polygon [(-2.5, 2.5), (-3.0,0), (-1.7,-1.0), (-1.1,0.2),(-1.5,2.0)])

    p1,p2,p3,p4 :: Picture
    p1 = Region Red r1
    p2 = Region Green r2
    p3 = Region Blue r3
    p4 = Region Yellow r4

    pics :: Picture
    pics = foldl Over EmptyPic [p1,p2,p3,p4]

只要用户编写的代码每次都能正确编译和加载，这一切都会按预期工作。但是，当用户编写一段无法加载的代码时（我一直在玩的示例是将 'pic' 更改为 'pics'，因此它无法找到要加载的 pic 函数）预期的行为是程序将打印加载错误到屏幕，以便用户可以更正他们的代码并尝试再次单击编译按钮。

然而，实际发生的情况是，一旦程序遇到一次 LoadFailure，所有后续点击编译按钮的尝试都会导致加载失败消息，无论代码是否正确！

我不太确定这里到底发生了什么，但似乎程序在每次评估中保留了一些先前结果的记忆。如何获得我正在寻找的行为？

编辑：我试图通过编写一个小测试用例来隔离问题，该用例说明了我在不使用 gtk 的情况下遇到的问题

import Control.Monad
import System.Time
import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

import System.Plugins.Make
import System.Plugins.Load
import System.Eval.Haskell

testCaseCorrect :: String
testCaseCorrect = "module Test where\n printGreeting :: String -> IO ()\n printGreeting greeting = print greeting"

-- This should cause load to fail as it will not be able to find the
-- printGreeting function
testCaseIncorrect :: String
testCaseIncorrect = "module Test where\n printGurting :: String -> IO ()\n printGurting greeting = print greeting"

main :: IO ()
main = do
    BS.writeFile "Test.hs" (BSC.pack testCaseCorrect)
    mkStat <- make "Test.hs" []

    case mkStat of
        MakeSuccess cd fp -> print fp
        MakeFailure (er1:er2:errs) -> error er2

    loadResult <- getModule
    case loadResult of
        Right (md, greeter) -> do
                greeter "Hi there"
                unload md
        Left errors -> print errors

    BS.writeFile "Test.hs" (BSC.pack testCaseIncorrect)

    mkStat2 <- make "Test.hs" []

    case mkStat2 of
        MakeSuccess cd fp -> print fp
        MakeFailure (er1:er2:errs) -> error er2

    loadResult2 <- getModule
    case loadResult2 of
        Right (md, greeter) -> do
                greeter "Hi there"
                unload md
        Left errors -> print errors


    BS.writeFile "Test.hs" (BSC.pack testCaseCorrect)
    mkStat3 <- make "Test.hs" []

    case mkStat3 of
        MakeSuccess cd fp -> print fp
        MakeFailure (er1:er2:errs) -> error er2

    loadResult3 <- getModule
    case loadResult3 of
        Right (md, greeter) -> do
                greeter "Hi there"
                unload md
        Left errors -> print errors

getModule :: IO (Either [String] (Module, String -> IO()))
getModule = do 
               mv <- load "Test.o" ["."] [] "printGreeting"
               case mv of
                    LoadFailure messages -> return (Left messages)
                    LoadSuccess x y -> return (Right (x, y))

此代码产生结果：

"Test.o"
"Hi there"
"Test.o"
["load: couldn't find symbol <<printGreeting>>"]
"Test.o"
["load: couldn't find symbol <<printGreeting>>"]

即它设法复制错误

编辑 2： 似乎在某些完全相同的代码运行中它也会产生输出：

"Test.o"
"Hi there"
"Test.o"
"Hi there"
"Test.o"
"Hi there"

但我认为这可能是因为连续编译一起运行得如此之快。

Answer 1

我使用我的updated version of the plugins library 复制了这个问题，并找出了三个原因。

首先，用于检查模块是否需要重新编译的getModificationTime function精度不足（秒）。

其次，GHC 似乎也犯了同样的错误。

第三，正如唐斯图尔特所说，模块需要卸载，这并不容易，因为 API 没有给你直接引用它。

我通过在符号查找失败时自动卸载模块来解决我的存储库中的第三个问题。修复其他两个的正确方法可能是修补上游。