summaryrefslogtreecommitdiff
path: root/src/main.mlton.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/main.mlton.sml')
-rw-r--r--src/main.mlton.sml61
1 files changed, 49 insertions, 12 deletions
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 9cc82da0..4e1f8e2c 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -41,6 +41,7 @@ fun oneRun args =
val css = ref false
val () = (Compiler.debug := false;
+ Elaborate.verbose := false;
Elaborate.dumpTypes := false;
Elaborate.unifyMore := false;
Compiler.dumpSource := false;
@@ -91,6 +92,7 @@ fun oneRun args =
doArgs rest)
| "-verbose" :: rest =>
(Compiler.debug := true;
+ Elaborate.verbose := true;
doArgs rest)
| "-timing" :: rest =>
(timing := true;
@@ -243,19 +245,43 @@ val () = case CommandLine.arguments () of
val rest = Substring.string (Substring.slice (after, 1, NONE))
in
case cmd of
- "" => send (sock, if OS.Process.isSuccess ((oneRun (rev args))
- handle ex => (print "unhandled exception:\n";
- print (General.exnMessage ex ^ "\n");
- OS.Process.failure)) then
- "0"
- else
- "1")
+ "" =>
+ let
+ val success = (oneRun (rev args))
+ handle ex => (print "unhandled exception:\n";
+ print (General.exnMessage ex ^ "\n");
+ OS.Process.failure)
+ in
+ TextIO.flushOut TextIO.stdOut;
+ TextIO.flushOut TextIO.stdErr;
+ send (sock, if OS.Process.isSuccess success then
+ "\001"
+ else
+ "\002")
+ end
| _ => loop' (rest, cmd :: args)
end
end handle OS.SysErr _ => ()
+
+ fun redirect old =
+ Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)),
+ new = old}
+
+ val oldStdout = Posix.IO.dup Posix.FileSys.stdout
+ val oldStderr = Posix.IO.dup Posix.FileSys.stderr
in
+ (* Redirect the daemon's output to the socket. *)
+ redirect Posix.FileSys.stdout;
+ redirect Posix.FileSys.stderr;
+
loop' ("", []);
Socket.close sock;
+
+ Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout};
+ Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr};
+ Posix.IO.close oldStdout;
+ Posix.IO.close oldStderr;
+
MLton.GC.pack ();
loop ()
end
@@ -272,15 +298,26 @@ val () = case CommandLine.arguments () of
fun wait () =
let
- val v = Socket.recvVec (sock, 1)
+ val v = Socket.recvVec (sock, 1024)
in
if Vector.length v = 0 then
OS.Process.failure
else
- case chr (Word8.toInt (Vector.sub (v, 0))) of
- #"0" => OS.Process.success
- | #"1" => OS.Process.failure
- | _ => raise Fail "Weird return code from daemon"
+ let
+ val s = Vector.map (chr o Word8.toInt) v
+ val last = Vector.sub (v, Vector.length v - 1)
+ val (rc, s) = if last = Word8.fromInt 1 then
+ (SOME OS.Process.success, String.substring (s, 0, size s - 1))
+ else if last = Word8.fromInt 2 then
+ (SOME OS.Process.failure, String.substring (s, 0, size s - 1))
+ else
+ (NONE, s)
+ in
+ print s;
+ case rc of
+ NONE => wait ()
+ | SOME rc => rc
+ end
end handle OS.SysErr _ => OS.Process.failure
in
if Socket.connectNB (sock, UnixSock.toAddr socket)