5cf643e · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #3495 from CarstenKoenig/fix/master/DisableIOBuffering

5cf643eNiklas Larsson10 years ago

libs/prelude/Prelude/Interactive.idr+10

compare with master

unifiedsplit

@@ -89,6 +89,16 @@ putCharLn c = putStrLn (singleton c)

89getChar : IO Char

90getChar = map cast $ foreign FFI_C "getchar" (IO Int)

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+

92||| Get the command-line arguments that the program was called with.

102||| Get the command-line arguments that the program was called with.

93partial

103partial

94getArgs : IO (List String)

104getArgs : IO (List String)

rts/idris_rts.c+5

@@ -1077,6 +1077,11 @@ const char* idris_getArg(int i) {

1077 return __idris_argv[i];

1078}

1079

1080+void idris_disableBuffering() {

1081+ setvbuf(stdin, NULL, _IONBF, 0);

1082+ setvbuf(stdout, NULL, _IONBF, 0);

1083+}

1084+

1080void stackOverflow() {

1085void stackOverflow() {

1081 fprintf(stderr, "Stack overflow");

1086 fprintf(stderr, "Stack overflow");

1082 exit(-1);

1087 exit(-1);

rts/idris_rts.h+3

@@ -394,6 +394,9 @@ extern char **__idris_argv;

394int idris_numArgs();

395const char *idris_getArg(int i);

396

397+// disable stdin/stdout buffering

398+void idris_disableBuffering();

399+

397// Handle stack overflow.

400// Handle stack overflow.

398// Just reports an error and exits.

401// Just reports an error and exits.

399

402

src/Idris/Core/Execute.hs+6

@@ -398,6 +398,12 @@ execForeign env ctxt arity ty fn xs onfail

398 show ptr ++

399 ". Are all cases covered?"

400

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+

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

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

402-- so just return 0.

408-- so just return 0.

403execForeign env ctxt arity ty fn xs onfail

409execForeign env ctxt arity ty fn xs onfail