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

我使用更新版本的插件库复制了该问题，并隔离了三个原因。

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

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

第三，正如 Don Stewart 所说，模块需要卸载，这并不容易完成，因为 API 不提供对它的直接引用。

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