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