src/Pure/ML-Systems/polyml_common.ML
author wenzelm
Sat, 06 Feb 2010 14:50:55 +0100
changeset 35010 d6e492cea6e4
parent 34136 3dcb46ae6185
child 35014 a725ff6ead26
permissions -rw-r--r--
renamed system/system_out to bash/bash_output -- to emphasized that this is really GNU bash, not some undefined POSIX sh;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml_common.ML
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     2
31308
3fd52453ae81 discontinued support for Poly/ML 4.x versions;
wenzelm
parents: 30672
diff changeset
     3
Compatibility file for Poly/ML -- common part for 5.x.
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     4
*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     5
28443
de653f1ad78b more robust treatment of Interrupt (cf. exn.ML);
wenzelm
parents: 28416
diff changeset
     6
exception Interrupt = SML90.Interrupt;
de653f1ad78b more robust treatment of Interrupt (cf. exn.ML);
wenzelm
parents: 28416
diff changeset
     7
34136
3dcb46ae6185 added basic library -- Scala version;
wenzelm
parents: 33213
diff changeset
     8
use "General/exn.ML";
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     9
use "ML-Systems/multithreading.ML";
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    10
use "ML-Systems/time_limit.ML";
31686
e54ae15335a1 more detailed start_timing/end_timing (in timing.ML);
wenzelm
parents: 31324
diff changeset
    11
use "ML-Systems/timing.ML";
35010
d6e492cea6e4 renamed system/system_out to bash/bash_output -- to emphasized that this is really GNU bash, not some undefined POSIX sh;
wenzelm
parents: 34136
diff changeset
    12
use "ML-Systems/bash.ML";
30619
0226c07352db added generic ML_Pretty interface;
wenzelm
parents: 30187
diff changeset
    13
use "ML-Systems/ml_pretty.ML";
30672
beaadd5af500 more systematic type use_context, with particular values ML_Parse.global_context and ML_Context.local_context;
wenzelm
parents: 30625
diff changeset
    14
use "ML-Systems/use_context.ML";
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    15
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    16
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    17
(** ML system and platform related **)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    18
26474
94735cff132c added forget_structure;
wenzelm
parents: 26380
diff changeset
    19
val forget_structure = PolyML.Compiler.forgetStructure;
94735cff132c added forget_structure;
wenzelm
parents: 26380
diff changeset
    20
33213
1b550123f133 forget old some old option stuff from NJ -- superceded by material in Pure/General/basics.ML;
wenzelm
parents: 33060
diff changeset
    21
val _ = PolyML.Compiler.forgetValue "isSome";
1b550123f133 forget old some old option stuff from NJ -- superceded by material in Pure/General/basics.ML;
wenzelm
parents: 33060
diff changeset
    22
val _ = PolyML.Compiler.forgetValue "getOpt";
1b550123f133 forget old some old option stuff from NJ -- superceded by material in Pure/General/basics.ML;
wenzelm
parents: 33060
diff changeset
    23
val _ = PolyML.Compiler.forgetValue "valOf";
33004
715566791eb0 always qualify NJ's old List.foldl/foldr in Isabelle/ML;
wenzelm
parents: 32776
diff changeset
    24
val _ = PolyML.Compiler.forgetValue "foldl";
715566791eb0 always qualify NJ's old List.foldl/foldr in Isabelle/ML;
wenzelm
parents: 32776
diff changeset
    25
val _ = PolyML.Compiler.forgetValue "foldr";
31324
3ffa005c7701 removed print function from global ML name space, to reduce risk of surprises;
wenzelm
parents: 31319
diff changeset
    26
val _ = PolyML.Compiler.forgetValue "print";
32741
bf8881f6e343 hide "ref" by default, to enforce excplicit indication as Unsynchronized;
wenzelm
parents: 32737
diff changeset
    27
val _ = PolyML.Compiler.forgetValue "ref";
bf8881f6e343 hide "ref" by default, to enforce excplicit indication as Unsynchronized;
wenzelm
parents: 32737
diff changeset
    28
val _ = PolyML.Compiler.forgetType "ref";
31324
3ffa005c7701 removed print function from global ML name space, to reduce risk of surprises;
wenzelm
parents: 31319
diff changeset
    29
26474
94735cff132c added forget_structure;
wenzelm
parents: 26380
diff changeset
    30
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    31
(* Compiler options *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    32
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    33
val ml_system_fix_ints = false;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    34
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    35
PolyML.Compiler.printInAlphabeticalOrder := false;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    36
PolyML.Compiler.maxInlineSize := 80;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    37
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    38
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    39
(* old Poly/ML emulation *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    40
31319
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
    41
fun quit () = exit 0;
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    42
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    43
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    44
(* restore old-style character / string functions *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    45
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    46
val ord = SML90.ord;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    47
val chr = SML90.chr;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    48
val explode = SML90.explode;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    49
val implode = SML90.implode;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    50
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    51
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    52
(* prompts *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    53
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    54
fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    55
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    56
30625
d53d1a16d5ee replaced install_pp/make_pp by more general toplevel_pp based on use_text;
wenzelm
parents: 30619
diff changeset
    57
(* print depth *)
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    58
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    59
local
32737
76fa673eee8b Raw ML references as unsynchronized state variables.
wenzelm
parents: 31686
diff changeset
    60
  val depth = Unsynchronized.ref 10;
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    61
in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    62
  fun get_print_depth () = ! depth;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    63
  fun print_depth n = (depth := n; PolyML.print_depth n);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    64
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    65
31319
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
    66
val error_depth = PolyML.error_depth;
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
    67
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    68
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    69
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    70
(** interrupts **)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    71
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    72
local
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    73
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    74
val sig_int = 2;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    75
val default_handler = Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ());
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    76
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    77
val _ = Signal.signal (sig_int, default_handler);
26380
5d368eb42c11 removed pointer_eq from polyml_common.ML (structure Address no longer available after 5.1);
wenzelm
parents: 26220
diff changeset
    78
val _ = PolyML.onEntry (fn () => (Signal.signal (sig_int, default_handler); ()));
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    79
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    80
fun change_signal new_handler f x =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    81
  let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    82
    (*RACE wrt. other signals!*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    83
    val old_handler = Signal.signal (sig_int, new_handler);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    84
    val result = Exn.capture (f old_handler) x;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    85
    val _ = Signal.signal (sig_int, old_handler);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    86
  in Exn.release result end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    87
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    88
in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    89
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    90
fun interruptible f = change_signal default_handler (fn _ => f);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    91
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    92
fun uninterruptible f =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    93
  change_signal Signal.SIG_IGN
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    94
    (fn old_handler => f (fn g => change_signal old_handler (fn _ => g)));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    95
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    96
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    97
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    98
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    99
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   100
(** OS related **)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   101
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   102
(* current directory *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   103
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   104
val cd = OS.FileSys.chDir;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   105
val pwd = OS.FileSys.getDir;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   106
28488
18fea7e88ea1 removed obsolete Posix/Signal compatibility wrappers;
wenzelm
parents: 28443
diff changeset
   107
fun process_id () =
18fea7e88ea1 removed obsolete Posix/Signal compatibility wrappers;
wenzelm
parents: 28443
diff changeset
   108
  Word.fmt StringCvt.DEC (Word.fromLargeWord (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())));
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   109
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   110
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   111
(* getenv *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   112
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   113
fun getenv var =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   114
  (case OS.Process.getEnv var of
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   115
    NONE => ""
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   116
  | SOME txt => txt);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   117
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   118
31319
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
   119
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
   120
(** Runtime system **)
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
   121
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
   122
val exception_trace = PolyML.exception_trace;
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
   123
val timing = PolyML.timing;
6974449ddea9 no longer open PolyML -- to avoid surprises within the global name space;
wenzelm
parents: 31308
diff changeset
   124
val profiling = PolyML.profiling;
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   125
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   126
fun profile 0 f x = f x
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   127
  | profile n f x =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   128
      let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   129
        val _ = RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler n;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   130
        val res = Exn.capture f x;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   131
        val _ = RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler 0;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   132
      in Exn.release res end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   133
33060
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   134
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   135
(* magic immutability -- for internal use only! *)
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   136
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   137
fun magic_immutability_mark (r: 'a Unsynchronized.ref) =
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   138
  ignore (RunCall.run_call1 RuntimeCalls.POLY_SYS_lockseg r);
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   139
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   140
fun magic_immutability_test (r: 'a Unsynchronized.ref) =
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   141
  Word8.andb (0wx40, RunCall.run_call1 RuntimeCalls.POLY_SYS_get_flags r) = 0w0;
e66b41782cb5 support single-assigment variables -- based on magic RTS operations by David Matthews;
wenzelm
parents: 33004
diff changeset
   142