src/Pure/ML-Systems/polyml-4.0.ML
author wenzelm
Fri, 02 Feb 2001 23:59:30 +0100
changeset 11039 55de839f4850
parent 10914 aded4ba99b88
permissions -rw-r--r--
'split_format' attribute;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml.ML
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     4
    Copyright   1991  University of Cambridge
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     5
9738
2e1dca5af2d4 fixed comment;
wenzelm
parents: 9735
diff changeset
     6
Compatibility file for Poly/ML (version 4.0).
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     7
*)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     8
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
     9
(** ML system related **)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    10
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    11
(* old Poly/ML emulation *)
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    12
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    13
local
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    14
  val orig_exit = exit;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    15
in
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    16
  open PolyML;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    17
  val exit = orig_exit;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    18
  fun quit () = exit 0;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    19
end;
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    20
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    21
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    22
(* restore old-style character / string functions *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    23
10708
1a6348a11489 SML90: ord, chr, explode, implode;
wenzelm
parents: 10518
diff changeset
    24
val ord = SML90.ord;
1a6348a11489 SML90: ord, chr, explode, implode;
wenzelm
parents: 10518
diff changeset
    25
val chr = SML90.chr;
1a6348a11489 SML90: ord, chr, explode, implode;
wenzelm
parents: 10518
diff changeset
    26
val explode = SML90.explode;
1a6348a11489 SML90: ord, chr, explode, implode;
wenzelm
parents: 10518
diff changeset
    27
val implode = SML90.implode;
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    28
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    29
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    30
(*Note start point for timing*)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    31
fun startTiming() =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    32
  let val CPUtimer = Timer.startCPUTimer();
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    33
      val time = Timer.checkCPUTimer(CPUtimer)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    34
  in  (CPUtimer,time)  end;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    35
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    36
(*Finish timing and return string*)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    37
fun endTiming (CPUtimer, {sys,usr}) =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    38
  let open Time  (*...for Time.toString, Time.+ and Time.- *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    39
      val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    40
  in  "User " ^ toString (usr2-usr) ^
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    41
      "  All "^ toString (sys2-sys + usr2-usr) ^
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    42
      " secs"
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    43
      handle Time => ""
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    44
  end;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    45
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    46
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    47
(* prompts *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    48
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    49
fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    50
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    51
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    52
(* toplevel pretty printing (see also Pure/install_pp.ML) *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    53
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    54
fun make_pp _ pprint (str, blk, brk, en) _ _ obj =
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    55
  pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    56
    fn () => brk (99999, 0), en);
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    57
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    58
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    59
(* ML command execution -- 'eval' *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    60
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    61
local
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    62
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    63
fun drop_last [] = []
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    64
  | drop_last [x] = []
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    65
  | drop_last (x :: xs) = x :: drop_last xs;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    66
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    67
val drop_last_char = implode o drop_last o explode;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    68
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    69
in
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    70
10914
aded4ba99b88 use_text etc.: proper output of error messages;
wenzelm
parents: 10708
diff changeset
    71
fun use_text (print, err) verbose txt =
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    72
  let
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    73
    val in_buffer = ref (explode txt);
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    74
    val out_buffer = ref ([]: string list);
10914
aded4ba99b88 use_text etc.: proper output of error messages;
wenzelm
parents: 10708
diff changeset
    75
    fun output () = drop_last_char (implode (rev (! out_buffer)));
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    76
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    77
    fun get () =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    78
      (case ! in_buffer of
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    79
        [] => ""
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    80
      | c :: cs => (in_buffer := cs; c));
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    81
    fun put s = out_buffer := s :: ! out_buffer;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    82
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    83
    fun exec () =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    84
      (case ! in_buffer of
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    85
        [] => ()
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    86
      | _ => (PolyML.compiler (get, put) (); exec ()));
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    87
  in
10914
aded4ba99b88 use_text etc.: proper output of error messages;
wenzelm
parents: 10708
diff changeset
    88
    exec () handle exn => (err (output ()); raise exn);
aded4ba99b88 use_text etc.: proper output of error messages;
wenzelm
parents: 10708
diff changeset
    89
    if verbose then print (output ()) else ()
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    90
  end;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    91
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    92
end;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    93
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    94
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
    95
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    96
(** interrupts **)
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
    97
10518
20d4899f5d48 exception Interrupt = SML90.Interrupt;
wenzelm
parents: 10517
diff changeset
    98
exception Interrupt = SML90.Interrupt;
10517
b9f7adf3ff11 added exception Interrupt for use in function Library/try
paulson
parents: 10209
diff changeset
    99
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   100
local
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   101
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   102
datatype 'a result =
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   103
  Result of 'a |
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   104
  Exn of exn;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   105
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   106
fun capture f x = Result (f x) handle exn => Exn exn;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   107
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   108
fun release (Result x) = x
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   109
  | release (Exn exn) = raise exn;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   110
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   111
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   112
val sig_int = 2;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   113
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   114
fun change_signal new_handler f x =
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   115
  let
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   116
    (*RACE wrt. other signals*)
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   117
    val old_handler = Signal.signal (sig_int, new_handler);
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   118
    val result = capture f x;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   119
    val _ = Signal.signal (sig_int, old_handler);
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   120
  in release result end;
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   121
10209
b24210573eca install default_handler for SIGINT initially as well;
wenzelm
parents: 10194
diff changeset
   122
val default_handler = Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ());
b24210573eca install default_handler for SIGINT initially as well;
wenzelm
parents: 10194
diff changeset
   123
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   124
in
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   125
10209
b24210573eca install default_handler for SIGINT initially as well;
wenzelm
parents: 10194
diff changeset
   126
val _ = Signal.signal (sig_int, default_handler);
b24210573eca install default_handler for SIGINT initially as well;
wenzelm
parents: 10194
diff changeset
   127
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   128
fun mask_interrupt f = change_signal Signal.SIG_IGN f;
10209
b24210573eca install default_handler for SIGINT initially as well;
wenzelm
parents: 10194
diff changeset
   129
fun exhibit_interrupt f = change_signal default_handler f;
9766
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   130
da6788606f54 fixed make_pp;
wenzelm
parents: 9738
diff changeset
   131
end;
9735
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   132
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   133
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   134
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   135
(** OS related **)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   136
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   137
(* system command execution *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   138
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   139
(*execute Unix command which doesn't take any input from stdin and
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   140
  sends its output to stdout; could be done more easily by Unix.execute,
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   141
  but that function doesn't use the PATH*)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   142
fun execute command =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   143
  let
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   144
    val tmp_name = OS.FileSys.tmpName ();
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   145
    val is = (OS.Process.system (command ^ " > " ^ tmp_name); TextIO.openIn tmp_name);
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   146
    val result = TextIO.inputAll is;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   147
  in
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   148
    TextIO.closeIn is;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   149
    OS.FileSys.remove tmp_name;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   150
    result
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   151
  end;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   152
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   153
(*plain version; with return code*)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   154
fun system cmd =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   155
  if OS.Process.isSuccess (OS.Process.system cmd) then 0 else 1;
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   156
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   157
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   158
(* file handling *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   159
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   160
(*get time of last modification*)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   161
fun file_info name = Time.toString (OS.FileSys.modTime name) handle _ => "";
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   162
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   163
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   164
(* getenv *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   165
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   166
fun getenv var =
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   167
  (case OS.Process.getEnv var of
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   168
    NONE => ""
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   169
  | SOME txt => txt);
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   170
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   171
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   172
(* non-ASCII input (see also Thy/use.ML) *)
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   173
203e5552496b added ML-Systems/polyml-4.0.ML;
wenzelm
parents:
diff changeset
   174
val needs_filtered_use = true;