How do exceptions work in Haskell (part two)?

Question

I have the following code:

{-# 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

Its behavior differs when compiled with optimizations on and off:

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]

Why is this? I am aware that imprecise exceptions can be chosen from arbitrarily; but here we are choosing from one precise and one imprecise exception, so that caveat should not apply.

Answer 1

I would agree with hammar, this looks like a bug. And it seems fixed in HEAD since some time. With an older ghc-7.7.20130312 as well as with today's HEAD ghc-7.7.20130521, the WrongArgumentCount exception is raised and all the other code of main is removed (bully for the optimiser). Still broken in 7.6.3, however.

The behaviour changed with the 7.2 series, I get the expected WrongArgumentCount from 7.0.4, and the (optimised) core makes that clear:

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
    }

when the length of the empty list is different from 3, raise WrongArgumentCount, otherwise try to do the rest.

With 7.2 and later, the evaluation of the length is moved behind the parsing of 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 ->

where

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]"

Since throwIO is supposed to respect ordering of IO actions,

The throwIO variant should be used in preference to throw to raise an exception within the IO monad because it guarantees ordering with respect to other IO operations, whereas throw does not.

that should not happen.

You can force the correct ordering by using a NOINLINE variant of when, or by performing an effectful IO action before throwing, so it seems that when the inliner sees that the when does nothing except possibly throwing, it decides that order doesn't matter.

(Sorry, not a real answer, but try to fit that in a comment ;)