Skip to content

Commit

Permalink
Add the Basis-defined Unix module.
Browse files Browse the repository at this point in the history
  • Loading branch information
athas committed Jun 22, 2021
1 parent 5b2058f commit 8c671f3
Show file tree
Hide file tree
Showing 3 changed files with 135 additions and 6 deletions.
File renamed without changes.
128 changes: 128 additions & 0 deletions basis/Unix.sml
Original file line number Diff line number Diff line change
@@ -0,0 +1,128 @@
(* Originally from SML/NJ sources, through MLton. Very slightly
modified for MLKit. *)

structure Unix: UNIX =
struct

structure OSP = OS.Process
structure PP = Posix.Process
structure PPE = Posix.ProcEnv
structure PFS = Posix.FileSys
structure PIO = Posix.IO
structure SS = Substring

type signal = Posix.Signal.signal
datatype exit_status = datatype Posix.Process.exit_status
val fromStatus = Posix.Process.fromStatus

datatype 'a str = FD of PFS.file_desc | STR of 'a * ('a -> unit)
fun close str =
case str of
FD file_desc => PIO.close file_desc
| STR (str, close) => close str

datatype ('a, 'b) proc = PROC of {pid: PP.pid,
status: OSP.status option ref,
ins: 'a str ref,
outs: 'b str ref}

fun executeInEnv (cmd, argv, env) =
let
val p1 = PIO.pipe ()
val p2 = PIO.pipe ()
fun closep () = (PIO.close (#outfd p1);
PIO.close (#infd p1);
PIO.close (#outfd p2);
PIO.close (#infd p2))
val base = SS.string(SS.taker (fn c => c <> #"/") (SS.full cmd))
fun startChild () =
case PP.fork () of
SOME pid => pid (* parent *)
| NONE => let
val oldin = #infd p1
val oldout = #outfd p2
val newin = PFS.stdin
val newout = PFS.stdout
in
PIO.close (#outfd p1);
PIO.close (#infd p2);
if (oldin = newin) then ()
else (PIO.dup2{old = oldin, new = newin};
PIO.close oldin);
if (oldout = newout) then ()
else (PIO.dup2{old = oldout, new = newout};
PIO.close oldout);
PP.exece (cmd, base :: argv, env)
end
(* end case *)
val _ = TextIO.flushOut TextIO.stdOut
val pid = (startChild ()) handle ex => (closep(); raise ex)
in
(* close the child-side fds *)
PIO.close (#outfd p2);
PIO.close (#infd p1);
(* set the fds close on exec *)
PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
PROC {
pid = pid,
status = ref NONE,
ins = ref (FD (#infd p2)),
outs = ref (FD (#outfd p1))
}
end

fun execute (cmd, argv) = executeInEnv (cmd, argv, PPE.environ())

local
fun mkInstreamOf (newIn, closeIn) (PROC {ins, ...}) =
case !ins of
FD file_desc => let val str' = newIn (file_desc, "<process>")
in ins := STR (str', closeIn); str'
end
| STR (str, _) => str
fun mkOutstreamOf (newOut, closeOut) (PROC {outs, pid, ...}) =
case !outs of
FD file_desc => let val str' = newOut (file_desc, "<process>")
in outs := STR (str', closeOut); str'
end
| STR (str, _) => str
in
fun textInstreamOf proc =
mkInstreamOf (TextIO.newIn, TextIO.closeIn) proc
fun textOutstreamOf proc =
mkOutstreamOf (TextIO.newOut, TextIO.closeOut) proc
fun binInstreamOf proc =
mkInstreamOf (BinIO.newIn, BinIO.closeIn) proc
fun binOutstreamOf proc =
mkOutstreamOf (BinIO.newOut, BinIO.closeOut) proc
end
fun streamsOf pr = (textInstreamOf pr, textOutstreamOf pr)

fun reap (PROC{pid, status, ins, outs}) =
case !status of
SOME status => status
| NONE => let
val _ = close (!ins)
val _ = close (!outs)
val (_, st) = PP.waitpid (PP.W_CHILD pid, [])

(* XXX: this function must return an
OS.Process.status, but waitpid returns a
Posix.Process.exit_status. We make the lossy
assumption of turning W_EXITED into a success and
everything else a failure. *)

val st' =
case st of
W_EXITED => OS.Process.success
| _ => OS.Process.failure

in
status := SOME st'; st'
end

fun kill (PROC{pid, ...}, signal) = PP.kill (PP.K_PROC pid, signal)

fun exit st = OSP.exit (Word8.toInt st)
end (* structure Unix *)
13 changes: 7 additions & 6 deletions basis/basis.mlb
Original file line number Diff line number Diff line change
Expand Up @@ -156,11 +156,6 @@ local
bas NET_HOST_DB.sml SOCKET.sml end
end*)

(* basis Unix =
let open Word System Io
in
bas UNIX.sml (*UNIX_SOCK.sml*) end
end*)

basis PrimIO =
let open General System ArrayVector Io Int String Word
Expand Down Expand Up @@ -211,7 +206,13 @@ local
in bas SML90.sml end
end
*)

basis Unix =
let open General Word System Posix IO String
in
bas UNIX.sig Unix.sml (*UNIX_SOCK.sml*) end
end
in
open General List ArrayVector String Bool Word Byte
Int Real IntInf IntInfRep Io System Text Posix IO (* Sml90 *)
Int Real IntInf IntInfRep Io System Text Posix IO Unix (* Sml90 *)
end

0 comments on commit 8c671f3

Please sign in to comment.