1
2fun exit 0 = (OS.Process.exit OS.Process.success): unit
3  | exit _ = OS.Process.exit OS.Process.failure;
4
5fun reraise exn =
6  (case PolyML.exceptionLocation exn of
7    NONE => raise exn
8  | SOME location => PolyML.raiseWithLocation (exn, location));
9
10fun set_exn_serial i exn =
11  let
12    val (file, startLine, endLine) =
13      (case PolyML.exceptionLocation exn of
14        NONE => ("", 0, 0)
15      | SOME {file, startLine, endLine, startPosition, ...} => (file, startLine, endLine));
16    val location =
17      {file = file, startLine = startLine, endLine = endLine,
18        startPosition = ~ i, endPosition = 0};
19  in PolyML.raiseWithLocation (exn, location) handle e => e end;
20
21fun get_exn_serial exn =
22  (case Option.map #startPosition (PolyML.exceptionLocation exn) of
23    NONE => NONE
24  | SOME i => if i >= 0 then NONE else SOME (~ i));
25
26exception Interrupt = SML90.Interrupt;
27val ord = SML90.ord;
28val chr = SML90.chr;
29val raw_explode = SML90.explode;
30val implode = SML90.implode;
31
32val pointer_eq = PolyML.pointerEq;
33
34val exception_trace = PolyML.exception_trace;
35
36open Thread;
37val seconds = Time.fromReal;
38use "General/exn.ML";
39use "ML-Systems/multithreading.ML";
40use "ML-Systems/multithreading_polyml.ML";
41use "ML-Systems/unsynchronized.ML";
42
43use "ML-Systems/ml_pretty.ML";
44
45val pretty_ml =
46  let
47    fun convert len (PolyML.PrettyBlock (ind, _, context, prts)) =
48          let
49            fun property name default =
50              (case List.find (fn PolyML.ContextProperty (a, _) => name = a | _ => false) context of
51                SOME (PolyML.ContextProperty (_, b)) => b
52              | NONE => default);
53            val bg = property "begin" "";
54            val en = property "end" "";
55            val len' = property "length" len;
56          in ML_Pretty.Block ((bg, en), map (convert len') prts, ind) end
57      | convert len (PolyML.PrettyString s) =
58          ML_Pretty.String (s, case Int.fromString len of SOME i => i | NONE => size s)
59      | convert _ (PolyML.PrettyBreak (wd, _)) =
60          ML_Pretty.Break (if wd < 99999 then (false, wd) else (true, 2));
61  in convert "" end;
62
63fun ml_pretty (ML_Pretty.Block ((bg, en), prts, ind)) =
64      let val context =
65        (if bg = "" then [] else [PolyML.ContextProperty ("begin", bg)]) @
66        (if en = "" then [] else [PolyML.ContextProperty ("end", en)])
67      in PolyML.PrettyBlock (ind, false, context, map ml_pretty prts) end
68  | ml_pretty (ML_Pretty.String (s, len)) =
69      if len = size s then PolyML.PrettyString s
70      else PolyML.PrettyBlock
71        (0, false, [PolyML.ContextProperty ("length", Int.toString len)], [PolyML.PrettyString s])
72  | ml_pretty (ML_Pretty.Break (false, wd)) = PolyML.PrettyBreak (wd, 0)
73  | ml_pretty (ML_Pretty.Break (true, _)) = PolyML.PrettyBreak (99999, 0);
74
75use "General/basics.ML";
76use "library.ML";
77use "General/alist.ML";
78use "General/table.ML";
79use "General/graph.ML";
80use "General/ord_list.ML";
81
82structure Position =
83struct
84  fun thread_data () = ();
85  fun setmp_thread_data () f x = f x;
86end;
87
88structure Output =
89struct
90  type output = string;
91  fun escape s : output = s;
92  fun raw_stdout s = (TextIO.output (TextIO.stdOut, s); TextIO.flushOut TextIO.stdOut);
93  fun writeln s = raw_stdout (suffix "\n" s);
94  fun warning s = writeln (prefix_lines "### " s);
95  fun status (_: string) = ();
96end;
97val writeln = Output.writeln;
98val warning = Output.warning;
99fun print_mode_value () : string list = [];
100
101use "General/properties.ML";
102use "General/timing.ML";
103
104use "Concurrent/standard_thread.ML";
105use "Concurrent/synchronized.ML";
106use "General/markup.ML";
107use "Concurrent/single_assignment.ML";
108use "Concurrent/time_limit.ML";
109use "Concurrent/par_exn.ML";
110use "Concurrent/task_queue.ML";
111use "Concurrent/future.ML";
112use "Concurrent/lazy.ML";
113use "Concurrent/par_list.ML";
114
115use "General/queue.ML";
116use "Concurrent/mailbox.ML";
117use "Concurrent/cache.ML";
118
119ML_system_pp (fn depth => fn pretty => fn var =>
120  pretty (Synchronized.value var, depth));
121
122ML_system_pp (fn depth => fn pretty => fn x =>
123  (case Future.peek x of
124    NONE => PolyML.PrettyString "<future>"
125  | SOME (Exn.Exn _) => PolyML.PrettyString "<failed>"
126  | SOME (Exn.Res y) => pretty (y, depth)));
127
128ML_system_pp (fn depth => fn pretty => fn x =>
129  (case Lazy.peek x of
130    NONE => PolyML.PrettyString "<lazy>"
131  | SOME (Exn.Exn _) => PolyML.PrettyString "<failed>"
132  | SOME (Exn.Res y) => pretty (y, depth)));
133
134