git.iko.soy/Idris-dev
on master help sign in
Merge pull request #3495 from CarstenKoenig/fix/master/DisableIOBuffering

added a `disableBuffering` action into Prelude.Interactive

commit5cf643e900414dde2e0af71a1c203d172ba7e4fa authorNiklas Larsson <metaniklas@gmail.com> dateFri 21 Oct 2016, 20:46 (10 years ago) parent284b90b1a59ed1
4 files changed+24
compare with master
unifiedsplit
libs/prelude/Prelude/Interactive.idr+10 rts/idris_rts.c+5 rts/idris_rts.h+3 src/Idris/Core/Execute.hs+6
libs/prelude/Prelude/Interactive.idr+10
@@ -89,6 +89,16 @@ putCharLn c = putStrLn (singleton c)
8989getChar : IO Char
9090getChar = map cast $ foreign FFI_C "getchar" (IO Int)
9191
92+||| Disables buffering in both stdin and stdout:
93+||| so that output is written immediately (never stored in the buffer)
94+||| and the next input item is read and returned
95+|||
96+||| this is useful to circumvent problems with IO on some Windows systems
97+||| where stdout output right before a prompt is only shown after
98+||| the input-line from stdin is produced
99+disableBuffering : IO ()
100+disableBuffering = foreign FFI_C "idris_disableBuffering" (IO ())
101+
92102||| Get the command-line arguments that the program was called with.
93103partial
94104getArgs : IO (List String)
rts/idris_rts.c+5
@@ -1077,6 +1077,11 @@ const char* idris_getArg(int i) {
10771077 return __idris_argv[i];
10781078}
10791079
1080+void idris_disableBuffering() {
1081+ setvbuf(stdin, NULL, _IONBF, 0);
1082+ setvbuf(stdout, NULL, _IONBF, 0);
1083+}
1084+
10801085void stackOverflow() {
10811086 fprintf(stderr, "Stack overflow");
10821087 exit(-1);
rts/idris_rts.h+3
@@ -394,6 +394,9 @@ extern char **__idris_argv;
394394int idris_numArgs();
395395const char *idris_getArg(int i);
396396
397+// disable stdin/stdout buffering
398+void idris_disableBuffering();
399+
397400// Handle stack overflow.
398401// Just reports an error and exits.
399402
src/Idris/Core/Execute.hs+6
@@ -398,6 +398,12 @@ execForeign env ctxt arity ty fn xs onfail
398398 show ptr ++
399399 ". Are all cases covered?"
400400
401+ | Just (FFun "idris_disableBuffering" _ _) <- foreignFromTT arity ty fn xs
402+ = do execIO $ hSetBuffering stdin NoBuffering
403+ execIO $ hSetBuffering stdout NoBuffering
404+ execApp env ctxt ioUnit (drop arity xs)
405+
406+
401407-- Right now, there's no way to send command-line arguments to the executor,
402408-- so just return 0.
403409execForeign env ctxt arity ty fn xs onfail