@@ -17,6 +17,7 @@ import Util.DynamicLinker
1717import Util.System
1818
1919import Control.Applicative hiding (Const)
20+import Control.Exception
2021import Control.Monad.Trans
2122import Control.Monad.Trans.State.Strict
2223import Control.Monad.Trans.Error
@@ -247,7 +248,7 @@ execApp' env ctxt (EP _ fp _) args@(_:_:v:k:rest)
247248 do v'' <- tryForce v'
248249 res <- execApp' env ctxt k [v''] >>= tryForce
249250 execApp' env ctxt res rest
250−execApp' env ctxt con@(EP _ fp _) args@(tp:v:rest)
251+execApp' env ctxt con@(EP _ fp _) args@(tp:v:rest)
251252 | fp == pioret =
252253 do v' <- tryForce v
253254 execApp' env ctxt (mkEApp con [tp, v']) rest
@@ -266,16 +267,23 @@ execApp' env ctxt (EP _ fp _) (_:fn:_:EHandle h:_:rest)
266267execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str f):EConstant (Str mode):rest)
267268 | fp == mkfprim,
268269 Just (FFun "fileOpen" _ _) <- foreignFromTT fn
269− = do m <- case mode of
270− "r" -> return ReadMode
271− "w" -> return WriteMode
272− "a" -> return AppendMode
273− "rw" -> return ReadWriteMode
274− "wr" -> return ReadWriteMode
275− "r+" -> return ReadWriteMode
276− _ -> execFail ("Invalid mode for " ++ f ++ ": " ++ mode)
277− h <- execIO $ openFile f m
278− execApp' env ctxt (ioWrap (EHandle h)) (tail rest)
270+ = do f <- execIO $
271+ catch (do let m = case mode of
272+ "r" -> Right ReadMode
273+ "w" -> Right WriteMode
274+ "a" -> Right AppendMode
275+ "rw" -> Right ReadWriteMode
276+ "wr" -> Right ReadWriteMode
277+ "r+" -> Right ReadWriteMode
278+ _ -> Left ("Invalid mode for " ++ f ++ ": " ++ mode)
279+ case fmap (openFile f) m of
280+ Right h -> do h' <- h; return $ Right (ioWrap (EHandle h'), tail rest)
281+ Left err -> return $ Left err)
282+ (\e -> let _ = ( e::SomeException)
283+ in return $ Right (ioWrap (EPtr nullPtr), tail rest))
284+ case f of
285+ Left err -> execFail err
286+ Right (res, rest) -> execApp' env ctxt res rest
279287
280288execApp' env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)
281289 | fp == mkfprim,
@@ -295,7 +303,15 @@ execApp' env ctxt (EP _ fp _) (_:fn:(EPtr p):rest)
295303 Just (FFun "isNull" _ _) <- foreignFromTT fn
296304 = let res = ioWrap . EConstant . I $
297305 if p == nullPtr then 1 else 0
298− in execApp' env ctxt res (tail rest)
306+ in execApp' env ctxt res (tail rest)
307+
308+-- Handles will be checked as null pointers sometimes - but if we got a
309+-- real Handle, then it's valid, so just return 1.
310+execApp' env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)
311+ | fp == mkfprim,
312+ Just (FFun "isNull" _ _) <- foreignFromTT fn
313+ = let res = ioWrap . EConstant . I $ 0
314+ in execApp' env ctxt res (tail rest)
299315
300316-- A foreign-returned char* has to be tested for NULL sometimes
301317execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str s):rest)