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