~james/span

span/cli/driver.ML -rw-r--r--4.3 KiB ViewLogBlameView rawPermalink 20c77b9771 — fix(cli): publish binary output atomically and preserve raw input 12 days ago
1val root = valOf (OS.Process.getEnv "SPAN_ROOT");
2val _ = use (root ^ "/.build/Span.Export/code/span.ML");
3
4fun chars s = map (Span.ascii o IntInf.fromInt o Char.ord) (String.explode s);
5fun text cs = String.implode (map (Char.chr o IntInf.toInt o Span.ordinal) cs);
6
7fun read path =
8 let
9 val fd = if path = "-" then Posix.FileSys.stdin
10 else Posix.FileSys.openf (path, Posix.FileSys.O_RDONLY, Posix.FileSys.O.flags [])
11 fun close () = if path = "-" then () else Posix.IO.close fd
12 fun loop total chunks =
13 let
14 val bytes = Posix.IO.readVec (fd, Int.min (65536, 1048577 - total))
15 val count = Word8Vector.length bytes
16 in
17 if count = 0 then String.concat (List.rev chunks)
18 else if total + count > 1048576 then raise Fail "input exceeds 1 MiB"
19 else loop (total + count) (Byte.bytesToString bytes :: chunks)
20 end
21 val input = loop 0 [] handle exn => ((close () handle _ => ()); raise exn)
22 val _ = close ()
23 in
24 input
25 end;
26
27fun write path text =
28 let
29 val bytes = Byte.stringToBytes text
30 val pid = SysWord.toString (Posix.Process.pidToWord (Posix.ProcEnv.getpid ()))
31 val prefix = OS.Path.concat (OS.Path.dir path, "." ^ OS.Path.file path ^ "." ^ pid ^ ".")
32 val defaultMode = Posix.FileSys.S.flags [Posix.FileSys.S.irusr, Posix.FileSys.S.iwusr,
33 Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp, Posix.FileSys.S.iroth, Posix.FileSys.S.iwoth]
34 val mode = Posix.FileSys.S.intersect [Posix.FileSys.ST.mode (Posix.FileSys.stat path),
35 Posix.FileSys.S.flags [Posix.FileSys.S.irwxu, Posix.FileSys.S.irwxg, Posix.FileSys.S.irwxo]]
36 handle exn as OS.SysErr (_, SOME error) =>
37 if error = Posix.Error.noent then defaultMode else raise exn
38 fun reserve n =
39 if n = 128 then raise Fail "cannot reserve output file"
40 else
41 let
42 val temporary = prefix ^ Int.toString n
43 in
44 (temporary, Posix.FileSys.createf
45 (temporary, Posix.FileSys.O_WRONLY, Posix.FileSys.O.excl, mode))
46 end handle exn as OS.SysErr (_, SOME error) =>
47 if error = Posix.Error.exist then reserve (n + 1) else raise exn
48 val (temporary, fd) = reserve 0
49 val closed = ref false
50 fun close () = (Posix.IO.close fd; closed := true)
51 fun discard () =
52 ((if !closed then () else close ()) handle _ => ();
53 OS.FileSys.remove temporary handle _ => ())
54 fun loop offset =
55 if offset = Word8Vector.length bytes then ()
56 else
57 let
58 val count = Posix.IO.writeVec (fd, Word8VectorSlice.slice (bytes, offset, NONE))
59 in
60 if count = 0 then raise Fail "output write made no progress" else loop (offset + count)
61 end
62 in
63 (loop 0; close (); OS.FileSys.rename {old = temporary, new = path})
64 handle exn => (discard (); raise exn)
65 end;
66
67fun output (ok, message) =
68 (TextIO.output (if ok then TextIO.stdOut else TextIO.stdErr, text message);
69 OS.Process.exit (if ok then OS.Process.success else OS.Process.failure));
70
71fun usage () =
72 (TextIO.output (TextIO.stdOut,
73 "usage: span assemble file [-o binary]\n span trace file\n span list file\n span run file [fuel]\n span disassemble binary\n\nuse - to read standard input\n");
74 OS.Process.exit OS.Process.success);
75
76fun run args =
77 case args of
78 [] => usage ()
79 | ["--help"] => usage ()
80 | ["disassemble", file] => output (Span.disassemble (chars (read file)))
81 | ["assemble", file, "-o", destination] =>
82 let
83 val ((ok, bytes), report) = Span.artifact (chars (read file))
84 in
85 if ok then
86 (write destination (text bytes);
87 output (true, report))
88 else output (false, report)
89 end
90 | ["run", file] => output (Span.process (map chars ["run", "4096"]) (chars (read file)))
91 | ["run", file, fuel] => output (Span.process (map chars ["run", fuel]) (chars (read file)))
92 | [mode, file] =>
93 if List.exists (fn x => x = mode) ["assemble", "trace", "list"] then
94 output (Span.process [chars mode] (chars (read file)))
95 else raise Fail "unknown command, use span --help"
96 | _ => raise Fail "invalid arguments, use span --help";
97
98fun main () = run (CommandLine.arguments ())
99 handle exn =>
100 (TextIO.output (TextIO.stdErr, "span: " ^ General.exnMessage exn ^ "\n");
101 OS.Process.exit OS.Process.failure);