20d4426 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

this command will be translated into a call `hSetBuffering` or `setvbuf`

to disable buffering in stdin/stdout the reason for this is that on windows you sometimes need disable buffering to see the prompt when doing something like this: do putStr "What's your name? " name <- getLine ...

commit20d4426050180dd95514ef385c797078199fa8df authorCarsten König <carsten@gettingsharper.de> dateTue 18 Oct 2016, 21:23 (10 years ago) parent284b90b

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, and never stored in the buffer

94+||| and the next input item is read and returned

95+|||

96+||| this is useful to circumvent problem with IO on some windows system

97+||| where stdout output sometimes is only shown after prompted input from

98+||| stdin

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