17

我有以下代码:

{-# LANGUAGE DeriveDataTypeable #-}
import Prelude hiding (catch)
import Control.Exception (throwIO, Exception)
import Control.Monad (when)
import Data.Maybe
import Data.Word (Word16)
import Data.Typeable (Typeable)
import System.Environment (getArgs)

data ArgumentParserException = WrongArgumentCount | InvalidPortNumber
    deriving (Show, Typeable)

instance Exception ArgumentParserException

data Arguments = Arguments Word16 FilePath String

main = do
    args <- return []
    when (length args /= 3) (throwIO WrongArgumentCount)

    let [portStr, cert, pw] = args
    let portInt = readMaybe portStr :: Maybe Integer
    when (portInt == Nothing) (throwIO InvalidPortNumber)

    let portNum = fromJust portInt
    when (portNum < 0 || portNum > 65535) (throwIO InvalidPortNumber)

    return $ Arguments (fromInteger portNum) cert pw

-- Newer 'base' has Text.Read.readMaybe but alas, that doesn't come with
-- the latest Haskell platform, so let's not rely on it
readMaybe :: Read a => String -> Maybe a
readMaybe s = case reads s of
    [(x, "")] -> Just x
    _         -> Nothing

在打开和关闭优化的情况下编译时,它的行为会有所不同:

crabgrass:~/tmp/signserv/src% ghc -fforce-recomp Main.hs && ./Main
Main: WrongArgumentCount
crabgrass:~/tmp/signserv/src% ghc -O -fforce-recomp Main.hs && ./Main
Main: Main.hs:20:9-34: Irrefutable pattern failed for pattern [portStr, cert, pw]

为什么是这样?我知道可以任意选择不精确的异常;但是这里我们从一个精确和一个不精确的例外中进行选择,因此不应该适用警告。

4

1 回答 1

14

我同意 hammar,这看起来像一个错误。一段时间以来,它似乎固定在 HEAD 中。对于旧ghc-7.7.20130312的以及今天的 HEAD ghc-7.7.20130521WrongArgumentCount会引发异常并main删除所有其他代码(欺负优化器)。但是,在 7.6.3 中仍然存在问题。

7.2 系列的行为发生了变化,我WrongArgumentCount从 7.0.4 中得到了预期,并且(优化的)核心清楚地表明了这一点:

Main.main1 =
  \ (s_a11H :: GHC.Prim.State# GHC.Prim.RealWorld) ->
    case GHC.List.$wlen
           @ GHC.Base.String (GHC.Types.[] @ GHC.Base.String) 0
    of _ {
      __DEFAULT ->
        case GHC.Prim.raiseIO#
               @ GHC.Exception.SomeException @ () Main.main7 s_a11H
        of _ { (# new_s_a11K, _ #) ->
        Main.main2 new_s_a11K
        };
      3 -> Main.main2 s_a11H
    }

当空列表的长度不同于 3 时, raise WrongArgumentCount,否则尝试做剩下的。

在 7.2 及更高版本中,长度的评估移到解析之后portStr

Main.main1 =
  \ (eta_Xw :: GHC.Prim.State# GHC.Prim.RealWorld) ->
    case Main.main7 of _ {
      [] -> case Data.Maybe.fromJust1 of wild1_00 { };
      : ds_dTy ds1_dTz ->
        case ds_dTy of _ { (x_aOz, ds2_dTA) ->
        case ds2_dTA of _ {
          [] ->
            case ds1_dTz of _ {
              [] ->
                case GHC.List.$wlen
                       @ [GHC.Types.Char] (GHC.Types.[] @ [GHC.Types.Char]) 0
                of _ {
                  __DEFAULT ->
                    case GHC.Prim.raiseIO#
                           @ GHC.Exception.SomeException @ () Main.main6 eta_Xw
                    of wild4_00 {
                    };
                  3 ->

在哪里

Main.main7 =
  Text.ParserCombinators.ReadP.run
    @ GHC.Integer.Type.Integer Main.main8 Main.main3

Main.main8 =
  GHC.Read.$fReadInteger5
    GHC.Read.$fReadInteger_$sconvertInt
    Text.ParserCombinators.ReadPrec.minPrec
    @ GHC.Integer.Type.Integer
    (Text.ParserCombinators.ReadP.$fMonadP_$creturn
       @ GHC.Integer.Type.Integer)

Main.main3 = case lvl_r1YS of wild_00 { }

lvl_r1YS =
  Control.Exception.Base.irrefutPatError
    @ ([GHC.Types.Char], [GHC.Types.Char], [GHC.Types.Char])
    "Except.hs:21:9-34|[portStr, cert, pw]"

由于throwIO应该尊重IO行动的顺序,

throwIO变体应该优先使用 throw 以在 monad 中引发异常,因为IO它保证相对于其他IO操作的顺序,而 throw 不保证。

那不应该发生。

您可以通过使用 的NOINLINE变体when或在抛出之前执行有效的IO操作来强制正确排序,因此当内联器看到when除了可能抛出之外什么都不做时,它认为顺序无关紧要。

(抱歉,这不是一个真正的答案,但请尝试将其放入评论中;)

于 2013-05-21T21:20:31.797 回答