comparison src/main.mlton.sml @ 1744:6fcce0592178

Send daemon output to calling process
author Adam Chlipala <adam@chlipala.net>
date Sat, 05 May 2012 12:45:35 -0400
parents c414850f206f
children 518e0b23c4ef
comparison
equal deleted inserted replaced
1743:1e940643a5f0 1744:6fcce0592178
39 val demo = ref (NONE : (string * bool) option) 39 val demo = ref (NONE : (string * bool) option)
40 val tutorial = ref false 40 val tutorial = ref false
41 val css = ref false 41 val css = ref false
42 42
43 val () = (Compiler.debug := false; 43 val () = (Compiler.debug := false;
44 Elaborate.verbose := false;
44 Elaborate.dumpTypes := false; 45 Elaborate.dumpTypes := false;
45 Elaborate.unifyMore := false; 46 Elaborate.unifyMore := false;
46 Compiler.dumpSource := false; 47 Compiler.dumpSource := false;
47 Compiler.doIflow := false; 48 Compiler.doIflow := false;
48 Demo.noEmacs := false; 49 Demo.noEmacs := false;
89 | "-debug" :: rest => 90 | "-debug" :: rest =>
90 (Settings.setDebug true; 91 (Settings.setDebug true;
91 doArgs rest) 92 doArgs rest)
92 | "-verbose" :: rest => 93 | "-verbose" :: rest =>
93 (Compiler.debug := true; 94 (Compiler.debug := true;
95 Elaborate.verbose := true;
94 doArgs rest) 96 doArgs rest)
95 | "-timing" :: rest => 97 | "-timing" :: rest =>
96 (timing := true; 98 (timing := true;
97 doArgs rest) 99 doArgs rest)
98 | "-tc" :: rest => 100 | "-tc" :: rest =>
241 let 243 let
242 val cmd = Substring.string befor 244 val cmd = Substring.string befor
243 val rest = Substring.string (Substring.slice (after, 1, NONE)) 245 val rest = Substring.string (Substring.slice (after, 1, NONE))
244 in 246 in
245 case cmd of 247 case cmd of
246 "" => send (sock, if OS.Process.isSuccess ((oneRun (rev args)) 248 "" =>
247 handle ex => (print "unhandled exception:\n"; 249 let
248 print (General.exnMessage ex ^ "\n"); 250 val success = (oneRun (rev args))
249 OS.Process.failure)) then 251 handle ex => (print "unhandled exception:\n";
250 "0" 252 print (General.exnMessage ex ^ "\n");
251 else 253 OS.Process.failure)
252 "1") 254 in
255 TextIO.flushOut TextIO.stdOut;
256 TextIO.flushOut TextIO.stdErr;
257 send (sock, if OS.Process.isSuccess success then
258 "\001"
259 else
260 "\002")
261 end
253 | _ => loop' (rest, cmd :: args) 262 | _ => loop' (rest, cmd :: args)
254 end 263 end
255 end handle OS.SysErr _ => () 264 end handle OS.SysErr _ => ()
265
266 fun redirect old =
267 Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)),
268 new = old}
269
270 val oldStdout = Posix.IO.dup Posix.FileSys.stdout
271 val oldStderr = Posix.IO.dup Posix.FileSys.stderr
256 in 272 in
273 (* Redirect the daemon's output to the socket. *)
274 redirect Posix.FileSys.stdout;
275 redirect Posix.FileSys.stderr;
276
257 loop' ("", []); 277 loop' ("", []);
258 Socket.close sock; 278 Socket.close sock;
279
280 Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout};
281 Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr};
282 Posix.IO.close oldStdout;
283 Posix.IO.close oldStderr;
284
259 MLton.GC.pack (); 285 MLton.GC.pack ();
260 loop () 286 loop ()
261 end 287 end
262 in 288 in
263 OS.Process.atExit (fn () => OS.FileSys.remove socket); 289 OS.Process.atExit (fn () => OS.FileSys.remove socket);
270 let 296 let
271 val sock = UnixSock.Strm.socket () 297 val sock = UnixSock.Strm.socket ()
272 298
273 fun wait () = 299 fun wait () =
274 let 300 let
275 val v = Socket.recvVec (sock, 1) 301 val v = Socket.recvVec (sock, 1024)
276 in 302 in
277 if Vector.length v = 0 then 303 if Vector.length v = 0 then
278 OS.Process.failure 304 OS.Process.failure
279 else 305 else
280 case chr (Word8.toInt (Vector.sub (v, 0))) of 306 let
281 #"0" => OS.Process.success 307 val s = Vector.map (chr o Word8.toInt) v
282 | #"1" => OS.Process.failure 308 val last = Vector.sub (v, Vector.length v - 1)
283 | _ => raise Fail "Weird return code from daemon" 309 val (rc, s) = if last = Word8.fromInt 1 then
310 (SOME OS.Process.success, String.substring (s, 0, size s - 1))
311 else if last = Word8.fromInt 2 then
312 (SOME OS.Process.failure, String.substring (s, 0, size s - 1))
313 else
314 (NONE, s)
315 in
316 print s;
317 case rc of
318 NONE => wait ()
319 | SOME rc => rc
320 end
284 end handle OS.SysErr _ => OS.Process.failure 321 end handle OS.SysErr _ => OS.Process.failure
285 in 322 in
286 if Socket.connectNB (sock, UnixSock.toAddr socket) 323 if Socket.connectNB (sock, UnixSock.toAddr socket)
287 orelse not (List.null (#wrs (Socket.select {rds = [], 324 orelse not (List.null (#wrs (Socket.select {rds = [],
288 wrs = [Socket.sockDesc sock], 325 wrs = [Socket.sockDesc sock],