git.iko.soy/Idris-dev
on master help sign in
Better emulation of C in executor wrt file handles
dff861eDavid Raymond Christiansen
src/Idris/Core/Execute.hs+28−12
compare with master
unifiedsplit
@@ -17,6 +17,7 @@ import Util.DynamicLinker
17import Util.System
17import Util.System
18
18
19import Control.Applicative hiding (Const)
19import Control.Applicative hiding (Const)
20+import Control.Exception
20import Control.Monad.Trans
21import Control.Monad.Trans
21import Control.Monad.Trans.State.Strict
22import Control.Monad.Trans.State.Strict
22import Control.Monad.Trans.Error
23import Control.Monad.Trans.Error
@@ -247,7 +248,7 @@ execApp' env ctxt (EP _ fp _) args@(_:_:v:k:rest)
247 do v'' <- tryForce v'
248 do v'' <- tryForce v'
248 res <- execApp' env ctxt k [v''] >>= tryForce
249 res <- execApp' env ctxt k [v''] >>= tryForce
249 execApp' env ctxt res rest
250 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)
251 | fp == pioret =
252 | fp == pioret =
252 do v' <- tryForce v
253 do v' <- tryForce v
253 execApp' env ctxt (mkEApp con [tp, v']) rest
254 execApp' env ctxt (mkEApp con [tp, v']) rest
@@ -266,16 +267,23 @@ execApp' env ctxt (EP _ fp _) (_:fn:_:EHandle h:_:rest)
266execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str f):EConstant (Str mode):rest)
267execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str f):EConstant (Str mode):rest)
267 | fp == mkfprim,
268 | fp == mkfprim,
268 Just (FFun "fileOpen" _ _) <- foreignFromTT fn
269 Just (FFun "fileOpen" _ _) <- foreignFromTT fn
270+ = do f <- execIO $
269− = do m <- case mode of
271+ catch (do let m = case mode of
270− "r" -> return ReadMode
272+ "r" -> Right ReadMode
271− "w" -> return WriteMode
273+ "w" -> Right WriteMode
272− "a" -> return AppendMode
274+ "a" -> Right AppendMode
273− "rw" -> return ReadWriteMode
275+ "rw" -> Right ReadWriteMode
274− "wr" -> return ReadWriteMode
276+ "wr" -> Right ReadWriteMode
275− "r+" -> return ReadWriteMode
277+ "r+" -> Right ReadWriteMode
276− _ -> execFail ("Invalid mode for " ++ f ++ ": " ++ mode)
278+ _ -> Left ("Invalid mode for " ++ f ++ ": " ++ mode)
277− h <- execIO $ openFile f m
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
278− execApp' env ctxt (ioWrap (EHandle h)) (tail rest)
286+ Right (res, rest) -> execApp' env ctxt res rest
279
287
280execApp' env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)
288execApp' env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)
281 | fp == mkfprim,
289 | fp == mkfprim,
@@ -295,7 +303,15 @@ execApp' env ctxt (EP _ fp _) (_:fn:(EPtr p):rest)
295 Just (FFun "isNull" _ _) <- foreignFromTT fn
303 Just (FFun "isNull" _ _) <- foreignFromTT fn
296 = let res = ioWrap . EConstant . I $
304 = let res = ioWrap . EConstant . I $
297 if p == nullPtr then 1 else 0
305 if p == nullPtr then 1 else 0
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
298− in execApp' env ctxt res (tail rest)
314+ in execApp' env ctxt res (tail rest)
299
315
300-- A foreign-returned char* has to be tested for NULL sometimes
316-- A foreign-returned char* has to be tested for NULL sometimes
301execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str s):rest)
317execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str s):rest)