3ac21cb · Idris-dev · git.iko.soy

218 | fp == pioret = execApp env ctxt (mkEApp con [tp, v]) rest

219

220-- Special cases arising from not having access to the C RTS in the interpreter

221−execApp env ctxt (EP _ fp _) (_:fn:EConstant (Str arg):_:rest)

221+execApp env ctxt (EP _ fp _) (_:fn:str:_:rest)

222 | fp == mkfprim,

223 Just (FFun "putStr" _ _) <- foreignFromTT fn

224+ = case str of

224− = do execIO (putStr arg)

225+ EConstant (Str arg) -> do execIO (putStr arg)

225− execApp env ctxt ioUnit rest

226+ execApp env ctxt ioUnit rest

227+ _ -> execFail . Msg $

228+ "The argument to putStr should be a constant string, but it was " ++

229+ show str ++

230+ ". Are all cases covered?"

226−execApp env ctxt (EP _ fp _) (_:fn:_:EHandle h:_:rest)

231+execApp env ctxt (EP _ fp _) (_:fn:_:handle:_:rest)

227 | fp == mkfprim,

232 | fp == mkfprim,

228 Just (FFun "idris_readStr" _ _) <- foreignFromTT fn

233 Just (FFun "idris_readStr" _ _) <- foreignFromTT fn

234+ = case handle of

229− = do contents <- execIO $ hGetLine h

235+ EHandle h -> do contents <- execIO $ hGetLine h

230− execApp env ctxt (EConstant (Str (contents ++ "\n"))) rest

236+ execApp env ctxt (EConstant (Str (contents ++ "\n"))) rest

237+ _ -> execFail . Msg $

238+ "The argument to idris_readStr should be a handle, but it was " ++

239+ show handle ++

240+ ". Are all cases covered?"

231−execApp env ctxt (EP _ fp _) (_:fn:EConstant (Str f):EConstant (Str mode):rest)

241+execApp env ctxt (EP _ fp _) (_:fn:fileStr:modeStr:rest)

232 | fp == mkfprim,

242 | fp == mkfprim,

233 Just (FFun "fileOpen" _ _) <- foreignFromTT fn

243 Just (FFun "fileOpen" _ _) <- foreignFromTT fn

244+ = case (fileStr, modeStr) of

245+ (EConstant (Str f), EConstant (Str mode)) ->

234− = do f <- execIO $

246+ do f <- execIO $

235− catch (do let m = case mode of

247+ catch (do let m = case mode of

236− "r" -> Right ReadMode

248+ "r" -> Right ReadMode

237− "w" -> Right WriteMode

249+ "w" -> Right WriteMode

238− "a" -> Right AppendMode

250+ "a" -> Right AppendMode

239− "rw" -> Right ReadWriteMode

251+ "rw" -> Right ReadWriteMode

240− "wr" -> Right ReadWriteMode

252+ "wr" -> Right ReadWriteMode

241− "r+" -> Right ReadWriteMode

253+ "r+" -> Right ReadWriteMode

242− _ -> Left ("Invalid mode for " ++ f ++ ": " ++ mode)

254+ _ -> Left ("Invalid mode for " ++ f ++ ": " ++ mode)

243− case fmap (openFile f) m of

255+ case fmap (openFile f) m of

244− Right h -> do h' <- h; return $ Right (ioWrap (EHandle h'), tail rest)

256+ Right h -> do h' <- h; return $ Right (ioWrap (EHandle h'), tail rest)

245− Left err -> return $ Left err)

257+ Left err -> return $ Left err)

246− (\e -> let _ = ( e::SomeException)

258+ (\e -> let _ = ( e::SomeException)

247− in return $ Right (ioWrap (EPtr nullPtr), tail rest))

259+ in return $ Right (ioWrap (EPtr nullPtr), tail rest))

248− case f of

260+ case f of

249− Left err -> execFail . Msg $ err

261+ Left err -> execFail . Msg $ err

250− Right (res, rest) -> execApp env ctxt res rest

262+ Right (res, rest) -> execApp env ctxt res rest

251−

263+ _ -> execFail . Msg $

264+ "The arguments to fileOpen should be constant strings, but they were " ++

265+ show fileStr ++ " and " ++ show modeStr ++

266+ ". Are all cases covered?"

267+

252−execApp env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)

268+execApp env ctxt (EP _ fp _) (_:fn:handle:rest)

253 | fp == mkfprim,

269 | fp == mkfprim,

254 Just (FFun "fileEOF" _ _) <- foreignFromTT fn

270 Just (FFun "fileEOF" _ _) <- foreignFromTT fn

271+ = case handle of

255− = do eofp <- execIO $ hIsEOF h

272+ EHandle h -> do eofp <- execIO $ hIsEOF h

256− let res = ioWrap (EConstant (I $ if eofp then 1 else 0))

273+ let res = ioWrap (EConstant (I $ if eofp then 1 else 0))

257− execApp env ctxt res (tail rest)

274+ execApp env ctxt res (tail rest)

258−

275+ _ -> execFail . Msg $

276+ "The argument to fileEOF should be a file handle, but it was " ++

277+ show handle ++

278+ ". Are all cases covered?"

279+

259−execApp env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)

280+execApp env ctxt (EP _ fp _) (_:fn:handle:rest)

260 | fp == mkfprim,

281 | fp == mkfprim,

261 Just (FFun "fileClose" _ _) <- foreignFromTT fn

282 Just (FFun "fileClose" _ _) <- foreignFromTT fn

283+ = case handle of

262− = do execIO $ hClose h

284+ EHandle h -> do execIO $ hClose h

263− execApp env ctxt ioUnit (tail rest)

285+ execApp env ctxt ioUnit (tail rest)

264−

286+ _ -> execFail . Msg $

287+ "The argument to fileClose should be a file handle, but it was " ++

288+ show handle ++

289+ ". Are all cases covered?"

290+

265−execApp env ctxt (EP _ fp _) (_:fn:(EPtr p):rest)

291+execApp env ctxt (EP _ fp _) (_:fn:ptr:rest)

266 | fp == mkfprim,

292 | fp == mkfprim,

267 Just (FFun "isNull" _ _) <- foreignFromTT fn

293 Just (FFun "isNull" _ _) <- foreignFromTT fn

294+ = case ptr of

268− = let res = ioWrap . EConstant . I $

295+ EPtr p -> let res = ioWrap . EConstant . I $

269− if p == nullPtr then 1 else 0

296+ if p == nullPtr then 1 else 0

297+ in execApp env ctxt res (tail rest)

298+ -- Handles will be checked as null pointers sometimes - but if we got a

299+ -- real Handle, then it's valid, so just return 1.

300+ EHandle h -> let res = ioWrap . EConstant . I $ 0

301+ in execApp env ctxt res (tail rest)

302+ -- A foreign-returned char* has to be tested for NULL sometimes

303+ EConstant (Str s) -> let res = ioWrap . EConstant . I $ 0

270− in execApp env ctxt res (tail rest)

304+ in execApp env ctxt res (tail rest)

305+ _ -> execFail . Msg $

306+ "The argument to isNull should be a pointer or file handle or string, but it was " ++

307+ show ptr ++

308+ ". Are all cases covered?"

271

309

272−-- Handles will be checked as null pointers sometimes - but if we got a

273−-- real Handle, then it's valid, so just return 1.

274−execApp env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)

275− | fp == mkfprim,

276− Just (FFun "isNull" _ _) <- foreignFromTT fn

277− = let res = ioWrap . EConstant . I $ 0

278− in execApp env ctxt res (tail rest)

279−

280−-- A foreign-returned char* has to be tested for NULL sometimes

281−execApp env ctxt (EP _ fp _) (_:fn:EConstant (Str s):rest)

282− | fp == mkfprim,

283− Just (FFun "isNull" _ _) <- foreignFromTT fn

284− = let res = ioWrap . EConstant . I $ 0

285− in execApp env ctxt res (tail rest)

286

310

287-- Right now, there's no way to send command-line arguments to the executor,

311-- Right now, there's no way to send command-line arguments to the executor,

288-- so just return 0.

312-- so just return 0.

291 Just (FFun "idris_numArgs" _ _) <- foreignFromTT fn

315 Just (FFun "idris_numArgs" _ _) <- foreignFromTT fn

292 = let res = ioWrap . EConstant . I $ 0

316 = let res = ioWrap . EConstant . I $ 0

293 in execApp env ctxt res (tail rest)

317 in execApp env ctxt res (tail rest)

294−-- Throw away the 'World' argument to the foreign function

295

318

296execApp env ctxt f@(EP _ fp _) args@(ty:fn:xs) | fp == mkfprim

319execApp env ctxt f@(EP _ fp _) args@(ty:fn:xs) | fp == mkfprim

297 = case foreignFromTT fn of

320 = case foreignFromTT fn of