on master help sign in
Make executor emulate putchar
6250eb4David Raymond Christiansen
src/Idris/Core/Execute.hs+13−1
@@ -220,7 +220,7 @@ execApp env ctxt con@(EP _ fp _) args@(tp:v:rest)
220-- Special cases arising from not having access to the C RTS in the interpreter
220-- Special cases arising from not having access to the C RTS in the interpreter
221execApp env ctxt (EP _ fp _) (_:fn:str:_:rest)
221execApp env ctxt (EP _ fp _) (_:fn:str:_:rest)
222 | fp == mkfprim,
222 | fp == mkfprim,
223− Just (FFun "putStr" _ _) <- foreignFromTT fn
223+ Just (FFun "putStr" _ _) <- foreignFromTT fn
224 = case str of
224 = case str of
225 EConstant (Str arg) -> do execIO (putStr arg)
225 EConstant (Str arg) -> do execIO (putStr arg)
226 execApp env ctxt ioUnit rest
226 execApp env ctxt ioUnit rest
@@ -228,6 +228,18 @@ execApp env ctxt (EP _ fp _) (_:fn:str:_:rest)
228 "The argument to putStr should be a constant string, but it was " ++
228 "The argument to putStr should be a constant string, but it was " ++
229 show str ++
229 show str ++
230 ". Are all cases covered?"
230 ". Are all cases covered?"
231+execApp env ctxt (EP _ fp _) (_:fn:ch:_:rest)
232+ | fp == mkfprim,
233+ Just (FFun "putchar" _ _) <- foreignFromTT fn
234+ = case ch of
235+ EConstant (Ch c) -> do execIO (putChar c)
236+ execApp env ctxt ioUnit rest
237+ EConstant (I i) -> do execIO (putChar (toEnum i))
238+ execApp env ctxt ioUnit rest
239+ _ -> execFail . Msg $
240+ "The argument to putchar should be a constant character, but it was " ++
241+ show str ++
242+ ". Are all cases covered?"
231execApp env ctxt (EP _ fp _) (_:fn:_:handle:_:rest)
243execApp env ctxt (EP _ fp _) (_:fn:_:handle:_:rest)
232 | fp == mkfprim,
244 | fp == mkfprim,
233 Just (FFun "idris_readStr" _ _) <- foreignFromTT fn
245 Just (FFun "idris_readStr" _ _) <- foreignFromTT fn