Mercurial > urweb
changeset 1744:6fcce0592178
Send daemon output to calling process
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 05 May 2012 12:45:35 -0400 |
| parents | 1e940643a5f0 |
| children | 518e0b23c4ef |
| files | src/elaborate.sig src/elaborate.sml src/main.mlton.sml |
| diffstat | 3 files changed, 55 insertions(+), 13 deletions(-) [+] |
line wrap: on
line diff
--- a/src/elaborate.sig Fri May 04 10:38:22 2012 -0400 +++ b/src/elaborate.sig Sat May 05 12:45:35 2012 -0400 @@ -42,5 +42,6 @@ * early phase. *) val incremental : bool ref + val verbose : bool ref end
--- a/src/elaborate.sml Fri May 04 10:38:22 2012 -0400 +++ b/src/elaborate.sml Sat May 05 12:45:35 2012 -0400 @@ -41,6 +41,7 @@ val dumpTypes = ref false val unifyMore = ref false val incremental = ref false + val verbose = ref false structure IS = IntBinarySet structure IM = IntBinaryMap @@ -3931,6 +3932,7 @@ (case ModDb.lookup dAll of SOME d => let + val () = if !verbose then TextIO.print ("REUSE: " ^ x ^ "\n") else () val env' = E.declBinds env d val denv' = dopenConstraints (loc, env', denv) {str = x, strs = []} in @@ -3938,6 +3940,8 @@ end | NONE => let + val () = if !verbose then TextIO.print ("CHECK: " ^ x ^ "\n") else () + val () = if x = "Basis" then raise Fail "Not allowed to redefine structure 'Basis'" else @@ -4680,7 +4684,7 @@ val c = normClassKey env c in case resolveClass env c of - SOME _ => raise Fail "Type class resolution succeeded unexpectedly" + SOME _ => () | NONE => expError env (Unresolvable (loc, c)) end) gs)
--- a/src/main.mlton.sml Fri May 04 10:38:22 2012 -0400 +++ b/src/main.mlton.sml Sat May 05 12:45:35 2012 -0400 @@ -41,6 +41,7 @@ val css = ref false val () = (Compiler.debug := false; + Elaborate.verbose := false; Elaborate.dumpTypes := false; Elaborate.unifyMore := false; Compiler.dumpSource := false; @@ -91,6 +92,7 @@ doArgs rest) | "-verbose" :: rest => (Compiler.debug := true; + Elaborate.verbose := true; doArgs rest) | "-timing" :: rest => (timing := true; @@ -243,19 +245,43 @@ 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 @@ 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)